Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -59,11 +59,11 @@ (top-path (assoc/default 'toppath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) - (runremote (assoc/default 'runremote cmdinfo)) + ;; (runremote (assoc/default 'runremote cmdinfo)) (transport (assoc/default 'transport cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (target (assoc/default 'target cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) @@ -85,12 +85,12 @@ runscript))))) ;; assume it is on the path (rollup-status 0)) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; Setup the *runremote* global var (if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time")) - (set! *runremote* runremote) - (set! *transport-type* transport) + ;; (set! *runremote* runremote) + (set! *transport-type* (string->symbol transport)) (set! keys (cdb:remote-run db:get-keys #f)) (set! keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) @@ -117,11 +117,11 @@ (debug:print 0 "Failed to setup, exiting") ;; (sqlite3:finalize! db) ;; (sqlite3:finalize! tdb) (exit 1))) ;; Can setup as client for server mode now - (server:client-setup) + ;; (server:client-setup) (change-directory *toppath*) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (change-directory work-area) @@ -580,12 +580,12 @@ (debug:print 0 "WARNING: No disk work area specified - running in the test directory under tmp_run"))) (set! cmdparms (base64:base64-encode (with-output-to-string (lambda () ;; (list 'hosts hosts) (write (list (list 'testpath test-path) - (list 'runremote *runremote*) - (list 'transport *transport-type*) + ;; (list 'runremote *runremote*) + (list 'transport (conc *transport-type*)) (list 'toppath *toppath*) (list 'work-area work-area) (list 'test-name test-name) (list 'runscript runscript) (list 'run-id run-id ) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -556,11 +556,12 @@ (if (or (args:get-arg "-test-files")(args:get-arg "-test-paths")) ;; if we are in a test use the MT_CMDINFO data (if (getenv "MT_CMDINFO") (let* ((startingdir (current-directory)) (cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO"))))) - (runremote (assoc/default 'runremote cmdinfo)) + ;; (runremote (assoc/default 'runremote cmdinfo)) + (transport (assoc/default 'transport cmdinfo)) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) @@ -569,11 +570,12 @@ (state (args:get-arg ":state")) (status (args:get-arg ":status")) (target (args:get-arg "-target")) (toppath (assoc/default 'toppath cmdinfo))) (change-directory toppath) - (set! *runremote* runremote) + ;; (set! *runremote* runremote) + (set! *transport-type* (string->symbol transport)) (if (not target) (begin (debug:print 0 "ERROR: -target is required.") (exit 1))) (if (not (setup-for-run)) @@ -729,11 +731,12 @@ (begin (debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!") (exit 5)) (let* ((startingdir (current-directory)) (cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO"))))) - (runremote (assoc/default 'runremote cmdinfo)) + ;; (runremote (assoc/default 'runremote cmdinfo)) + (transport (assoc/default 'transport cmdinfo)) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) @@ -741,18 +744,19 @@ (itemdat (assoc/default 'itemdat cmdinfo)) (db #f) (state (args:get-arg ":state")) (status (args:get-arg ":status"))) (change-directory testpath) - (set! *runremote* runremote) + ;; (set! *runremote* runremote) + (set! *transport-type* (string->symbol transport)) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; can setup as client for server mode now - (server:client-setup) + ;; (server:client-setup) (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: (open-run-close db:load-test-data db test-id)) (if (args:get-arg "-setlog") @@ -902,11 +906,12 @@ (db (if toppath (open-db) #f))) (if db (begin (set! *db* db) (set! *client-non-blocking-mode* #t) - (server:client-setup) + ;; (server:client-setup) + ;; (server:client-launch) (import readline) (import apropos) (gnu-history-install-file-manager (string-append (or (get-environment-variable "HOME") ".") "/.megatest_history")) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -885,15 +885,15 @@ (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (args:get-arg "-server") - (open-run-close server:start db (args:get-arg "-server")) - (if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers - (args:get-arg "-runtests"))) - (server:client-setup) ;; This is a duplicate startup!!!??? BUG? - )) + (open-run-close server:start db (args:get-arg "-server"))) + ;; (if (not (or (args:get-arg "-runall") ;; runall and runtests are allowed to be servers + ;; (args:get-arg "-runtests"))) + ;; (server:client-setup) ;; This is a duplicate startup!!!??? BUG? + ;; )) (set! keys (open-run-close db:get-keys db)) ;; have enough to process -target or -reqtarg here (if (args:get-arg "-reqtarg") (let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL (runconfig (read-config runconfigf #f #f environ-patt: #f)))