Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -27,11 +27,11 @@ process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm tdb.scm \ client.scm mt.scm \ ezsteps.scm lock-queue.scm sdb.scm \ rmt.scm api.scm subrun.scm \ - portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm + portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm # module source files MSRCFILES = ftail.scm # Eggs to install (straightforward ones) @@ -216,10 +216,14 @@ chmod a+x $@ $(PREFIX)/bin/mt_runstep : utils/mt_runstep $(INSTALL) $< $@ chmod a+x $@ + +$(PREFIX)/bin/serialize-env: serialize-env.scm + csc serialize-env.scm + $(INSTALL) serialize-env $@ $(PREFIX)/bin/mt_ezstep : utils/mt_ezstep $(INSTALL) $< $@ chmod a+x $@ @@ -274,10 +278,11 @@ chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ + $(PREFIX)/bin/serialize-env \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \ $(PREFIX)/share/js/jquery-3.1.0.slim.min.js Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -2081,10 +2081,33 @@ ;; clear vars matching pattern, run proc, set vars back ;; if proc is a string run that string as a command with ;; system. ;; +(define *common:orig-env* + (let ((envvars (get-environment-variables))) + (if (get-environment-variable "MT_ORIG_ENV") + (with-input-from-string + (z3:decode-buffer (base64:base64-decode (get-environment-variable "MT_ORIG_ENV"))) + read) + (filter-map (lambda (x) + (if (string-match "^MT_.*" (car x)) + #f + x)) + envvars)))) + +(define (common:with-orig-env proc) + (let ((current-env (get-environment-variables))) + (for-each (lambda (x) (unsetenv (car x))) current-env) + (for-each (lambda (x) (setenv (car x) (cdr x))) *common:orig-env*) + (let ((rv (cond + ((string? proc)(system proc)) + (proc (proc))))) + (for-each (lambda (x) (unsetenv (car x))) *common:orig-env*) + (for-each (lambda (x) (setenv (car x) (cdr x))) current-env) + rv))) + (define (common:without-vars proc . var-patts) (let ((vars (make-hash-table))) (for-each (lambda (vardat) ;; each env var (for-each @@ -2104,20 +2127,21 @@ (lambda (var val) (setenv var val))) vars)) -(define (common:run-a-command cmd #!key (with-vars #f)) +(define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f)) (let* ((pre-cmd (dtests:get-pre-command)) (post-cmd (dtests:get-post-command)) (fullcmd (if (or pre-cmd post-cmd) (conc pre-cmd cmd post-cmd) (conc "viewscreen " cmd)))) (debug:print-info 02 *default-log-port* "Running command: " fullcmd) - (if with-vars - (common:without-vars cmd) - (common:without-vars fullcmd "MT_.*")))) + (cond + (with-vars (common:without-vars cmd)) + (with-orig-env (common:with-orig-env cmd)) + (else (common:without-vars fullcmd "MT_.*"))))) ;;====================================================================== ;; T I M E A N D D A T E ;;====================================================================== Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -621,11 +621,11 @@ ))))) lbl)) (store-button store-label) (command-proc (lambda (command-text-box) (let* ((cmd (iup:attribute command-text-box "VALUE"))) - (common:run-a-command cmd)))) + (common:run-a-command cmd with-orig-env: #t)))) (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10" #:action (lambda (obj cnum val) ;; (print "cnum=" cnum) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -1273,11 +1273,11 @@ (let* ((status (vector-ref hed 3)) (val (vector-ref hed (- colnum 1))) (bgcolor (cond ((member (conc status) '("" "#")) running-color) - ((member (conc status) '("0" 0)) + ((member (conc status) '("0" 0 "-")) white) (else failcolor))) (mtrx-rc (conc rownum ":" colnum))) ;;(print "BB> status=>"status"< bgcolor="bgcolor) (iup:attribute-set! steps-matrix mtrx-rc (if val (conc val) "")) ADDED serialize-env.scm Index: serialize-env.scm ================================================================== --- /dev/null +++ serialize-env.scm @@ -0,0 +1,9 @@ +(use z3) +(use base64) + +(let* ((env-str (with-output-to-string (lambda () (pp (get-environment-variables))))) + (zipped-env-str (z3:encode-buffer env-str)) + (b64-env-str (base64-encode zipped-env-str))) + (print b64-env-str)) + + Index: utils/mk_wrapper ================================================================== --- utils/mk_wrapper +++ utils/mk_wrapper @@ -23,10 +23,14 @@ cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh" if [ "$LD_LIBRARY_PATH" != "" ];then echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2 ( cat << __EOF +if [ -z \$MT_ORIG_ENV ]; then + export MT_ORIG_ENV=\$( $prefix/bin/serialize-env ) +fi + if [ "\$LD_LIBRARY_PATH" != "" ];then export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH else export LD_LIBRARY_PATH=$LD_LIBRARY_PATH fi Index: wrappers/cfg.sh ================================================================== --- wrappers/cfg.sh +++ wrappers/cfg.sh @@ -12,10 +12,14 @@ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Megatest. If not, see . + +if [ -z $MT_ORIG_ENV ]; then + export MT_ORIG_ENV=$( PREFIX/bin/serialize-env ) +fi if [ "$LD_LIBRARY_PATH" != "" ];then export LD_LIBRARY_PATH=PREFIX:PREFIX/lib:PREFIX/lib64:$LD_LIBRARY_PATH else export LD_LIBRARY_PATH=PREFIX:PREFIX/lib:PREFIX/lib64