Megatest

(declare (uses daemon))
(declare (uses db))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")

			"-set-state-status"
			"-debug" ;; for *verbosity* > 2
			"-gen-megatest-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-dumpmode"
			"-run-id"
			) 
		 (list  "-h"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-show-keys"

(if (args:get-arg "-server")

    ;; Server? Start up here.
    ;;
    (let ((tl        (setup-for-run))
	  (transport (or (configf:lookup *configdat* "setup" "transport")
			 (args:get-arg "-transport" "http")))
	  (run-id    (and (args:get-arg "-run-id")
			  (string->number (args:get-arg "-run-id")))))
      (debug:print 2 "Launching server using transport " transport " for run-id=" run-id)
      (if run-id
	  (server:launch (string->symbol transport) run-id)
	  (debug:print 0 "ERROR: server requires run-id be specified with -run-id")))

    ;; Not a server? This section will decide how to communicate
    ;;
    ;;  Setup client for all expect listed here
    (if (null? (lset-intersection 
		     equal?
		     (hash-table-keys args:arg-hash)
		     '("-list-servers"
		       "-stop-server"
		       "-show-cmdinfo"
		       "-list-runs")))
	(if (setup-for-run)
	    (let ((run-id    (and (args:get-arg "-run-id")
				  (string->number (args:get-arg "-run-id")))))
	      ;; (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
	      ;; if not list or kill then start a client (if appropriate)
	      (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
		      (eq? (length (hash-table-keys args:arg-hash)) 0))
		  (debug:print-info 1 "Server connection not needed")
		  ;; ok, so lets connect to the server
		  (let* ((transport-from-config   (configf:lookup *configdat* "setup" "transport"))

								      transport-from-cmdinfo
								      transport-from-config
								      "fs"))))
		    (debug:print 2 "chosen-transport: " chosen-transport " have; config=" transport-from-config ", cmdln=" transport-from-cmdln ", cmdinfo=" transport-from-cmdinfo)
		    (case chosen-transport
		      ((http)
		       (set! *transport-type 'http)
		       ;; if we have a run-id (why would we?) start the server for that run.
		       ;; otherwise it is up to other calls to start the server(s) dynamically
		       (if run-id 
			   (begin
			     (server:ensure-running run-id)
			     (client:launch run-id))
			   (begin
			     ;; without run-id we'll start a server for "0"
			     (server:ensure-running 0)
			     (client:launch 0))))
		      (else ;; (fs)
		       (debug:print 0 "ERROR: Should NOT be getting here! fs transport is no longer supported")
		       (set! *transport-type* 'fs)
		       (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))

(if (or (args:get-arg "-list-servers")
	(args:get-arg "-stop-server"))

;;    - if cannot access db > allowed disconnect time then kill job

(if (args:get-arg "-runtests")
  (general-run-call 
   "-runtests" 
   "run a test" 
   (lambda (target runname keys keyvals)
     ;;
     ;; May or may not implement it this way ...
     ;;
     ;; Insert this run into the tasks queue
     ;; (open-run-close tasks:add tasks:open-db 
     ;;    	     "runtests" 
     ;;    	     user
     ;;    	     target
     ;;    	     runname
     ;;    	     (args:get-arg "-runtests")
     ;;    	     #f))))
     (runs:run-tests target
		     runname
		     (args:get-arg "-runtests")
		     user
		     args:arg-hash))))

;;======================================================================

			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
			  (debug:print-info 2 "running \"" cmd "\"")
			  (change-directory startingdir)
			  (set! exitstat (system cmd))
			  (set! *globalexitstatus* exitstat) ;; no necessary
			  (change-directory testpath)
			  ;; (cdb:test-set-log! *runremote* test-id (sdb:qry 'getid htmllogfile))))
			  (rmt:test-set-log! run-id test-id htmllogfile)))
		    (let ((msg (args:get-arg "-m")))
		      (rmt:teststep-set-status! run-id test-id stepname "end" exitstat msg logfile))
		    )))
	  (if (or (args:get-arg "-test-status")
		  (args:get-arg "-set-values"))
	      (let ((newstatus (cond
				((number? status)       (if (equal? status 0) "PASS" "FAIL"))