Megatest

Artifact [7f7ba83fa1]
Login

Artifact 7f7ba83fa1f5e3820afc92b8546fdb369e792711:


;; Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     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 <http://www.gnu.org/licenses/>.
;;

;; (declare (uses dbi))
(declare (uses pkts))
;; (declare (uses stml2))
;; (declare (uses cookie))
;; (declare (uses csv-xml))
;; (declare (uses hostinfo))

(declare (uses adjutant))
;; (declare (uses archivemod))
(declare (uses apimod))
;; (declare (uses autoload))
;; (declare (uses bigmod))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbmod))
(declare (uses debugprint))
;; (declare (uses ducttape-lib))
;; (declare (uses ezstepsmod))
(declare (uses launchmod))
(declare (uses mtargs))
(declare (uses mtver))
;; (declare (uses mutils))
(declare (uses processmod))
(declare (uses rmtmod))
;; (declare (uses runsmod))
;; (declare (uses servermod))
;; (declare (uses testsmod))
(declare (uses dbmgrmod))

;; needed for configf scripts, scheme etc.
;; (declare (uses apimod.import))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs.import))
;; (declare (uses commonmod.import))
;; (declare (uses configfmod.import))
;; (declare (uses bigmod.import))
;; (declare (uses dbmod.import))
;; (declare (uses rmtmod.import))
;; (declare (uses servermod.import))
;; (declare (uses launchmod.import))

;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module mtserve
	*

  (import scheme

;;	  chicken.base
;;	  chicken.bitwise
;;	  chicken.condition
;;	  ;; chicken.csi
;;	  chicken.eval
;;	  chicken.file
;;	  chicken.file.posix
;;	  chicken.format
;;	  chicken.io
;;	  chicken.irregex
;;	  chicken.pathname
;;	  chicken.port
;;	  chicken.pretty-print
;;	  chicken.process
;;	  chicken.process-context
;;	  chicken.process-context.posix
;;	  chicken.process.signal
;;	  chicken.random
;;	  chicken.repl
;;	  chicken.sort
;;	  chicken.string
;;	  chicken.tcp
;;	  chicken.time
;;	  chicken.time.posix
;;	  
;;	  (prefix base64 base64:)
;;	  (prefix sqlite3 sqlite3:)
;;	  (prefix sxml-modifications sxml-)
;;	  address-info
;;	  csv-abnf
;;	  directory-utils
;;	  fmt
;;	  format
;;	  http-client
;;	  intarweb
;;	  json
;;	  linenoise
;;	  matchable
;;	  md5
;;	  message-digest
;;	  queues
;;	  regex
;;	  regex-case
;;	  s11n
;;	  sparse-vectors
;;	  spiffy
;;	  spiffy-directory-listing
;;	  spiffy-request-vars
;;	  sql-de-lite
;;	  stack
;;	  sxml-modifications
;;	  sxml-serializer
;;	  sxml-transforms
;;	  system-information
;;	  typed-records
;;	  uri-common
;;	  z3
;;	  
;;	  srfi-1
;;	  srfi-4
;;	  srfi-18
;;	  srfi-13
;;	  srfi-98
;;	  srfi-69
;;
;;	  ;; local modules
;;	  autoload
;;	  adjutant
;;	  csv-xml
;;	  ;; hostinfo
;;	  mtver
;;	  mutils
;;	  cookie
;;	  csv-xml
;;	  ducttape-lib
;;	  (prefix mtargs args:)
;;	  pkts
;;	  stml2
;;	  (prefix dbi dbi:)
;;
;;	  apimod
;;	  archivemod
;;	  bigmod
;;	  commonmod
;;	  configfmod
;;	  dbmod
;;	  debugprint
;;	  ezstepsmod
;;	  launchmod
;;	  processmod
;;	  rmtmod
;;	  runsmod
;;	  servermod
;;	  tasksmod
;;	  testsmod
;;	  dbmgrmod
;;	  
;;	  ulex
	  )

;;   ;; ulex parameters
;;   (work-method 'direct)
;;   (return-method 'direct)
  
  ;; ulex parameters
  ;; (work-method   'mailbox)
  ;; (return-method 'mailbox)

;; (my-with-lock common:with-simple-file-lock)
;;   
;; ;; fake out readline usage of toplevel-command
;; (define (toplevel-command . a) #f)
;; (define *didsomething* #f)  
;; (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")
;; ;; (include "test_records.scm")
;; 
;; ;; (include "common.scm")
;; (include "db.scm")
;; ;; (include "server.scm")
;; (include "tests.scm")
;; (include "genexample.scm")
;; (include "tdb.scm")
;; (include "env.scm")
;; (include "diff-report.scm")
;; (include "ods.scm")
;; 

  (define (main)
    (let ((tl        (launch:setup))
 	  (dbname    (args:get-arg "-db"))) 
      (rmt:server-launch dbname)
      #;(set! *didsomething* #t)))

  
(thread-join!
 (thread-start!
  (make-thread main)))

)

;; (define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
;; (define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
;; 
;; ;;======================================================================
;; ;; Test commands (i.e. for use inside tests)
;; ;;======================================================================
;; 
;; (define (megatest:step step state status logfile msg)
;;   (if (not (get-environment-variable "MT_CMDINFO"))
;;       (begin
;;      	(debug:print-error 0 *default-log-port* "MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
;;      	(exit 5))
;;       (let* ((cmdinfo   (common:read-encoded-string (get-environment-variable "MT_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))
;;      	     (test-id   (assoc/default 'test-id   cmdinfo))
;;      	     (itemdat   (assoc/default 'itemdat   cmdinfo))
;;      	     (work-area (assoc/default 'work-area cmdinfo))
;;      	     (db        #f))
;;      	(change-directory testpath)
;;      	(if (not (launch:setup))
;;      	    (begin
;;      	      (debug:print 0 *default-log-port* "Failed to setup, exiting")
;;      	      (exit 1)))
;;      	(if (and state status)
;;      	    (let ((comment (launch:load-logpro-dat run-id test-id step)))
;;      	      ;; (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
;;      	      (rmt:teststep-set-status! run-id test-id step state status (or comment msg) logfile))
;;      	    (begin
;;      	      (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -step")
;;      	      (exit 6))))))
;; 
;; ;;======================================================================
;; ;; full run
;; ;;======================================================================
;; 
;; (define (handle-run-requests target runname keys keyvals need-clean)	 
;;   (if (or (args:get-arg "-kill-rerun") (args:get-arg "-rerun-clean")) ;; first set states/statuses correct
;;       ;; For rerun-clean do we or do we not support the testpatt?
;;       (let ((states   (or (configf:lookup *configdat* "validvalues" "cleanrerun-states")
;;      			  "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED"))
;;      	    (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses")
;;      			  "FAIL,INCOMPLETE,ABORT,CHECK,DEAD,PREQ_FAIL,PREQ_DISCARDED")))
;;      	(hash-table-set! args:arg-hash "-preclean" #t)
;;      	(runs:operate-on 'set-state-status
;;      			 target
;;      			 (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
;;      			 ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;;      			 (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;;      			 state:  states
;;      			 ;; status: statuses
;;      			 new-state-status: "NOT_STARTED,n/a")
;;      	(runs:clean-cache target runname *toppath*)
;;      	(runs:operate-on 'set-state-status
;;      			 target
;;      			 (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
;;      			 ;; "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;;      			 (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;;      			 ;; state:  states
;;      			 status: statuses
;;      			 new-state-status: "NOT_STARTED,n/a")))
;;   ;; RERUN ALL
;;   (if (args:get-arg "-rerun-all") ;; first set states/statuses correct
;;       (let* ((rconfig (full-runconfigs-read)))
;;      	(hash-table-set! args:arg-hash "-preclean" #t)
;;      	(runs:operate-on 'set-state-status
;;      			 target
;;      			 (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
;;      			 (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt")
;;      			 state:  #f
;;      			 ;; status: statuses
;;      			 new-state-status: "NOT_STARTED,n/a")
;;      	(runs:clean-cache target runname *toppath*)
;;      	(runs:operate-on 'set-state-status
;;      			 target
;;      			 (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
;;      			 (common:args-get-testpatt rconfig) ;; (args:get-arg "-testpatt")
;;      			 ;; state:  states
;;      			 status: #f
;;      			 new-state-status: "NOT_STARTED,n/a")))
;;   (let* ((config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
;;      			       (if x (string->number x) #f)))
;;      	 (rerun-cnt (if config-reruns
;;      			config-reruns
;;      			1)))
;;     
;;     (runs:run-tests target
;;      		    runname
;;      		    #f ;; (common:args-get-testpatt #f)
;;      		    ;; (or (args:get-arg "-testpatt")
;;      		    ;;     "%")
;;      		    (bdat-user *bdat*)
;;      		    args:arg-hash
;;      		    run-count: rerun-cnt)))
;; 
;; ;; csv processing record
;; (define (make-refdb:csv)
;;   (vector 
;;    (make-sparse-array)
;;    (make-hash-table)
;;    (make-hash-table)
;;    0
;;    0))
;; (define-inline (refdb:csv-get-svec     vec)    (vector-ref  vec 0))
;; (define-inline (refdb:csv-get-rows     vec)    (vector-ref  vec 1))
;; (define-inline (refdb:csv-get-cols     vec)    (vector-ref  vec 2))
;; (define-inline (refdb:csv-get-maxrow   vec)    (vector-ref  vec 3))
;; (define-inline (refdb:csv-get-maxcol   vec)    (vector-ref  vec 4))
;; (define-inline (refdb:csv-set-svec!    vec val)(vector-set! vec 0 val))
;; (define-inline (refdb:csv-set-rows!    vec val)(vector-set! vec 1 val))
;; (define-inline (refdb:csv-set-cols!    vec val)(vector-set! vec 2 val))
;; (define-inline (refdb:csv-set-maxrow!  vec val)(vector-set! vec 3 val))
;; (define-inline (refdb:csv-set-maxcol!  vec val)(vector-set! vec 4 val))
;; 
;; (define (get-dat results sheetname)
;;   (or (hash-table-ref/default results sheetname #f)
;;       (let ((tmp-vec  (make-refdb:csv)))
;;      	(hash-table-set! results sheetname tmp-vec)
;;      	tmp-vec)))
;; 
;; ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
;; (define (open-logfile logpath-in)
;;   (condition-case
;;    (let* ((log-dir (or (pathname-directory logpath-in) "."))
;;      	  (fname   (pathname-strip-directory logpath-in))
;;      	  (logpath (if (> (string-length fname) 250)
;;      		       (let ((newlogf (conc log-dir "/" (common:get-signature fname) ".log")))
;;      			 (debug:print 0 *default-log-port* "WARNING: log file " logpath-in " path too long, converted to " newlogf)
;;      			 newlogf)
;;      		       logpath-in)))
;;      (if (not (directory-exists? log-dir))
;; 	 (system (conc "mkdir -p " log-dir)))
;;      (open-output-file logpath))
;;    (exn ()
;; 	(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath-in)
;; 	(set! *didsomething* #t)
;; 	(exit 1))))
;; 
;; ;; Disabled help items
;; ;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;; ;;                            from prior runs with same keys
;; ;;  -daemonize              : fork into background and disconnect from stdin/out
;; 
;; (define help (conc "
;; Megatest, documentation at http://www.kiatoa.com/fossils/megatest
;;   version " megatest-version "
;;   license GPL, Copyright Matt Welland 2006-2017
;;  
;; Usage: megatest [options]
;;   -h                      : this help
;;   -manual                 : show the Megatest user manual
;;   -version                : print megatest version (currently " megatest-version ")
;; 
;; Launching and managing runs
;;   -run                    : run all tests or as specified by -testpatt
;;   -remove-runs            : remove the data for a run, requires -runname and -testpatt
;;                             Optionally use :state and :status, use -keep-records to remove only
;;                             the run data. Use -kill-wait to override the 10 second
;;                             per test wait after kill delay (e.g. -kill-wait 0). 
;;   -kill-runs              : kill existing run(s) (all incomplete tests killed)
;;   -kill-rerun             : kill an existing run (all incomplete tests killed and run is rerun)
;;   -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
;;   -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
;;   -rerun-clean            : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
;;                             and then run the specified testpatt with -preclean
;;   -rerun-all              : set all tests to NOT_STARTED,n/a and run with -preclean
;;   -lock                   : lock run specified by target and runname
;;   -unlock                 : unlock run specified by target and runname
;;   -set-run-status status  : sets status for run to status, requires -target and -runname
;;   -get-run-status         : gets status for run specified by target and runname
;;   -run-wait               : wait on run specified by target and runname
;;   -preclean               : remove the existing test directory before running the test
;;   -clean-cache            : remove the cached megatest.config and runconfigs.config files
;;   -no-cache               : do not use the cached config files. 
;;   -one-pass               : launch as many tests as you can but do not wait for more to be ready
;;   -remove-keep N          : remove all but N most recent runs per target; use '-actions, -age, -precmd'
;;   -age <age>              : 120d,3h,20m to apply only to runs older than the 
;;                                  specified age. NB// M=month, m=minute
;;   -actions <action>[,...] : actions to take; print,remove-runs,archive,kill-runs
;;   -precmd                 : insert a wrapper command in front of the commands run
;; 
;; Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
;;   -target key1/key2/...   : run for key1, key2, etc.
;;   -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfigs
;;   -testpatt patt1/patt2,patt3/...  : % is wildcard
;;   -runname                : required, name for this particular test run
;;   -state                  : Applies to runs, tests or steps depending on context
;;   -status                 : Applies to runs, tests or steps depending on context
;;   -modepatt key           : load testpatt from <key> in runconfigs instead of default TESTPATT if -testpatt and -tagexpr are not specified
;;   -tagexpr tag1,tag2%,..  : select tests with tags matching expression
;;   
;; 
;; Test helpers (for use inside tests)
;;   -step stepname
;;   -test-status            : set the state and status of a test (use :state and :status)
;;   -setlog logfname        : set the path/filename to the final log relative to the test
;;                             directory. may be used with -test-status
;;   -set-toplog logfname    : set the overall log for a suite of sub-tests
;;   -summarize-items        : for an itemized test create a summary html 
;;   -m comment              : insert a comment for this test
;; 
;; Test data capture
;;   -set-values             : update or set values in the testdata table
;;   :category               : set the category field (optional)
;;   :variable               : set the variable name (optional)
;;   :value                  : value measured (required)
;;   :expected               : value expected (required)
;;   :tol                    : |value-expect| <= tol (required, can be <, >, >=, <= or number)
;;   :units                  : name of the units for value, expected_value etc. (optional)
;;   -load-test-data         : read test specific data for storage in the test_data table
;;                             from standard in. Each line is comma delimited with four
;;                             fields category,variable,value,comment
;; 
;; Queries
;;   -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
;;   -show-keys              : show the keys used in this megatest setup
;;   -test-files targpatt    : get the most recent test path/file matching targpatt e.g. %/% or '*.log'
;;                             returns list sorted by age ascending, see examples below
;;   -test-paths             : get the test paths matching target, runname, item and test
;;                             patterns.
;;   -list-disks             : list the disks available for storing runs
;;   -list-targets           : list the targets in runconfigs.config
;;   -list-db-targets        : list the target combinations used in the db
;;   -show-config            : dump the internal representation of the megatest.config file
;;   -show-runconfig         : dump the internal representation of the runconfigs.config file
;;   -dumpmode MODE          : dump in MODE format instead of sexpr, MODE=json,ini,sexp etc. (add -debug 0,9 to see which file contributes each line)
;;   -show-cmdinfo           : dump the command info for a test (run in test environment)
;;   -section sectionName
;;   -var varName            : for config and runconfig lookup value for sectionName varName
;;   -since N                : get list of runs changed since time N (Unix seconds)
;;   -fields fieldspec       : fields to include in json dump; runs:id,runame+tests:testname+steps
;;   -sort fieldname         : in -list-runs sort tests by this field
;;   -testdata-csv [categorypatt/]varpatt  : dump testdata for given category
;; 
;; Misc 
;;   -start-dir path         : switch to this directory before running megatest
;;   -contour cname          : add a level of hierarcy to the linktree and run paths
;;   -area-tag tagname       : add a tag to an area while syncing to pgdb
;;   -run-tag tagname        : add a tag to a run while syncing to pgdb
;;   -rebuild-db             : bring the database schema up to date
;;   -cleanup-db             : remove any orphan records, vacuum the db
;;   -import-megatest.db     : push data from megatest.db to cache db files in /tmp/$USER
;;   -sync-to-megatest.db    : pull data from cache files in /tmp/$USER to megatest.db
;;   -sync-to dest           : sync to new postgresql central style database
;;   -update-meta            : update the tests metadata for all tests
;;   -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
;;                                  overwritten by values set in config files.
;;   -server -|hostname      : start the server (reduces contention on megatest.db), use
;;                             - to automatically figure out hostname
;;   -adjutant C,M           : start the server/adjutant with allocated cores C and Mem M (Gig), 
;;                             use 0,0 to auto use full machine
;;   -transport http|rpc     : use http or rpc for transport (default is http) 
;;   -log logfile            : send stdout and stderr to logfile
;;   -autolog logfilebase    : appends pid and host to logfilebase for logfile
;;   -list-servers           : list the servers 
;;   -kill-servers           : kill all servers
;;   -repl                   : start a repl (useful for extending megatest)
;;   -load file.scm          : load and run file.scm
;;   -mark-incompletes       : find and mark incomplete tests
;;   -ping run-id|host:port  : ping server, exit with 0 if found
;;   -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
;;   -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG
;;   -config fname           : override the megatest.config file with fname
;;   -append-config fname    : append fname to the megatest.config file
;; 
;; Utilities
;;   -env2file fname         : write the environment to fname.csh and fname.sh
;;   -envcap a               : save current variables labeled as context 'a' in file envdat.db
;;   -envdelta a-b           : output enviroment delta from context a to context b to -o fname
;;                             set the output mode with -dumpmode csh, bash or ini
;;                             note: ini format will use calls to use curr and minimize path
;;   -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
;;                             formats: perl, ruby, sqlite3, csv (for csv the -o param
;;                             will substitute %s for the sheet name in generating 
;;                             multiple sheets)
;;   -o                      : output file for refdb2dat (defaults to stdout)
;;   -archive cmd            : archive runs specified by selectors to one of disks specified
;;                             in the [archive-disks] section.
;;                             cmd: keep-html, restore, save, save-remove, get, replicate-db (use 
;;                             -dest to set destination), -include path1,path2... to get or save specific files
;;   -generate-html          : create a simple html dashboard for browsing your runs
;;   -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
;;   -list-run-time          : list time requered to complete runs. It supports following switches
;;                             -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
;;   -list-test-time	  : list time requered to complete each test in a run. It following following arguments
;;                             -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
;;   -syscheck               : do some very basic checks; write access and space in tmp, home, runs, links and 
;;                             is $DISPLAY valid 
;;   -list-waivers           : dump waivers for specified target, runname, testpatt to stdout
;; 
;; Diff report
;;   -diff-rep               : generate diff report (must include -src-target, -src-runname, -target, -runname
;;                                                   and either -diff-email or -diff-html)
;;   -src-target <target>
;;   -src-runname <target>
;;   -diff-email <emails>    : comma separated list of email addresses to send diff report
;;   -diff-html  <rep.html>  : path to html file to generate
;; 
;; Spreadsheet generation
;;   -extract-ods fname.ods  : extract an open document spreadsheet from the database
;;   -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
;;                             will clear the field if no rundir/testname/itempath/logfile
;;                             if it contains forward slashes the path will be converted
;;                             to windows style
;; Getting started
;;   -create-megatest-area   : create a skeleton megatest area. You will be prompted for paths
;;   -create-test testname   : create a skeleton megatest test. You will be prompted for info
;; 
;; Examples
;; 
;; # Get test path, use '.' to get a single path or a specific path/file pattern
;; megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%
;; 
;; Called as " (string-intersperse (argv) " ") "
;; Version " megatest-version ", built from " megatest-fossil-hash ))
;;      
;; (define (main)
;;   (make-and-init-bigdata)
;; 
;; ;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;; ;;
;; (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
;;   (if (common:file-exists? debugcontrolf)
;;       (load debugcontrolf)))
;; 
;; ;; usage logging, careful with this, it is not designed to deal with all real world challenges!
;; ;;
;; (if (and *usage-log-file*
;; 	 (file-writable? *usage-log-file*))
;;     (with-output-to-file
;; 	*usage-log-file*
;;       (lambda ()
;; 	(print
;; 	 (if *usage-use-seconds*
;; 	     (current-seconds)
;; 	     (time->string
;; 	      (seconds->local-time (current-seconds))
;; 	      "%Yww%V.%w %H:%M:%S"))
;; 	 " "
;; 	 (current-user-name) " "
;; 	 (current-directory) " "
;; 	 "\"" (string-intersperse (argv) " ") "\""))
;;       #:append))
;; 
;;      ;;  -gui                    : start a gui interface
;;      ;;  -config fname           : override the runconfigs file with fname
;;      
;;      ;; process args
;;      (define remargs (args:get-args 
;;      		 (argv)
;;      		 (list  "-runtests"  ;; run a specific test
;;      			"-config"    ;; override the config file name
;;      			"-append-config"
;;      			"-execute"   ;; run the command encoded in the base64 parameter
;;      			"-step"
;;      			"-target"
;;      			"-reqtarg"
;;      			":runname"
;;      			"-runname"
;;      			":state"  
;;      			"-state"
;;      			":status"
;;      			"-status"
;;      			"-list-runs"
;; 			"-testdata-csv"
;;      			"-testpatt"
;; 			"--modepatt"
;; 			"-modepatt"
;; 			"-tagexpr"
;;      			"-itempatt"
;;      			"-setlog"
;;      			"-set-toplog"
;;      			"-runstep"
;;      			"-logpro"
;;      			"-m"
;;      			"-rerun"
;;      
;;      			"-days"
;;      			"-rename-run"
;;      			"-to"
;;      			"-dest"
;; 			"-source" 
;; 			"-time-stamp" 
;;      			;; values and messages
;;      			":category"
;;      			":variable"
;;      			":value"
;;      			":expected"
;;      			":tol"
;;      			":units"
;;      
;;      			;; misc
;;      			"-start-dir"
;; 			"-run-patt"
;; 			"-target-patt"   
;;      			"-contour"
;; 			"-area-tag"  
;; 			"-area"  
;;      			"-run-tag"
;;      			"-server"
;; 			"-db"            ;; file name for setting up a server
;;      			"-adjutant"
;;      			"-transport"
;;      			"-port"
;;      			"-extract-ods"
;;      			"-pathmod"
;;      			"-env2file"
;;      			"-envcap"
;;      			"-envdelta"
;;      			"-setvars"
;;      			"-set-state-status"
;; 			
;; 			;; move runs stuff here
;; 			"-remove-keep"           
;;      			"-set-run-status"
;;      			"-age"
;;      
;;      			;; archive 
;;      			"-archive"
;;      			"-actions"
;;      			"-precmd"
;;      			"-include"
;;      			"-exclude-rx"
;;      			"-exclude-rx-from"
;;      			
;;      			"-debug" ;; for *verbosity* > 2
;;      			"-debug-noprop"
;;      			"-create-test"
;;      			"-override-timeout"
;;      			"-test-files"  ;; -test-paths is for listing all
;;      			"-load"        ;; load and exectute a scheme file
;;      			"-section"
;;      			"-var"
;;      			"-dumpmode"
;;      			"-run-id"
;;      			"-ping"
;;      			"-refdb2dat"
;;      			"-o"
;;      			"-log"
;; 			"-autolog"
;; 			"-sync-log"
;;      			"-since"
;;      			"-fields"
;;      			"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
;;      			"-sort"
;;      			"-target-db"
;;      			"-source-db"
;;      			"-prefix-target"
;;      
;; 			"-src-target"
;; 			"-src-runname"
;; 			"-diff-email"
;;      			"-sync-to"			
;;      			"-pgsync"
;;      			"-kill-wait"    ;; wait this long before removing test (default is 10 sec)
;; 			"-diff-html"
;;      
;;      			;; wizards, area capture, setup new ...
;;      			"-extract-skeleton"
;;      			)
;;       		 (list  "-h" "-help" "--help"
;;      			"-manual"
;;      			"-version"
;;      		        "-force"
;;      		        "-xterm"
;;      		        "-showkeys"
;;      		        "-show-keys"
;;      		        "-test-status"
;;      			"-set-values"
;;      			"-load-test-data"
;;      			"-summarize-items"
;;      		        "-gui"
;;      			"-daemonize"
;;      			"-preclean"
;;      			"-rerun-clean"
;;      			"-rerun-all"
;;      			"-clean-cache"
;;      			"-no-cache"
;;      			"-cache-db"
;;      			"-cp-eventtime-to-publishtime"
;;                              "-use-db-cache"
;;                              "-prepend-contour"
;;      
;;      
;;      			;; misc
;;      			"-repl"
;;      			"-lock"
;;      			"-unlock"
;;      			"-list-servers"
;;      			"-kill-servers"
;; 			"-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)
;;      			"-one-pass"      ;;
;;      			"-local"         ;; run some commands using local db access
;;      			"-generate-html"
;;      			"-generate-html-structure" 
;;      			"-list-run-time"
;;                              "-list-test-time"
;;      			
;;      			;; misc queries
;;      			"-list-disks"
;;      			"-list-targets"
;;      			"-list-db-targets"
;;      			"-show-runconfig"
;;      			"-show-config"
;;      			"-show-cmdinfo"
;;      			"-get-run-status"
;;      			"-list-waivers"
;;      
;;      			;; queries
;;      			"-test-paths" ;; get path(s) to a test, ordered by youngest first
;;      
;;      			"-runall"    ;; run all tests, respects -testpatt, defaults to %
;;      			"-run"       ;; alias for -runall
;;      			"-remove-runs"
;;                              "-kill-runs"
;;                              "-kill-rerun"
;;                              "-keep-records" ;; use with -remove-runs to remove only the run data
;;      			"-rebuild-db"
;;      			"-cleanup-db"
;;      			"-rollup"
;;      			"-update-meta"
;;      			"-create-megatest-area"
;;      			"-mark-incompletes"
;;      
;;      			"-convert-to-norm"
;;      			"-convert-to-old"
;;      			"-import-megatest.db"
;;      			"-sync-to-megatest.db"
;; 			"-sync-brute-force"
;;      			"-logging"
;;      			"-v" ;; verbose 2, more than normal (normal is 1)
;;      			"-q" ;; quiet 0, errors/warnings only
;;      
;;                              "-diff-rep"
;;      
;;      			"-syscheck"
;;      			"-obfuscate"
;;      			;; junk placeholder
;;      			;; "-:p"
;;      			
;;                              )
;;      		 args:arg-hash
;;      		 0))
;;      
;;      ;; Add args that use remargs here
;;      ;;
;;      (if (and (not (null? remargs))
;;      	 (not (or
;;      	       (args:get-arg "-runstep")
;;      	       (args:get-arg "-envcap")
;;      	       (args:get-arg "-envdelta")
;;      	       )
;;      	      ))
;;          (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))
;;      
;;      ;; before doing anything else change to the start-dir if provided
;;      ;;
;;      (if (args:get-arg "-start-dir")
;;          (if (common:file-exists? (args:get-arg "-start-dir"))
;;              (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
;;                (set-environment-variable! "PWD" fullpath)
;;                (change-directory fullpath))
;;      	(begin
;;      	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
;;      	  (exit 1))))
;;      
;;      ;; immediately set MT_TARGET if -reqtarg or -target are available
;;      ;;
;;      (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
;;        (if targ (set-environment-variable! "MT_TARGET" targ)))
;;      
;;      ;; The watchdog is to keep an eye on things like db sync etc.
;;      ;;
;; ;; (init-watchdog)
;;   
;; ;;      (define (debug:debug-mode n)
;; ;;        (cond
;; ;;         ((and (number? *verbosity*)   ;; number number
;; ;;      	 (number? n))
;; ;;          (<= n *verbosity*))
;; ;;         ((and (list? *verbosity*)     ;; list   number
;; ;;      	 (number? n))
;; ;;          (member n *verbosity*))
;; ;;         ((and (list? *verbosity*)     ;; list   list
;; ;;      	 (list? n))
;; ;;          (not (null? (lset-intersection! eq? *verbosity* n))))
;; ;;         ((and (number? *verbosity*)
;; ;;      	 (list? n))
;; ;;          (member *verbosity* n))))
;; 
;;      ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;;      ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;;      ;; where (launch:setup) returns #f?
;;      ;;
;;      (if (or (args:get-arg "-log") ;;(args:get-arg "-server") ;; redirect the log always when a server
;; 	     (args:get-arg "-autolog"))
;;          (handle-exceptions
;;      	exn
;;      	(begin
;;      	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
;;      	  )
;;         (let* ((tl   (or (args:get-arg "-log")
;; 			 (args:get-arg "-autolog") ;; autolog provides the basename .../logs/something- for the logfile
;; 			 (launch:setup)))   ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
;;      	       (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
;; 			 (conc tl (current-process-id)"-"(get-host-name)".log")
;;      			 (conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
;;      	       (oup  (open-logfile logf)))
;;      	(if (not (args:get-arg "-log"))
;;      	    (hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
;;      	(debug:print-info 0 *default-log-port* "Sending log output to " logf)
;;      	(set! *default-log-port* oup))))
;;      
;;      (if (or (args:get-arg "-h")
;;      	(args:get-arg "-help")
;;      	(args:get-arg "--help"))
;;          (begin
;;            (print help)
;;            (exit)))
;;      
;;      (if (args:get-arg "-manual")
;;          (let* ((htmlviewercmd (or (configf:lookup *configdat* "setup" "htmlviewercmd")
;;      			      (common:which '("firefox" "arora"))))
;;      	   (install-home  (common:get-install-area))
;;      	   (manual-html   (conc install-home "/share/docs/megatest_manual.html")))
;;            (if (and install-home
;;      	       (common:file-exists? manual-html))
;;      	  (system (conc "(" htmlviewercmd " " manual-html " ) &"))
;;      	  (system (conc "(" htmlviewercmd " http://www.kiatoa.com/cgi-bin/fossils/megatest/doc/tip/docs/manual/megatest_manual.html ) &")))
;;            (exit)))
;;      
;;      (if (args:get-arg "-version")
;;          (begin
;;            (print (common:version-signature)) ;; (print megatest-version)
;;            (exit)))
;;      
;;      ;; Overall exit handling setup immediately
;;      ;;
;;      (if (or (args:get-arg "-process-reap"))
;;              ;; (args:get-arg "-runtests")
;;      	;; (args:get-arg "-execute")
;;      	;; (args:get-arg "-remove-runs")
;;      	;; (args:get-arg "-runstep"))
;;          (let ((original-exit (exit-handler)))
;;            (exit-handler (lambda (#!optional (exit-code 0))
;;      		      (printf "Preparing to exit with exit code ~A ...\n" exit-code)
;;      		      (for-each
;;      		       
;;      		       (lambda (pid)
;;      			 (handle-exceptions
;;      			     exn
;;      			   (begin
;;      			     (printf "process reap failed. exn=~A\n" exn)
;;      			     #t)
;;      			  (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
;;      				      (if (or (eq? pid-val pid)
;;      					      (eq? pid-val 0))
;;      					  (begin
;;      					    (printf "Sending signal/term to ~A\n" pid)
;;      					    (process-signal pid signal/term))))))
;;      		       (process:children #f))
;;      		      (original-exit exit-code)))))
;;      
;;      ;; for some switches always print the command to stderr
;;      ;;
;;      (if (args:any-defined? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun")
;;          (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))
;;      
;;      ;; some switches imply homehost. Exit here if not on homehost
;;      ;;
;;      #;(let ((homehost-required  (list "-cleanup-db" "-server")))
;;        (if (apply args:any-defined? homehost-required)
;;            (if (not (common:on-homehost?))
;;      	  (for-each
;;      	   (lambda (switch)
;;      	     (if (args:get-arg switch)
;;      		 (begin
;;      		   (debug:print 0 *default-log-port* "ERROR: you must be on the homehost to run with " switch
;;      				", you can move homehost by removing the .homehost file but this will disrupt any runs in progress.")
;;      		   (exit 1))))
;;      	   homehost-required))))
;;      
;;      ;;======================================================================
;;      ;; Misc setup stuff
;;      ;;======================================================================
;;      
;;      (debug:setup)
;;      
;;      (if (args:get-arg "-logging")(set! *logging* #t))
;;      
;;      ;;(if (debug:debug-mode 3) ;; we are obviously debugging
;;      ;;    (set! open-run-close open-run-close-no-exception-handling))
;;      
;;      (if (args:get-arg "-itempatt")
;;          (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt"))))
;;            (debug:print 0 *default-log-port* "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval)
;;            (hash-table-set! args:arg-hash "-testpatt" newval)
;;            (hash-table-delete! args:arg-hash "-itempatt")))
;;      
;;      (if (args:get-arg "-runtests")
;;          (debug:print 0 *default-log-port* "WARNING: \"-runtests\" is deprecated. Use \"-run\" with \"-testpatt\" instead"))
;; 
;;      ;; (debug:print 0 *default-log-port* "on-exit disabled. Please re-enable")
;;      (on-exit std-exit-procedure)
;;      
;;      ;;======================================================================
;;      ;; Misc general calls
;;      ;;======================================================================
;; 
;; ;; TODO: Restore this functionality
;; 
;;      #; (if (and (args:get-arg "-cache-db")
;;               (args:get-arg "-source-db"))
;;          (let* ((temp-dir (or (args:get-arg "-target-db") (create-directory (conc "/tmp/" (get-environment-variable "USER") "/" (string-translate (current-directory) "/" "_")))))
;;                 (target-db (conc temp-dir "/cached.db"))
;;                 (source-db (args:get-arg "-source-db")))        
;;            (db:cache-for-read-only source-db target-db)
;;            (set! *didsomething* #t)))
;;      
;;      ;; handle a clean-cache request as early as possible
;;      ;;
;;      (if (args:get-arg "-clean-cache")
;;          (let ((toppath  (launch:setup)))
;;            (set! *didsomething* #t) ;; suppress the help output.
;;            (runs:clean-cache (common:args-get-target)
;;      			(args:get-arg "-runname")
;;      			toppath)))
;;      	  
;;      (if (args:get-arg "-env2file")
;;          (begin
;;            (save-environment-as-files (args:get-arg "-env2file"))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-list-disks")
;;          (let ((toppath (launch:setup)))
;;            (print 
;;             (string-intersperse 
;;      	(map (lambda (x)
;;      	       (string-intersperse 
;;      		x
;;      		" => "))
;;      	     (common:get-disks *configdat*))
;;      	"\n"))
;;            (set! *didsomething* #t)))
;;      
;;      
;;   (if (args:get-arg "-refdb2dat")
;;          (let* ((input-db (args:get-arg "-refdb2dat"))
;;      	   (out-file (args:get-arg "-o"))
;;      	   (out-fmt  (or (args:get-arg "-dumpmode") "scheme"))
;;      	   (out-port (if (and out-file 
;;      			      (not (member out-fmt '("sqlite3" "csv"))))
;;      			 (open-output-file out-file)
;;      			 (current-output-port)))
;;      	   (res-data (configf:read-refdb input-db))
;;      	   (data     (car res-data))
;;      	   (msg      (cadr res-data)))
;;            (if (not data)
;;      	  (debug:print 0 *default-log-port* "Bad input? data=" data) ;; some error occurred
;;      	  (with-output-to-port out-port
;;      	    (lambda ()
;;      	      (case (string->symbol out-fmt)
;;      		((scheme)(pp data))
;;      		((perl)
;;      		 ;; (print "%hash = (")
;;      		 ;;        key1 => 'value1',
;;      		 ;;        key2 => 'value2',
;;      		 ;;        key3 => 'value3',
;;      		 ;; );
;;      		 (configf:map-all-hier-alist 
;;      		  data 
;;      		  (lambda (sheetname sectionname varname val)
;;      		    (print "$data{\"" sheetname "\"}{\"" sectionname "\"}{\"" varname "\"} = \"" val "\";"))))
;;      		((python ruby)
;;      		 (print "data={}")
;;      		 (configf:map-all-hier-alist
;;      		  data
;;      		  (lambda (sheetname sectionname varname val)
;;      		    (print "data[\"" sheetname "\"][\"" sectionname "\"][\"" varname "\"] = \"" val "\""))
;;      		  initproc1:
;;      		  (lambda (sheetname)
;;      		    (print "data[\"" sheetname "\"] = {}"))
;;      		  initproc2:
;;      		  (lambda (sheetname sectionname)
;;      		    (print "data[\"" sheetname "\"][\"" sectionname "\"] = {}"))))
;;      		((csv)
;;      		 (let* ((results  (make-hash-table)) ;; (make-sparse-array)))
;;      			(row-cols (make-hash-table))) ;; hash of hashes where section => ht { row-<name> => num or col-<name> => num
;;      		   ;; (print "data=")
;;      		   ;; (pp data)
;;      		   (configf:map-all-hier-alist
;;      		    data
;;      		    (lambda (sheetname sectionname varname val)
;;      		      ;; (print "sheetname: " sheetname ", sectionname: " sectionname ", varname: " varname ", val: " val)
;;      		      (let* ((dat      (get-dat results sheetname))
;;      			     (vec      (refdb:csv-get-svec dat))
;;      			     (rownames (refdb:csv-get-rows dat))
;;      			     (colnames (refdb:csv-get-cols dat))
;;      			     (currrown (hash-table-ref/default rownames varname #f))
;;      			     (currcoln (hash-table-ref/default colnames sectionname #f))
;;      			     (rown     (or currrown 
;;      					   (let* ((lastn   (refdb:csv-get-maxrow dat))
;;      						  (newrown (+ lastn 1)))
;;      					     (refdb:csv-set-maxrow! dat newrown)
;;      					     newrown)))
;;      			     (coln     (or currcoln 
;;      					   (let* ((lastn   (refdb:csv-get-maxcol dat))
;;      						  (newcoln (+ lastn 1)))
;;      					     (refdb:csv-set-maxcol! dat newcoln)
;;      					     newcoln))))
;;      			(if (not (sparse-array-ref vec 0 coln)) ;; (eq? rown 0)
;;      			    (begin
;;      			      (sparse-array-set! vec 0 coln sectionname)
;;      			      ;; (print "sparse-array-ref " 0 "," coln "=" (sparse-array-ref vec 0 coln))
;;      			      ))
;;      			(if (not (sparse-array-ref vec rown 0)) ;; (eq? coln 0)
;;      			    (begin
;;      			      (sparse-array-set! vec rown 0 varname)
;;      			      ;; (print "sparse-array-ref " rown "," 0 "=" (sparse-array-ref vec rown 0))
;;      			      ))
;;      			(if (not currrown)(hash-table-set! rownames varname rown))
;;      			(if (not currcoln)(hash-table-set! colnames sectionname coln))
;;      			;; (print "dat=" dat ", rown=" rown ", coln=" coln)
;;      			(sparse-array-set! vec rown coln val)
;;      			;; (print "sparse-array-ref " rown "," coln "=" (sparse-array-ref vec rown coln))
;;      			)))
;;      		   (for-each
;;      		    (lambda (sheetname)
;;      		      (let* ((sheetdat (get-dat results sheetname))
;;      			     (svec     (refdb:csv-get-svec sheetdat))
;;      			     (maxrow   (refdb:csv-get-maxrow sheetdat))
;;      			     (maxcol   (refdb:csv-get-maxcol sheetdat))
;;      			     (fname    (if out-file 
;;      					   (string-substitute "%s" sheetname out-file) ;; "/foo/bar/%s.csv")
;;      					   (conc sheetname ".csv"))))
;;      			(with-output-to-file fname
;;      			  (lambda ()
;;      			    ;; (print "Sheetname: " sheetname)
;;      			    (let loop ((row       0)
;;      				       (col       0)
;;      				       (curr-row '())
;;      				       (result   '()))
;;      			      (let* ((val (sparse-array-ref svec row col))
;;      				     (disp-val (if val
;;      						   (conc "\"" val "\"")
;;      						   "")))
;;      				(if (> col 0)(display ","))
;;      				(display disp-val)
;;      				(cond
;;      				 ((> row maxrow)(display "\n") result)
;;      				 ((>= col maxcol)
;;      				  (display "\n")
;;      				  (loop (+ row 1) 0 '() (append result (list curr-row))))
;;      				 (else
;;      				  (loop row (+ col 1) (append curr-row (list val)) result)))))))))
;;      		    (hash-table-keys results))))
;;      		((sqlite3)
;;      		 (let* ((db-file   (or out-file (pathname-file input-db)))
;;      			(db-exists (common:file-exists? db-file))
;;      			(db        (sqlite3:open-database db-file)))
;;      		   (if (not db-exists)(sqlite3:execute db "CREATE TABLE data (sheet,section,var,val);"))
;;      		   (configf:map-all-hier-alist
;;      		    data
;;      		    (lambda (sheetname sectionname varname val)
;;      		      (sqlite3:execute db
;;      				       "INSERT OR REPLACE INTO data (sheet,section,var,val) VALUES (?,?,?,?);"
;;      				       sheetname sectionname varname val)))
;;      		   (sqlite3:finalize! db)))
;;      		(else
;;      		 (pp data))))))
;;            (if out-file (close-output-port out-port))
;;            (exit) ;; yes, bending the rules here - need to exit since this is a utility
;;            ))
;; 
;;   ;; disabled for now
;;   
;;      #;(if (args:get-arg "-ping")
;;          (let* ((server-id     (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
;;      	   (host:port     (args:get-arg "-ping")))
;;            (server-ready? (or server-id host:port) #f do-exit: #t)))
;;      
;;      ;;======================================================================
;;      ;; Capture, save and manipulate environments
;;      ;;======================================================================
;;      
;;      ;; NOTE: Keep these above the section where the server or client code is setup
;;      
;;      (let ((envcap (args:get-arg "-envcap")))
;;        (if envcap
;;            (let* ((db      (env:open-db (if (null? remargs) "envdat.db" (car remargs)))))
;;      	(env:save-env-vars db envcap)
;;      	(env:close-database db)
;;      	(set! *didsomething* #t))))
;;      
;;      ;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b 
;;      ;;
;;      (let ((envdelta (args:get-arg "-envdelta")))
;;        (if envdelta
;;            (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta)))
;;      	(if (not (null? match))
;;      	    (let* ((db        (env:open-db (if (null? remargs) "envdat.db" (car remargs))))
;;      		   ;; (resctx    (cadr match))
;;      		   ;; (equn      (caddr match))
;;      		   (parts     match) ;; (string-split equn "-"))
;;      		   (minuend   (car parts))
;;      		   (subtraend (cadr parts))
;;      		   (added     (env:get-added   db minuend subtraend))
;;      		   (removed   (env:get-removed db minuend subtraend))
;;      		   (changed   (env:get-changed db minuend subtraend)))
;;      	      ;; (pp (hash-table->alist added))
;;      	      ;; (pp (hash-table->alist removed))
;;      	      ;; (pp (hash-table->alist changed))
;;      	      (if (args:get-arg "-o")
;;      		  (with-output-to-file
;;      		      (args:get-arg "-o")
;;      		    (lambda ()
;;      		      (env:print added removed changed)))
;;      		  (env:print added removed changed))
;;      	      (env:close-database db)
;;      	      (set! *didsomething* #t))
;;      	    (debug:print-error 0 *default-log-port* "Parameter to -envdelta should be new=start-end")))))
;;      
;;      ;;======================================================================
;;      ;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;      ;;   we start the server if not running else start the client thread
;;      ;;======================================================================
;;      
;;      ;; Server? Start up here.
;;      ;;
;;      (if (args:get-arg "-server")
;; 	 (if  (not (args:get-arg "-db"))
;; 	      (debug:print 0 *default-log-port* "ERROR: -db required to start server")
;; 	      (let ((tl        (launch:setup))
;; 		    (dbname    (args:get-arg "-db"))) ;; transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
;; 		(rmt:server-launch dbname)
;; 		(set! *didsomething* #t))))
;; 	 
;;      ;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
;;      ;; a specific Megatest area. Detail are being hashed out and this may change.
;;      ;;
;;      (if (args:get-arg "-adjutant")
;;          (begin
;;            (adjutant-run)
;;            (set! *didsomething* #t)))
;;      
;;      (if (or (args:get-arg "-list-servers")
;;              (args:get-arg "-kill-servers"))
;;          (let ((tl (launch:setup)))
;;            (if tl ;; all roads from here exit
;;      	  (let* ((servers (rmt:get-servers-info *toppath*))
;;      		 (fmtstr  "~8a~22a~20a~20a~8a\n"))
;; 	    ;; id INTEGER PRIMARY KEY,
;; 	    ;; host TEXT,
;; 	    ;; port INTEGER,
;; 	    ;; servkey TEXT,
;; 	    ;; pid TEXT,
;; 	    ;; ipaddr TEXT,
;; 	    ;; apath TEXT,
;; 	    ;; dbname TEXT,
;; 	    ;; event_time 
;;      	    (format #t fmtstr "pid" "Interface:port" "State" "dbname" "apath")
;;      	    (format #t fmtstr "===" "==============" "=====" "======" "=====")
;;      	    (for-each ;;  ( mod-time host port start-time pid )
;;      	     (lambda (server)
;; 	       (match-let
;; 		(((id host port servkey pid ipaddr apath dbname event_time) server))
;;      		(format #t
;;      			fmtstr
;;      			pid
;;      			(conc host":"port)
;;      			(if (server-ready? host port servkey) "Running" "Dead")
;;      			dbname ;; (seconds->hr-min-sec mod)
;;      			apath
;; 			)
;;      		 (if (args:get-arg "-kill-servers")
;;      		     (begin
;;      		       (debug:print-info 0 *default-log-port* "Attempting to kill server with pid " pid " !!needs completion!!")
;;      		       #;(server:kill server)))))
;;      	     servers)
;;      	    ;; (debug:print-info 1 *default-log-port* "Done with listservers")
;;      	    (set! *didsomething* #t)
;;      	    (exit))
;;      	  (exit))))
;;            ;; must do, would have to add checks to many/all calls below
;;      
;;      ;;======================================================================
;;      ;; Weird special calls that need to run *after* the server has started?
;;      ;;======================================================================
;;      
;;      (if (args:get-arg "-list-targets")
;;          (if (launch:setup)
;;              (let* ((rconfdat (configf:read-config (conc *toppath* "/runconfigs.config") #f #f))
;; 		    (targets  (common:get-runconfig-targets rconfdat)))
;;                ;; (debug:print 1 *default-log-port* "Found "(length targets) " targets")
;;                (case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
;;                  ((alist)
;;                   (for-each (lambda (x)
;;                               ;; (print "[" x "]"))
;;                               (print x))
;;                             targets))
;;                  ((json)
;;                   (json-write targets))
;;                  (else
;;                   (debug:print-error 0 *default-log-port* "dump output format " (args:get-arg "-dumpmode") " not supported for -list-targets")))
;;                (set! *didsomething* #t))))
;; 
;; 
;;      (if (args:get-arg "-show-runconfig")
;;          (let ((tl (launch:setup)))
;;            (push-directory *toppath*)
;;            (let ((data (full-runconfigs-read)))
;;      	;; keep this one local
;;      	(cond
;;      	 ((and (args:get-arg "-section")
;;      	       (args:get-arg "-var"))
;;      	  (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))
;;      			 (configf:lookup data "default" (args:get-arg "-var")))))
;;      	    (if val (print val))))
;;      	 ((or (not (args:get-arg "-dumpmode"))
;;                    (string=? (args:get-arg "-dumpmode") "ini"))
;;      	  (configf:config->ini data))
;;      	 ((string=? (args:get-arg "-dumpmode") "sexp")
;;      	  (pp (hash-table->alist data)))
;;      	 ((string=? (args:get-arg "-dumpmode") "json")
;;      	  (json-write data))
;;      	 (else
;;      	  (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
;;      	(set! *didsomething* #t))
;;            (pop-directory)))
;;      
;;      (if (args:get-arg "-show-config")
;;          (let ((tl   (launch:setup))
;;      	  (data *configdat*)) ;; (configf:read-config "megatest.config" #f #t)))
;;            (push-directory *toppath*)
;;            ;; keep this one local
;;            (cond 
;;             ((and (args:get-arg "-section")
;;      	     (args:get-arg "-var"))
;;      	(let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))
;;      	  (if val (print val))))
;;      
;;             ;; print just a section if only -section
;;      
;;             ((equal? (args:get-arg "-dumpmode") "sexp")
;;      	(pp (hash-table->alist data)))
;;             ((equal? (args:get-arg "-dumpmode") "json")
;;      	(json-write data))
;;             ((or (not (args:get-arg "-dumpmode"))
;;      	    (string=? (args:get-arg "-dumpmode") "ini"))
;;      	(configf:config->ini data))
;;             (else
;;      	(debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
;;            (set! *didsomething* #t)
;;            (pop-directory)
;;            (bdat-time-to-exit-set! *bdat* #t)))
;;      
;;      (if (args:get-arg "-show-cmdinfo")
;;          (if (or (args:get-arg ":value")(get-environment-variable "MT_CMDINFO"))
;;      	(let ((data (common:read-encoded-string (or (args:get-arg ":value")(get-environment-variable "MT_CMDINFO")))))
;;      	  (if (equal? (args:get-arg "-dumpmode") "json")
;;      	      (json-write data)
;;      	      (pp data))
;;      	  (set! *didsomething* #t))
;;      	(debug:print-info 0 *default-log-port* "environment variable MT_CMDINFO is not set")))
;;      
;;      ;;======================================================================
;;      ;; Remove old run(s)
;;      ;;======================================================================
;;      
;;      ;; since several actions can be specified on the command line the removal
;;      ;; is done first
;;      (define (operate-on action #!key (mode #f)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default"
;;        (let* ((runrec (runs:runrec-make-record))
;;      	 (target (or target-in   (common:args-get-target))) ;; eventually get rid of the call to common:args-get-target
;;      	 (runname (or runname-in
;;      		      (args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
;;      	 (testpatt (or (args:get-arg "-testpatt")
;;      		       (and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
;;      			    (common:get-full-test-name))
;;      		       (and (eq? action 'kill-runs)
;;      			    "%/%") ;; I'm just guessing that this is correct :(
;;      		       (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
;;      		       ))) ;;
;;          (cond
;;           ((not target)
;;            (debug:print-error 0 *default-log-port* "Missing required parameter for "
;;      			 action ", you must specify -target or -reqtarg")
;;            (exit 1))
;;           ((not runname)
;;            (debug:print-error 0 *default-log-port* "Missing required parameter for "
;;      			 action ", you must specify the run name pattern with -runname patt")
;;            (exit 2))
;;           ((not testpatt)
;;            (debug:print-error 0 *default-log-port* "Missing required parameter for "
;;      			 action ", you must specify the test pattern with -testpatt")
;;            (exit 3))
;;           (else
;;            (if (not (car *configinfo*))
;;      	  (begin
;;      	    (debug:print-error 0 *default-log-port* "Attempted " action "on test(s) but run area config file not found")
;;      	    (exit 1))
;;      	  ;; put test parameters into convenient variables
;;      	  (begin
;;      	    ;; check for correct version, exit with message if not correct
;; 
;; 	    ;; TODO: restore this functionality
;; 	    
;; 	    ;; (common:exit-on-version-changed)
;; 	    
;;      	    (runs:operate-on  action
;;      			      target
;;      			      runname
;;      			      testpatt
;;      			      state:  (common:args-get-state)
;;      			      status: (common:args-get-status)
;;      			      new-state-status: (args:get-arg "-set-state-status")
;;                                    mode: mode)))
;;            (set! *didsomething* #t)))))
;;      
;;      (if (args:get-arg "-kill-runs")
;;          (general-run-call 
;;           "-kill-runs"
;;           "kill runs"
;;           (lambda (target runname keys keyvals)
;;             (operate-on 'kill-runs mode: #f)
;;             )))
;;      
;;      (if (args:get-arg "-kill-rerun")
;;          (let* ((target-patt (common:args-get-target))
;;                 (runname-patt (args:get-arg "-runname")))
;;            (cond ((not target-patt)
;;                   (debug:print-error 0 *default-log-port* "Missing target, must specify target for -kill-rerun with -target <target name>")
;;                   (exit 1))
;;                  ((not runname-patt)
;;                   (debug:print-error 0 *default-log-port* "Missing runname, must specify runname for -kill-rerun with -runname <run name>")
;;                   (exit 1))
;;                  ((string-search "[ ,%]" target-patt)
;;                   (debug:print-error 0 *default-log-port* "Invalid target ["target-patt"], must specify exact target (no wildcards) for -kill-rerun with -target <target name>")
;;                   (exit 1))
;;                  ((string-search "[ ,%]" runname-patt)
;;                   (debug:print-error 0 *default-log-port* "Invalid runname ["runname-patt"], must specify exact runname (no wildcards) for -kill-rerun with -runname <runname name>")
;;                   (exit 1))
;;                  (else
;;                   (general-run-call 
;;                    "-kill-runs"
;;                    "kill runs"
;;                    (lambda (target runname keys keyvals)
;;                      (operate-on 'kill-runs mode: #f)
;;                      ))
;;            
;;                   (thread-sleep! 15))
;;                  ;; fall thru and let "-run" loop fire
;;                  )))
;;      
;;      
;;      (if (args:get-arg "-remove-runs")
;;          (general-run-call 
;;           "-remove-runs"
;;           "remove runs"
;;           (lambda (target runname keys keyvals)
;;             (operate-on 'remove-runs mode: (if (args:get-arg "-keep-records")
;;                                                'remove-data-only
;;                                                'remove-all)))))
;;      
;;      (if (args:get-arg "-remove-keep")
;;          (general-run-call 
;;           "-remove-keep"
;;           "remove keep"
;;           (lambda (target runname keys keyvals)
;;             (let ((actions (map string->symbol
;;                                 (string-split
;;      			    (or (args:get-arg "-actions")
;;      				"print")
;;      			    ",")))) ;; default to printing the output
;;               (runs:remove-all-but-last-n-runs-per-target target runname
;;      						     (string->number (args:get-arg "-remove-keep"))
;;      						     actions: actions)))))
;;      
;;      (if (args:get-arg "-set-state-status")
;;          (general-run-call 
;;           "-set-state-status"
;;           "set state and status"
;;           (lambda (target runname keys keyvals)
;;             (operate-on 'set-state-status))))
;;      
;;      (if (or (args:get-arg "-set-run-status")
;;      	(args:get-arg "-get-run-status"))
;;          (general-run-call
;;           "-set-run-status"
;;           "set run status"
;;           (lambda (target runname keys keyvals)
;;             (let* ((runsdat  (rmt:get-runs-by-patt keys runname 
;;      					(common:args-get-target)
;;      					#f #f #f #f))
;;      	      (header   (vector-ref runsdat 0))
;;      	      (rows     (vector-ref runsdat 1)))
;;      	 (if (null? rows)
;;      	     (begin
;;      	       (debug:print-info 0 *default-log-port* "No matching run found.")
;;      	       (exit 1))
;;      	     (let* ((row      (car (vector-ref runsdat 1)))
;;      		    (run-id   (db:get-value-by-header row header "id")))
;;      	       (if (args:get-arg "-set-run-status")
;;      		   (rmt:set-run-status run-id (args:get-arg "-set-run-status") msg: (args:get-arg "-m"))
;;      		   (print (rmt:get-run-status run-id))
;;      		   )))))))
;;      
;;      ;;======================================================================
;;      ;; Query runs
;;      ;;======================================================================
;;      
;;      ;; -fields runs:id,target,runname,comment+tests:id,testname,item_path+steps
;;      ;;
;;      ;; csi> (extract-fields-constraints "runs:id,target,runname,comment+tests:id,testname,item_path+steps")
;;      ;;         => (("runs" "id" "target" "runname" "comment") ("tests" "id" "testname" "item_path") ("steps"))
;;      ;;
;;      ;;   NOTE: remember that the cdr will be the list you expect (cdr ("runs" "id" "target" "runname" "comment")) => ("id" "target" "runname" "comment")
;;      ;;         and so alist-ref will yield what you expect
;;      ;;
;;      (define (extract-fields-constraints fields-spec)
;;        (map (lambda (table-spec) ;; runs:id,target,runname
;;      	 (let ((dat (string-split table-spec ":"))) ;; ("runs" "id,target,runname")
;;      	   (if (> (length dat) 1)
;;      	       (cons (car dat)(string-split (cadr dat) ",")) ;; "id,target,runname"
;;      	       dat)))
;;             (string-split fields-spec "+")))
;;      
;;      (define (get-value-by-fieldname datavec test-field-index fieldname)
;;        (let ((indx (hash-table-ref/default test-field-index fieldname #f)))
;;          (if indx
;;      	(if (>= indx (vector-length datavec))
;;      	    #f ;; index too high, should raise an error I suppose
;;      	    (vector-ref datavec indx))
;;      	#f)))
;;      
;;      
;;      
;;      
;;      
;;      (when (args:get-arg "-testdata-csv")
;;        (if (launch:setup)
;;            (let* ((keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
;;                   (runpatt     (or (args:get-arg "-runname") "%"))
;;                   (testpatt    (common:args-get-testpatt #f))
;;                   (datapatt    (args:get-arg "-testdata-csv"))
;;                   (match-data  (string-match "^([^/]+)/(.*)" (args:get-arg "-testdata-csv")))
;;                   (categorypatt (if match-data (list-ref match-data 1) "%"))
;;                   (setvarpatt  (if match-data
;;                                    (list-ref match-data 2)
;;                                    (args:get-arg "-testdata-csv")))
;;                   (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") 
;;                                                      (common:args-get-target) #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
;;                   (header      (db:get-header runsdat))
;;                   (access-mode (db:get-access-mode))
;;                   (testpatt    (common:args-get-testpatt #f))
;;                   (fields-spec (if (args:get-arg "-fields")
;;                                    (extract-fields-constraints (args:get-arg "-fields"))
;;                                    (list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")))
;;                                          (cons "tests"  db:test-record-fields) ;; "id" "testname" "test_path")
;;                                          (list "steps" "id" "stepname"))))
;;                   (tests-spec  (let ((t (alist-ref "tests" fields-spec equal?)))
;;                                  (if (and t (null? t)) ;; all fields
;;                                      db:test-record-fields
;;                                      t)))
;;                   (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) 
;;                   (test-field-index (make-hash-table))
;;                   (runs (db:get-rows runsdat))
;;                   )
;;              (if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec
;;                  (let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec)))
;;                    (if (null? invalid-tests-spec)
;;                        ;; generate the lookup map test-field-name => index-number
;;                        (let loop ((hed (car adj-tests-spec))
;;                                   (tal (cdr adj-tests-spec))
;;                                   (idx 0))
;;                          (hash-table-set! test-field-index hed idx)
;;                          (if (not (null? tal))(loop (car tal)(cdr tal)(+ idx 1))))
;;                        (begin
;;                          (debug:print-error 0 *default-log-port* "Invalid test fields specified: " (string-intersperse invalid-tests-spec ", "))
;;                          (exit)))))
;;              (let* ((table-header (string-split "target,run,test,itempath,category,var,value,comment" ","))
;;                     (table-rows
;;                      (apply append (map  
;;                                     (lambda (run)
;;                                       (let* ((target (string-intersperse (map (lambda (x)
;;      							 (db:get-value-by-header run header x))
;;      						       keys) "/"))
;;                                              (statuses (string-split (or (args:get-arg "-status") "") ","))
;;                                              (run-id  (db:get-value-by-header run header "id"))
;;                                              (runname (db:get-value-by-header run header "runname")) 
;;                                              (states  (string-split (or (args:get-arg "-state") "") ","))
;;                                              (tests   (if tests-spec
;;                                                           (rmt:get-tests-for-run run-id testpatt states statuses #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
;;                                                                              ;; use qryvals if test-spec provided
;;                                                                              (if tests-spec
;;                                                                                  (string-intersperse adj-tests-spec ",")
;;                                                                                  ;; db:test-record-fields
;;                                                                                  #f)
;;                                                                              #f
;;                                                                              'normal)
;;                                                           '())))
;;                                         (apply append
;;                                                (map
;;                                                 (lambda (test)
;;                                                   (let* (
;;                                                          (test-id      (if (member "id"           tests-spec)(get-value-by-fieldname test test-field-index "id"          ) #f)) ;; (db:test-get-id         test))
;;                                                          (testname     (if (member "testname"     tests-spec)(get-value-by-fieldname test test-field-index "testname"    ) #f)) ;; (db:test-get-testname   test))
;;                                                          (itempath     (if (member "item_path"    tests-spec)(get-value-by-fieldname test test-field-index "item_path"   ) #f)) ;; (db:test-get-item-path  test))
;;                                                          (fullname     (conc testname
;;                                                                              (if (equal? itempath "")
;;                                                                                  "" 
;;                                                                                  (conc "/" itempath ))))
;;                                                          (testdat-raw (map vector->list (rmt:read-test-data-varpatt run-id test-id categorypatt setvarpatt)))
;;                                                          (testdat (filter
;;                                                                    (lambda (x)
;;                                                                      (not (equal? "logpro"
;;                                                                                   (list-ref x 10))))
;;                                                                    testdat-raw)))
;;                                                     (map 
;;                                                      (lambda (item)
;;                                                        (receive (id test_id category
;;                                                                     variable value expected
;;                                                                     tol units comment status type)
;;                                                            (apply values item)
;;                                                          (list target runname testname itempath category variable value comment)))
;;                                                      testdat)))
;;                                                 tests))))
;;                                     runs))))
;;                (print (string-join table-header ","))
;;                (for-each (lambda(table-row)
;;                            (print (string-join (map ->string table-row) ",")))
;;      
;;                          
;;                                  table-rows))))
;;        (set! *didsomething* #t)
;;        (bdat-time-to-exit-set! *bdat* #t))
;;      
;;      
;;      
;;      ;; NOTE: list-runs and list-db-targets operate on local db!!!
;;      ;;
;;      ;; IDEA: megatest list -runname blah% ...
;;      ;;
;;      (if (or (args:get-arg "-list-runs")
;;      	(args:get-arg "-list-db-targets"))
;;          (if (launch:setup)
;;      	(let* (;; (dbstruct    (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
;;      	       (runpatt     (args:get-arg "-list-runs"))
;;                     (access-mode (db:get-access-mode))
;;      	       (testpatt    (common:args-get-testpatt #f))
;;      	       ;; (if (args:get-arg "-testpatt") 
;;      	       ;;  	        (args:get-arg "-testpatt") 
;;      	       ;;  	        "%"))
;;      	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
;;      	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
;;      	;; (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
;;      	;; 		           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
;;      	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") 
;;                                                        (common:args-get-target) #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
;;      	       (runstmp     (db:get-rows runsdat))
;;      	       (header      (db:get-header runsdat))
;;      	       ;; this is "-since" support. This looks at last mod times of <run-id>.db files
;;      	       ;; and collects those modified since the -since time.
;;      	       (runs        runstmp)
;;                              ;; (if (and (not (null? runstmp))
;;      			;;        (args:get-arg "-since"))
;;      			;;   (let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
;;      			;;     (let loop ((hed (car runstmp))
;;      			;;   	     (tal (cdr runstmp))
;;      			;;   	     (res '()))
;;      			;;       (let ((new-res (if (member (db:get-value-by-header hed header "id") changed-ids)
;;      			;;   		       (cons hed res)
;;      			;;   		       res)))
;;      			;;         (if (null? tal)
;;      			;;   	  (reverse new-res)
;;      			;;   	  (loop (car tal)(cdr tal) new-res)))))
;;      			;;   runstmp))
;;      	       (db-targets  (args:get-arg "-list-db-targets"))
;;      	       (seen        (make-hash-table))
;;      	       (dmode       (let ((d (args:get-arg "-dumpmode"))) ;; json, sexpr
;;      			      (if d (string->symbol d) #f)))
;;      	       (data        (make-hash-table))
;;      	       (fields-spec (if (args:get-arg "-fields")
;;      				(extract-fields-constraints (args:get-arg "-fields"))
;;      				(list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")))
;;      				      (cons "tests"  db:test-record-fields) ;; "id" "testname" "test_path")
;;      				      (list "steps" "id" "stepname"))))
;;      	       (runs-spec   (let ((r (alist-ref "runs"  fields-spec equal?))) ;; the check is now unnecessary
;;      			      (if (and r (not (null? r))) r (list "id" ))))
;;      	       (tests-spec  (let ((t (alist-ref "tests" fields-spec equal?)))
;;      			      (if (and t (null? t)) ;; all fields
;;      				  db:test-record-fields
;;      				  t)))
;;      	       (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id"))))
;;      	       (steps-spec  (alist-ref "steps" fields-spec equal?))
;;      	       (test-field-index (make-hash-table)))
;;      	  (if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec
;;      	      (let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec)))
;;      		(if (null? invalid-tests-spec)
;;      		    ;; generate the lookup map test-field-name => index-number
;;      		    (let loop ((hed (car adj-tests-spec))
;;      			       (tal (cdr adj-tests-spec))
;;      			       (idx 0))
;;      		      (hash-table-set! test-field-index hed idx)
;;      		      (if (not (null? tal))(loop (car tal)(cdr tal)(+ idx 1))))
;;      		    (begin
;;      		      (debug:print-error 0 *default-log-port* "Invalid test fields specified: " (string-intersperse invalid-tests-spec ", "))
;;      		      (exit)))))
;;      	  ;; Each run
;;      	  (for-each 
;;      	   (lambda (run)
;;      	     (let ((targetstr (string-intersperse (map (lambda (x)
;;      							 (db:get-value-by-header run header x))
;;      						       keys) "/")))
;;      	       (if db-targets
;;      		   (if (not (hash-table-ref/default seen targetstr #f))
;;      		       (begin
;;      			 (hash-table-set! seen targetstr #t)
;;      			 ;; (print "[" targetstr "]"))))
;;      			 (if (not dmode)
;;      			     (print targetstr)
;;      			     (hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '())))
;;      			     )))
;;      		   (let* ((run-id  (db:get-value-by-header run header "id"))
;;      			  (runname (db:get-value-by-header run header "runname")) 
;;      			  (states  (string-split (or (args:get-arg "-state") "") ","))
;;      			  (statuses (string-split (or (args:get-arg "-status") "") ","))
;;      			  (tests   (if tests-spec
;;      				       (rmt:get-tests-for-run run-id testpatt states statuses #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
;;      							     ;; use qryvals if test-spec provided
;;      							     (if tests-spec
;;      								 (string-intersperse adj-tests-spec ",")
;;      								 ;; db:test-record-fields
;;      								 #f)
;;      							     #f
;;      							     'normal)
;;      				       '())))
;;      		     (case dmode
;;      		       ((json ods sexpr)
;;      			(if runs-spec
;;      			    (for-each 
;;      			     (lambda (field-name)
;;      			       (mutils:hierhash-set! data (conc (db:get-value-by-header run header field-name)) targetstr runname "meta" field-name))
;;      			     runs-spec)))
;;      			;; (mutils:hierhash-set! data (db:get-value-by-header run header "status")     targetstr runname "meta" "status"     )
;;      			;; (mutils:hierhash-set! data (db:get-value-by-header run header "state")      targetstr runname "meta" "state"      )
;;      			;; (mutils:hierhash-set! data (conc (db:get-value-by-header run header "id"))  targetstr runname "meta" "id"         )
;;      			;; (mutils:hierhash-set! data (db:get-value-by-header run header "event_time") targetstr runname "meta" "event_time" )
;;      			;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment")    targetstr runname "meta" "comment"    )
;;      			;; ;; add last entry twice - seems to be a bug in hierhash?
;;      			;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment")    targetstr runname "meta" "comment"    )
;;      		       (else
;;      			(if (null? runs-spec)
;;      			    (print "Run: " targetstr "/" runname 
;;      				   " status: " (db:get-value-by-header run header "state")
;;      				   " run-id: " run-id ", number tests: " (length tests)
;;      				   " event_time: " (db:get-value-by-header run header "event_time"))
;;      			    (begin
;;      			      (if (not (member "target" runs-spec))
;;      			          ;; (display (conc "Target: " targetstr))
;;      			          (display (conc "Run: " targetstr "/" runname " ")))
;;      			      (for-each
;;      			       (lambda (field-name)
;;      				 (if (equal? field-name "target")
;;      				     (display (conc "target: " targetstr " "))
;;      				     (display (conc field-name ": " (db:get-value-by-header run header (conc field-name)) " "))))
;;      			       runs-spec)
;;      			      (newline)))))
;;      		       
;;      		     (for-each 
;;      		      (lambda (test)
;;      		      	(handle-exceptions
;;      			 exn
;;      			 (begin
;;      			   (debug:print-error 0 *default-log-port* "Bad data in test record? " test)
;;      			   (debug:print-error 5 *default-log-port* "exn=" (condition->list exn))
;;      			   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;;      			   (print-call-chain (current-error-port)))
;;      			 (let* ((test-id      (if (member "id"           tests-spec)(get-value-by-fieldname test test-field-index "id"          ) #f)) ;; (db:test-get-id         test))
;;      				(testname     (if (member "testname"     tests-spec)(get-value-by-fieldname test test-field-index "testname"    ) #f)) ;; (db:test-get-testname   test))
;;      				(itempath     (if (member "item_path"    tests-spec)(get-value-by-fieldname test test-field-index "item_path"   ) #f)) ;; (db:test-get-item-path  test))
;;      				(comment      (if (member "comment"      tests-spec)(get-value-by-fieldname test test-field-index "comment"     ) #f)) ;; (db:test-get-comment    test))
;;      				(tstate       (if (member "state"        tests-spec)(get-value-by-fieldname test test-field-index "state"       ) #f)) ;; (db:test-get-state      test))
;;      				(tstatus      (if (member "status"       tests-spec)(get-value-by-fieldname test test-field-index "status"      ) #f)) ;; (db:test-get-status     test))
;;      				(event-time   (if (member "event_time"   tests-spec)(get-value-by-fieldname test test-field-index "event_time"  ) #f)) ;; (db:test-get-event_time test))
;;      				(rundir       (if (member "rundir"       tests-spec)(get-value-by-fieldname test test-field-index "rundir"      ) #f)) ;; (db:test-get-rundir     test))
;;      				(final_logf   (if (member "final_logf"   tests-spec)(get-value-by-fieldname test test-field-index "final_logf"  ) #f)) ;; (db:test-get-final_logf test))
;;      				(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test))
;;      				(fullname     (conc testname
;;      						    (if (equal? itempath "")
;;      							"" 
;;      							(conc "(" itempath ")")))))
;;      			   (case dmode
;;      			     ((json ods sexpr)
;;      			      (if tests-spec
;;      				  (for-each
;;      				   (lambda (field-name)
;;      				     (mutils:hierhash-set! data  (get-value-by-fieldname test test-field-index field-name) targetstr runname "data" (conc test-id) field-name))
;;      				   tests-spec)))
;;      			     ;; ;; (mutils:hierhash-set! data  fullname   targetstr runname "data" (conc test-id) "tname"     )
;;      			     ;;  (mutils:hierhash-set! data  testname   targetstr runname "data" (conc test-id) "testname"  )
;;      			     ;;  (mutils:hierhash-set! data  itempath   targetstr runname "data" (conc test-id) "itempath"  )
;;      			     ;;  (mutils:hierhash-set! data  comment    targetstr runname "data" (conc test-id) "comment"   )
;;      			     ;;  (mutils:hierhash-set! data  tstate     targetstr runname "data" (conc test-id) "state"     )
;;      			     ;;  (mutils:hierhash-set! data  tstatus    targetstr runname "data" (conc test-id) "status"    )
;;      			     ;;  (mutils:hierhash-set! data  rundir     targetstr runname "data" (conc test-id) "rundir"    )
;;      			     ;;  (mutils:hierhash-set! data  final_logf targetstr runname "data" (conc test-id) "final_logf")
;;      			     ;;  (mutils:hierhash-set! data  run_duration targetstr runname "data" (conc test-id) "run_duration")
;;      			     ;;  (mutils:hierhash-set! data  event-time targetstr runname "data" (conc test-id) "event_time")
;;      			     ;;  ;; add last entry twice - seems to be a bug in hierhash?
;;      			     ;;  (mutils:hierhash-set! data  event-time targetstr runname "data" (conc test-id) "event_time")
;;      			     ;;  )
;;      			     (else
;;      			      (if (and tstate tstatus event-time)
;;      				  (format #t
;;      					  "  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
;;      					  (if fullname fullname "")
;;      					  (if tstate   tstate   "")
;;      					  (if tstatus  tstatus  "")
;;      					  (get-value-by-fieldname test test-field-index "run_duration");;(if test     (db:test-get-run_duration test) "")
;;      					  (if event-time event-time "")
;;      					  (get-value-by-fieldname test test-field-index "host")) ;;(if test (db:test-get-host test)) "")
;;      				  (print "  Test: " fullname
;;      					 (if tstate  (conc " State: "  tstate)  "")
;;      					 (if tstatus (conc " Status: " tstatus) "")
;;      					 (if (get-value-by-fieldname test test-field-index "run_duration")
;;      					     (conc " Runtime: " (get-value-by-fieldname test test-field-index "run_duration"))
;;      					     "")
;;      					 (if event-time (conc " Time: " event-time) "")
;;      					 (if (get-value-by-fieldname test test-field-index "host")
;;      					     (conc " Host: " (get-value-by-fieldname test test-field-index "host"))
;;      					     "")))
;;      			      (if (not (or (equal? (get-value-by-fieldname test test-field-index "status") "PASS")
;;      					   (equal? (get-value-by-fieldname test test-field-index "status") "WARN")
;;      					   (equal? (get-value-by-fieldname test test-field-index "state")  "NOT_STARTED")))
;;      				  (begin
;;      				    (print   (if (get-value-by-fieldname test test-field-index "cpuload")
;;      						 (conc "         cpuload:  "   (get-value-by-fieldname test test-field-index "cpuload"))
;;      						 "") ;; (db:test-get-cpuload test)
;;      					     (if (get-value-by-fieldname test test-field-index "diskfree")
;;      						 (conc "\n         diskfree: " (get-value-by-fieldname test test-field-index "diskfree")) ;; (db:test-get-diskfree test)
;;      						 "")
;;      					     (if (get-value-by-fieldname test test-field-index "uname")
;;      						 (conc "\n         uname:    " (get-value-by-fieldname test test-field-index "uname")) ;; (db:test-get-uname test)
;;      						 "")
;;      					     (if (get-value-by-fieldname test test-field-index "rundir")
;;      						 (conc "\n         rundir:   " (get-value-by-fieldname test test-field-index "rundir")) ;; (db:test-get-rundir test)
;;      						 "")
;;      ;;					     "\n         rundir:   " (get-value-by-fieldname test test-field-index "") ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb* 
;;      ;; 					     (db:test-get-rundir test) ;; )
;;      					     )
;;      				    ;; Each test
;;      				    ;; DO NOT remote run
;;      				    (let ((steps (rmt:get-steps-for-test run-id (db:test-get-id test)))) ;; (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
;;      				      (for-each 
;;      				       (lambda (step)
;;      					 (format #t 
;;      						 "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
;;      						 (tdb:step-get-stepname step)
;;      						 (tdb:step-get-state step)
;;      						 (tdb:step-get-status step)
;;      						 (tdb:step-get-event_time step)))
;;      				       steps)))))))))
;;      		      (if (args:get-arg "-sort")
;;      			  (sort tests
;;      				(lambda (a-test b-test)
;;      				  (let* ((key    (args:get-arg "-sort"))
;;      					 (first  (get-value-by-fieldname a-test test-field-index key))
;;      					 (second (get-value-by-fieldname b-test test-field-index key)))
;;      				    ((cond 
;;      				      ((and (number? first)(number? second)) <)
;;      				      ((and (string? first)(string? second)) string<=?)
;;      				      (else equal?))
;;      				     first second))))
;;      			  tests))))))
;;      	   runs)
;;      	  (case dmode
;;      	    ((json)  (json-write data))
;;      	    ((sexpr) (pp (common:to-alist data))))
;;      	  (let* ((metadat-fields (delete-duplicates
;;      				  (append keys '( "runname" "time" "owner" "pass_count" "fail_count" "state" "status" "comment" "id"))))
;;      		 (run-fields    '(
;;      				  "testname"
;;      				  "item_path"
;;      				  "state"
;;      				  "status"
;;      				  "comment"
;;      				  "event_time"
;;      				  "host"
;;      				  "run_id"
;;      				  "run_duration"
;;      				  "attemptnum"
;;      				  "id"
;;      				  "archived"
;;      				  "diskfree"
;;      				  "cpuload"
;;      				  "final_logf"
;;      				  "shortdir"
;;      				  "rundir"
;;      				  "uname"
;;      				  )
;;      				)
;;      		 (newdat          (common:to-alist data))
;;      		 (allrundat       (if (null? newdat)
;;      				      '()
;;      				      (car (map cdr newdat)))) ;; (car (map cdr (car (map cdr newdat)))))
;;      		 (runs            (append
;;      				   (list "runs" ;; sheetname
;;      					 metadat-fields)
;;      				   (map (lambda (run)
;;      					  ;; (print "run: " run)
;;      					  (let* ((runname (car run))
;;      						 (rundat  (cdr run))
;;      						 (metadat (let ((tmp (assoc "meta" rundat)))
;;      							    (if tmp (cdr tmp) #f))))
;;      					    ;; (print "runname: " runname "\n\nrundat: " )(pp rundat)(print "\n\nmetadat: ")(pp metadat)
;;      					    (if metadat
;;      						(map (lambda (field)
;;      						       (let ((tmp (assoc field metadat)))
;;      							 (if tmp (cdr tmp) "")))
;;      						     metadat-fields)
;;      						(begin
;;      						  (debug:print 0 *default-log-port* "WARNING: meta data for run " runname " not found")
;;      						  '()))))
;;      					allrundat)))
;;      		 ;; '( ( "target" ( "runname" ( "data" ( "runid" ( "id . "37" ) ( ... ))))
;;      		 (run-pages      (map (lambda (targdat)
;;      					(let* ((target  (car targdat))
;;      					       (runsdat (cdr targdat)))
;;      					  (if runsdat
;;      					      (map (lambda (rundat)
;;      						     (let* ((runname  (car rundat))
;;      							    (rundat   (cdr rundat))
;;      							    (testsdat (let ((tmp (assoc "data" rundat)))
;;      									(if tmp (cdr tmp) #f))))
;;      						       (if testsdat
;;      							   (let ((tests (map (lambda (test)
;;      									       (let* ((test-id  (car test))
;;      										      (test-dat (cdr test)))
;;      										 (map (lambda (field)
;;      											(let ((tmp (assoc field test-dat)))
;;      											  (if tmp (cdr tmp) "")))
;;      										      run-fields)))
;;      									     testsdat)))
;;      							     ;; (print "Target: " target "/" runname " tests:")
;;      							     ;; (pp tests)
;;      							     (cons (conc target "/" runname)
;;      								   (cons (list (conc target "/" runname))
;;      									 (cons '()
;;      									       (cons run-fields tests)))))
;;      							   (begin
;;      							     (debug:print 4 *default-log-port* "WARNING: run " target "/" runname " appears to have no data")
;;      							     ;; (pp rundat)
;;      							     '()))))
;;      						   runsdat)
;;      					      '())))
;;      				      newdat)) ;; we use newdat to get target
;;      		 (sheets         (filter (lambda (x)
;;      					   (not (null? x)))
;;      					 (cons runs (map car run-pages)))))
;;      	    ;; (print "allrundat:")
;;      	    ;; (pp allrundat)
;;      	    ;; (print "runs:")
;;      	    ;; (pp runs)
;;      	    ;(print "sheets: ")
;;      	    ;; (pp sheets)
;;      	    (if (eq? dmode 'ods)
;;      		(let* ((tempdir    (conc "/tmp/" (current-user-name) "/" (pseudo-random-integer 10000) "_" (current-process-id)))
;;      		       (outputfile (or (args:get-arg "-o") "out.ods"))
;;      		       (ouf        (if (string-match (regexp "^[/~]+.*") outputfile) ;; full path?
;;      				       outputfile
;;      				       (begin
;;      					 (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
;;      					 (conc (current-directory) "/" outputfile)))))
;;      		  (create-directory tempdir #t)
;;      		  (ods:list->ods tempdir ouf sheets))))
;;      	  ;; (system (conc "rm -rf " tempdir))
;;      	  (set! *didsomething* #t)
;; 	  (bdat-time-to-exit-set! *bdat* #t)
;; 	  ) ;; end if true branch (end of a let)
;; 	) ;; end if
;;          ) ;; end if -list-runs
;; 
;;      ;; list-waivers
;;      (if (and (args:get-arg "-list-waivers")
;;      	 (launch:setup))
;;          (let* ((runpatt     (or (args:get-arg "-runname") "%"))
;;      	   (testpatt    (common:args-get-testpatt #f))
;;      	   (keys        (rmt:get-keys)) 
;;      	   (runsdat     (rmt:get-runs-by-patt
;;      			 keys runpatt 
;;      			 (common:args-get-target) #f #f
;;      			 '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
;;      	   (runs        (db:get-rows runsdat))
;;      	   (header      (db:get-header runsdat))
;;      	   (results     (make-hash-table))  ;; [target] ( (testname/itempath . "comment") ... )
;;      	   (addtest     (lambda (target testname itempath comment)
;;      			  (hash-table-set! results target (cons (cons (conc testname "/" itempath) comment)
;;      								(hash-table-ref/default results target '())))))
;;      	   (last-target #f))
;;            (for-each
;;             (lambda (run)
;;      	 (let* ((run-id  (db:get-value-by-header run header "id"))
;;      		(target  (rmt:get-target run-id))
;;      		(runname (db:get-value-by-header run header "runname")) 
;;      		(tests   (rmt:get-tests-for-run
;;      			  run-id testpatt '("COMPLETED") '("WAIVED") #f #f #f 'testname 'asc							     ;; use qryvals if test-spec provided
;;      			  #f #f #f)))
;;      	   (if (not (equal? target last-target))
;;      	       (print "[" target "]"))
;;      	   (set! last-target target)
;;      	   (print "# " runname)
;;      	   (for-each
;;      	    (lambda (testdat)
;;      	      (let* ((testfullname (conc (db:test-get-testname testdat)
;;      					 (if (equal? "" (db:test-get-item-path testdat))
;;      					     ""
;;      					     (conc "/" (db:test-get-item-path testdat)))
;;      					 )))
;;      	      (print testfullname " " (db:test-get-comment testdat))))
;;      	    tests)))
;;             runs)
;;            (set! *didsomething* #t)))
;;            
;;      
;;      ;; get lock in db for full run for this directory
;;      ;; for all tests with deps
;;      ;;   walk tree of tests to find head tasks
;;      ;;   add head tasks to task queue
;;      ;;   add dependant tasks to task queue 
;;      ;;   add remaining tasks to task queue
;;      ;; for each task in task queue
;;      ;;   if have adequate resources
;;      ;;     launch task
;;      ;;   else
;;      ;;     put task in deferred queue
;;      ;; if still ok to run tasks
;;      ;;   process deferred tasks per above steps
;;      
;;      ;; run all tests are are Not COMPLETED and PASS or CHECK
;;      (if (or (args:get-arg "-runall")
;;      	(args:get-arg "-run")
;;      	(args:get-arg "-rerun-clean")
;;      	(args:get-arg "-rerun-all")
;;      	(args:get-arg "-runtests")
;;              (args:get-arg "-kill-rerun"))
;;          (let ((need-clean (or (args:get-arg "-rerun-clean")
;;                                (args:get-arg "-rerun-all")))
;;      	  (orig-cmdline (string-intersperse (argv) " ")))
;;            (general-run-call 
;;             "-runall"
;;             "run all tests"
;;             (lambda (target runname keys keyvals)
;;      	 (if (or (string-search "%" target)
;;      		 (string-search "%" runname)) ;; we are being asked to re-run multiple runs
;;      	     (let* ((run-specs (rmt:simple-get-runs runname #f #f target #f))) ;; list of simple-run records
;;      	       (debug:print-info 0 *default-log-port* "Pattern supplied for target or runname with "
;;      				 (length run-specs) " matches round. Running each in turn.")
;;      	       (if (null? run-specs)
;;      		   (debug:print 0 *default-log-port* "WARNING: No runs match target " target " and runname " runname))
;;      	       (for-each (lambda (spec) 
;;      			   (let* ((precmd     (if (args:get-arg "-precmd")(conc (args:get-arg "-precmd") " ") ""))
;;      				  (newcmdline (conc
;;      					       precmd
;;      					       (string-substitute
;;      						(conc "target " target)
;;      						(conc "target " (simple-run-target spec))
;;      						(string-substitute
;;      						 (conc "runname " runname)
;;      						 (conc "runname " (simple-run-runname spec))
;;      						 orig-cmdline)))))
;;      			     (debug:print 0 *default-log-port* "ORIG: " orig-cmdline)
;;      			     (debug:print 0 *default-log-port* "NEW:  " newcmdline)
;;      			     (system newcmdline)))
;;      			 run-specs))
;;      	     (handle-run-requests target runname keys keyvals need-clean))))))
;;      
;;      ;;======================================================================
;;      ;; run one test
;;      ;;======================================================================
;;      
;;      ;; 1. find the config file
;;      ;; 2. change to the test directory
;;      ;; 3. update the db with "test started" status, set running host
;;      ;; 4. process launch the test
;;      ;;    - monitor the process, update stats in the db every 2^n minutes
;;      ;; 5. as the test proceeds internally it calls megatest as each step is
;;      ;;    started and completed
;;      ;;    - step started, timestamp
;;      ;;    - step completed, exit status, timestamp
;;      ;; 6. test phone home
;;      ;;    - if test run time > allowed run time then kill job
;;      ;;    - if cannot access db > allowed disconnect time then kill job
;;      
;;      ;; == duplicated == (if (or (args:get-arg "-run")(args:get-arg "-runtests"))
;;      ;; == duplicated ==   (general-run-call 
;;      ;; == duplicated ==    "-runtests" 
;;      ;; == duplicated ==    "run a test" 
;;      ;; == duplicated ==    (lambda (target runname keys keyvals)
;;      ;; == duplicated ==      ;;
;;      ;; == duplicated ==      ;; May or may not implement it this way ...
;;      ;; == duplicated ==      ;;
;;      ;; == duplicated ==      ;; Insert this run into the tasks queue
;;      ;; == duplicated ==      ;; (open-run-close tasks:add tasks:open-db 
;;      ;; == duplicated ==      ;;    	     "runtests" 
;;      ;; == duplicated ==      ;;    	     user
;;      ;; == duplicated ==      ;;    	     target
;;      ;; == duplicated ==      ;;    	     runname
;;      ;; == duplicated ==      ;;    	     (args:get-arg "-runtests")
;;      ;; == duplicated ==      ;;    	     #f))))
;;      ;; == duplicated ==      (runs:run-tests target
;;      ;; == duplicated == 		     runname
;;      ;; == duplicated == 		     (common:args-get-testpatt #f) ;; (args:get-arg "-runtests")
;;      ;; == duplicated == 		     user
;;      ;; == duplicated == 		     args:arg-hash))))
;;      
;;      ;;======================================================================
;;      ;; Rollup into a run
;;      ;;======================================================================
;;      
;;      ;; (if (args:get-arg "-rollup")
;;      ;;     (general-run-call 
;;      ;;      "-rollup" 
;;      ;;      "rollup tests" 
;;      ;;      (lambda (target runname keys keyvals)
;;      ;;        (runs:rollup-run keys
;;      ;; 			keyvals
;;      ;; 			(or (args:get-arg "-runname")(args:get-arg ":runname") )
;;      ;; 			user))))
;;      
;;      ;;======================================================================
;;      ;; Lock or unlock a run
;;      ;;======================================================================
;;      
;;      (if (or (args:get-arg "-lock")(args:get-arg "-unlock"))
;;          (general-run-call 
;;           (if (args:get-arg "-lock") "-lock" "-unlock")
;;           "lock/unlock tests" 
;;           (lambda (target runname keys keyvals)
;;             (runs:handle-locking 
;;      		  target
;;      		  keys
;;      		  (or (args:get-arg "-runname")(args:get-arg ":runname") )
;;      		  (args:get-arg "-lock")
;;      		  (args:get-arg "-unlock")
;;      		  (bdat-user *bdat*)))))
;;      
;;      ;;======================================================================
;;      ;; Get paths to tests
;;      ;;======================================================================
;;      ;; Get test paths matching target, runname, and testpatt
;;      (if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
;;          ;; if we are in a test use the MT_CMDINFO data
;;          (if (get-environment-variable "MT_CMDINFO")
;;      	(let* ((startingdir (current-directory))
;;      	       (cmdinfo   (common:read-encoded-string (get-environment-variable "MT_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))
;;      	       (itemdat   (assoc/default 'itemdat   cmdinfo))
;;      	       (state     (args:get-arg ":state"))
;;      	       (status    (args:get-arg ":status"))
;;      	       ;;(target    (args:get-arg "-target"))
;;      	       (target    (common:args-get-target))
;;      	       (toppath   (assoc/default 'toppath   cmdinfo)))
;;      	  (change-directory toppath)
;;      	  (if (not target)
;;      	      (begin
;;      		(debug:print-error 0 *default-log-port* "-target is required.")
;;      		(exit 1)))
;;      	  (if (not (launch:setup))
;;      	      (begin
;;      		(debug:print 0 *default-log-port* "Failed to setup, giving up on -test-paths or -test-files, exiting")
;;      		(exit 1)))
;;      	  (let* ((keys     (rmt:get-keys))
;;      		 ;; db:test-get-paths must not be run remote
;;      		 (paths    (tests:test-get-paths-matching keys target (args:get-arg "-test-files"))))
;;      	    (set! *didsomething* #t)
;;      	    (for-each (lambda (path)
;;      			(if (common:file-exists? path)
;;      			(print path)))	
;;      		      paths)))
;;      	;; else do a general-run-call
;;      	(general-run-call 
;;      	 "-test-files"
;;      	 "Get paths to test"
;;      	 (lambda (target runname keys keyvals)
;;      	   (let* ((db       #f)
;;      		  ;; DO NOT run remote
;;      		  (paths    (tests:test-get-paths-matching keys target (args:get-arg "-test-files"))))
;;      	     (for-each (lambda (path)
;;      			 (print path))
;;      		       paths))))))
;;      
;;      ;;======================================================================
;;      ;; Archive tests
;;      ;;======================================================================
;;      ;; Archive tests matching target, runname, and testpatt
;;      (if (equal? (args:get-arg "-archive") "replicate-db")
;;          (begin
;;                ;; check if source
;;                ;; check if megatest.db exist
;;               (launch:setup)
;;               (if (not (args:get-arg "-source"))
;;                   (begin 
;;                   (debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
;;                   (exit 1)))
;;               (if (common:file-exists? (conc  *toppath* "/megatest.db"))
;;                   (begin  
;;                     (debug:print-info 1 *default-log-port* "File " (conc  *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
;;                     (exit 1)))
;;               (if (and (common:get-db-tmp-area) (> (length (directory   (common:get-db-tmp-area) #f)) 0))
;;                 (begin
;;                 (debug:print-info 1 *default-log-port* (common:get-db-tmp-area) " not empty. Please remove it before trying to replicate db")
;;                 (exit 1)))    
;;                ;; check if timestamp 
;;                (let* ((source (args:get-arg "-source"))
;;                      (src     (if (not (equal? (substring source 0 1) "/"))
;;                                   (conc (current-directory) "/" source)
;;                                   source))
;;                      (ts (if (args:get-arg "-time-stamp")   (args:get-arg "-time-stamp") "latest")))
;;                    (if  (common:directory-exists? src)
;;                        (begin 
;;                        (archive:restore-db src ts)
;;                  (set! *didsomething* #t))
;;             (begin
;;               (debug:print-error 1 *default-log-port* "Path " source " not found")
;;               (exit 1))))))   
;;          ;; else do a general-run-call
;;         (if (and (args:get-arg "-archive") (not (equal? (args:get-arg "-archive") "replicate-db"))) 
;;          (begin
;;            ;; for the archive get we need to preserve the starting dir as part of the target path
;;            (if (and (args:get-arg "-dest")
;;      	       (not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
;;      	  (let ((newpath  (conc (current-directory) "/" (args:get-arg "-dest"))))
;;      	    (debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
;;      	    (hash-table-set! args:arg-hash "-dest" newpath)))
;;            (general-run-call 
;;             "-archive"
;;             "Archive"
;;             (lambda (target runname keys keyvals)
;;      	 (operate-on 'archive target-in: target runname-in: runname )))))
;;      
;;      ;;======================================================================
;;      ;; Extract a spreadsheet from the runs database
;;      ;;======================================================================
;; 
;; ;; TODO: Reenable this functionality
;; 
;;      #;(if (args:get-arg "-extract-ods")
;;          (general-run-call
;;           "-extract-ods"
;;           "Make ods spreadsheet"
;;           (lambda (target runname keys keyvals)
;;             (let ((dbstruct   (make-dbr:dbstruct path: *toppath* local: #t))
;;      	     (outputfile (args:get-arg "-extract-ods"))
;;      	     (runspatt   (or (args:get-arg "-runname")(args:get-arg ":runname")))
;;      	     (pathmod    (args:get-arg "-pathmod")))
;;      	     ;; (keyvalalist (keys->alist keys "%")))
;;      	 (debug:print 2 *default-log-port* "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals)
;;      	 (db:extract-ods-file dbstruct outputfile keyvals (if runspatt runspatt "%") pathmod)
;;      	 (db:close-all dbstruct)
;;      	 (set! *didsomething* #t)))))
;;      
;;      ;;======================================================================
;;      ;; execute the test
;;      ;;    - gets called on remote host
;;      ;;    - receives info from the -execute param
;;      ;;    - passes info to steps via MT_CMDINFO env var (future is to use a dot file)
;;      ;;    - gathers host info and 
;;      ;;======================================================================
;;      
;;      (if (args:get-arg "-execute")
;;          (begin
;;            (launch:execute (args:get-arg "-execute"))
;;            (set! *didsomething* #t)))
;;      
;;      ;;======================================================================
;;      ;; recover from a test where the managing mtest was killed but the underlying
;;      ;; process might still be salvageable
;;      ;;======================================================================
;;      
;;      (if (args:get-arg "-recover-test")
;;          (let* ((params (string-split (args:get-arg "-recover-test") ",")))
;;            (if (> (length params) 1) ;; run-id and test-id
;;      	  (let ((run-id (string->number (car params)))
;;      		(test-id (string->number (cadr params))))
;;      	    (if (and run-id test-id)
;;      		(begin
;;      		  (launch:recover-test run-id test-id)
;;      		  (set! *didsomething* #t))
;;      		(begin
;;      		  (debug:print-error 0 *default-log-port* "bad run-id or test-id, must be integers")
;;      		  (exit 1)))))))
;;      
;;   (if (args:get-arg "-step")
;;       (begin
;;            (thread-sleep! 1.5)
;;            (megatest:step 
;;             (args:get-arg "-step")
;;             (or (args:get-arg "-state")(args:get-arg ":state"))
;;             (or (args:get-arg "-status")(args:get-arg ":status"))
;;             (args:get-arg "-setlog")
;;             (args:get-arg "-m"))
;;            ;; (if db (sqlite3:finalize! db))
;;            (set! *didsomething* #t)
;;            (thread-sleep! 1.5)))
;;          
;;      (if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
;;      	;;     (not (args:get-arg "-step")))  ;; -setlog may have been processed already in the "-step" previous
;;      	;;     NEW POLICY - -setlog sets test overall log on every call.
;;      	(args:get-arg "-set-toplog")
;;      	(args:get-arg "-test-status")
;;      	(args:get-arg "-set-values")
;;      	(args:get-arg "-load-test-data")
;;      	(args:get-arg "-runstep")
;;      	(args:get-arg "-summarize-items"))
;;          (if (not (get-environment-variable "MT_CMDINFO"))
;;      	(begin
;;      	  (debug:print-error 0 *default-log-port* "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   (common:read-encoded-string (get-environment-variable "MT_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))
;;      	       (test-id   (assoc/default 'test-id   cmdinfo))
;;      	       (itemdat   (assoc/default 'itemdat   cmdinfo))
;;      	       (work-area (assoc/default 'work-area cmdinfo))
;;      	       (db        #f) ;; (open-db))
;;      	       (state     (args:get-arg ":state"))
;;      	       (status    (args:get-arg ":status"))
;;      	       (stepname  (args:get-arg "-step")))
;;      	  (if (not (launch:setup))
;;      	      (begin
;;      		(debug:print 0 *default-log-port* "Failed to setup, exiting")
;;      		(exit 1)))
;;      
;;      	  (if (args:get-arg "-runstep")(debug:print-info 1 *default-log-port* "Running -runstep, first change to directory " work-area))
;;      	  (change-directory work-area)
;;      	  ;; can setup as client for server mode now
;;      	  ;; (client:setup)
;;      
;;      	  (if (args:get-arg "-load-test-data")
;;      	      ;; has sub commands that are rdb:
;;      	      ;; DO NOT put this one into either rmt: or open-run-close
;;      	      (tdb:load-test-data run-id test-id))
;;      	  (if (args:get-arg "-setlog")
;;      	      (let ((logfname (args:get-arg "-setlog")))
;;      		(rmt:test-set-log! run-id test-id logfname)))
;;      	  (if (args:get-arg "-set-toplog")
;;      	      ;; DO NOT run remote
;;      	      (tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog")))
;;      	  (if (args:get-arg "-summarize-items")
;;      	      ;; DO NOT run remote
;;      	      (tests:summarize-items run-id test-id test-name #t)) ;; do force here
;;      	  (if (args:get-arg "-runstep")
;;      	      (if (null? remargs)
;;      		  (begin
;;      		    (debug:print-error 0 *default-log-port* "nothing specified to run!")
;;      		    (if db (sqlite3:finalize! db))
;;      		    (exit 6))
;;      		  (let* ((stepname   (args:get-arg "-runstep"))
;;      			 (logprofile (args:get-arg "-logpro"))
;;      			 (logfile    (conc stepname ".log"))
;;      			 (cmd        (if (null? remargs) #f (car remargs)))
;;      			 (params     (if cmd (cdr remargs) '()))
;;      			 (exitstat   #f)
;;      			 (shell      (let ((sh (get-environment-variable "SHELL") ))
;;      				       (if sh 
;;      					   (last (string-split sh "/"))
;;      					   "bash")))
;;      			 (redir      (case (string->symbol shell)
;;      				       ((tcsh csh ksh)    ">&")
;;      				       ((zsh bash sh ash) "2>&1 >")
;;      				       (else ">&")))
;;      			 (fullcmd    (conc "(" (string-intersperse 
;;      						(cons cmd params) " ")
;;      					   ") " redir " " logfile)))
;;      		    ;; mark the start of the test
;;      		    (rmt:teststep-set-status! run-id test-id stepname "start" "n/a" (args:get-arg "-m") logfile)
;;      		    ;; run the test step
;;      		    (debug:print-info 2 *default-log-port* "Running \"" fullcmd "\" in directory \"" startingdir)
;;      		    (change-directory startingdir)
;;      		    (set! exitstat (system fullcmd))
;;      		    (set! *globalexitstatus* exitstat)
;;      		    ;; (change-directory testpath)
;;      		    ;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
;;      		    (if logprofile
;;      			(let* ((htmllogfile (conc stepname ".html"))
;;      			       (oldexitstat exitstat)
;;      			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
;;      			  (debug:print-info 2 *default-log-port* "running \"" cmd "\"")
;;      			  (change-directory startingdir)
;;      			  (set! exitstat (system cmd))
;;      			  (set! *globalexitstatus* exitstat) ;; no necessary
;;      			  (change-directory testpath)
;;      			  (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"))
;;      				((and (string? status)
;;      				      (string->number status))(if (equal? (string->number status) 0) "PASS" "FAIL"))
;;      				(else status)))
;;      		    ;; transfer relevant keys into a hash to be passed to test-set-status!
;;      		    ;; could use an assoc list I guess. 
;;      		    (otherdata (let ((res (make-hash-table)))
;;      				 (for-each (lambda (key)
;;      					     (if (args:get-arg key)
;;      						 (hash-table-set! res key (args:get-arg key))))
;;      					   (list ":value" ":tol" ":expected" ":first_err" ":first_warn" ":units" ":category" ":variable"))
;;      				 res)))
;;      		(if (and (args:get-arg "-test-status")
;;      			 (or (not state)
;;      			     (not status)))
;;      		    (begin
;;      		      (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -test-status\n" help)
;;      		      (if (sqlite3:database? db)(sqlite3:finalize! db))
;;      		      (exit 6)))
;;      		(let* ((msg    (args:get-arg "-m"))
;;      		       (numoth (length (hash-table-keys otherdata))))
;;      		  ;; Convert to rpc inside the tests:test-set-status! call, not here
;;      		  (tests:test-set-status! run-id test-id state newstatus msg otherdata work-area: work-area))))
;;      	  (if (sqlite3:database? db)(sqlite3:finalize! db))
;;      	  (set! *didsomething* #t))))
;;      
;;      ;;======================================================================
;;      ;; Various helper commands can go below here
;;      ;;======================================================================
;;      
;;      (if (or (args:get-arg "-showkeys")
;;              (args:get-arg "-show-keys"))
;;          (let ((db #f)
;;      	  (keys #f))
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting")
;;      	    (exit 1)))
;;            (set! keys (rmt:get-keys)) ;;  db))
;;            (debug:print 1 *default-log-port* "Keys: " (string-intersperse keys ", "))
;;            (if (sqlite3:database? db)(sqlite3:finalize! db))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-gui")
;;          (begin
;;            (debug:print 0 *default-log-port* "Look at the dashboard for now")
;;            ;; (megatest-gui)
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-create-megatest-area")
;;          (begin
;;            (genexample:mk-megatest.config)
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-create-test")
;;          (let ((testname (args:get-arg "-create-test")))
;;            (genexample:mk-megatest-test testname)
;;            (set! *didsomething* #t)))
;;      
;;      ;;======================================================================
;;      ;; Update the database schema, clean up the db
;;      ;;======================================================================
;; 
;; ;; TODO: Restore this functionality
;; 
;;       #;(if (args:get-arg "-rebuild-db")
;;          (begin
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
;;      	    (exit 1)))
;;            ;; keep this one local
;;            ;; (open-run-close patch-db #f)
;;            (let ((dbstruct (db:setup #f areapath: *toppath*)))
;;              (common:cleanup-db dbstruct full: #t))
;;            (set! *didsomething* #t)))
;;      
;;      #;(if (args:get-arg "-cleanup-db")
;;          (begin
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
;;      	    (exit 1)))
;;            (let ((dbstruct (db:setup #f areapath: *toppath*)))
;;              (common:cleanup-db dbstruct))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-mark-incompletes")
;;          (begin
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting")
;;      	    (exit 1)))
;;            (runs:find-and-mark-incomplete-and-check-end-of-run #f)
;;            (set! *didsomething* #t)))
;;      
;;      ;;======================================================================
;;      ;; Update the tests meta data from the testconfig files
;;      ;;======================================================================
;;      
;;      (if (args:get-arg "-update-meta")
;;          (begin
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
;;      	    (exit 1)))
;;            (runs:update-all-test_meta #f)
;;            (set! *didsomething* #t)))
;;      
;;      ;;======================================================================
;;      ;; Start a repl
;;      ;;======================================================================
;;      
;;      ;; fakeout readline
;;      ;; (include "readline-fix.scm")
;;      
;;      
;;      (when (args:get-arg "-diff-rep")
;;        (when (and
;;               (not (args:get-arg "-diff-html"))
;;               (not (args:get-arg "-diff-email")))
;;          (debug:print 0 *default-log-port* "Must specify -diff-html or -diff-email with -diff-rep")
;;          (set! *didsomething* 1)
;;          (exit 1))
;;        
;;        (let* ((toppath (launch:setup)))
;;          (do-diff-report
;;           (args:get-arg "-src-target")
;;           (args:get-arg "-src-runname")
;;           (args:get-arg "-target")
;;           (args:get-arg "-runname")
;;           (args:get-arg "-diff-html")
;;           (args:get-arg "-diff-email"))
;;          (set! *didsomething* #t)
;;          (exit 0)))
;;      
;;      (if (or (get-environment-variable "MT_RUNSCRIPT")
;;      	(args:get-arg "-repl")
;;      	(args:get-arg "-load"))
;;          (let* ((toppath (launch:setup)))
;; 		
;;      	        ;; (dbstruct (if (and toppath
;; 		;; 	      #;(common:on-homehost?))
;; 		;; 	 (db:setup #f) ;; sets up main.db
;; 		;; 	 #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
;; 	   (if *toppath*
;; 	       (cond
;; 		((get-environment-variable "MT_RUNSCRIPT")
;; 		 ;; How to run megatest scripts
;; 		 ;;
;; 		 ;; #!/bin/bash
;; 		 ;;
;; 		 ;; export MT_RUNSCRIPT=yes
;; 		 ;; megatest << EOF
;; 		 ;; (print "Hello world")
;; 		 ;; (exit)
;; 		 ;; EOF
;; 		 
;; 		 (repl))
;; 		(else
;; 		 (begin
;; 		   ;; (set! *db* dbstruct)
;; 		   ;; (import extras) ;; might not be needed
;; 		   ;; (import chicken.csi)
;; 		   ;; (import readline)
;; 		   #;(import apropos
;; 			   archivemod
;; 			   commonmod
;; 			   configfmod
;; 			   dbmod
;; 			   debugprint
;; 			   ezstepsmod
;; 			   launchmod
;; 			   processmod
;; 			   rmtmod
;; 			   runsmod
;; 			   servermod
;; 			   tasksmod
;; 			   testsmod)
;; 		   
;; 		   (set-history-length! 300)
;; 		   (load-history-from-file ".megatest_history")
;; 		   (current-input-port (make-linenoise-port))
;; 		   ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
;; 		   
;; 		   ;; (if *use-new-readline*
;; 		   ;; 	  (begin
;; 		   ;; 	    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
;; 		   ;; 	    (current-input-port (make-readline-port "megatest> ")))
;; 		   ;; 	  (begin
;; 		   ;; 	    (gnu-history-install-file-manager
;; 		   ;; 	     (string-append
;; 		   ;; 	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
;; 		   ;; 	    (current-input-port (make-gnu-readline-port "megatest> "))))
;; 		   (if (args:get-arg "-repl")
;; 		       (repl)
;; 		       (load (args:get-arg "-load")))
;; 		   ;; (db:close-all dbstruct) <= taken care of by on-exit call
;; 		   )
;; 		 (exit)))
;; 	       (set! *didsomething* #t))))
;;      
;;      ;;======================================================================
;;      ;; Wait on a run to complete
;;      ;;======================================================================
;;      
;;      (if (and (args:get-arg "-run-wait")
;;      	 (not (or (args:get-arg "-run")
;;      		  (args:get-arg "-runtests")))) ;; run-wait is built into runtests now
;;          (begin
;;            (if (not (launch:setup))
;;      	  (begin
;;      	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
;;      	    (exit 1)))
;;            (operate-on 'run-wait)
;;            (set! *didsomething* #t)))
;;      
;;      ;; ;; ;; redo me ;; Not converted to use dbstruct yet
;;      ;; ;; ;; redo me ;;
;;      ;; ;; ;; redo me (if (args:get-arg "-convert-to-norm")
;;      ;; ;; ;; redo me     (let* ((toppath (setup-for-run))
;;      ;; ;; ;; redo me 	   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t))))
;;      ;; ;; ;; redo me       (for-each 
;;      ;; ;; ;; redo me        (lambda (field)
;;      ;; ;; ;; redo me 	 (let ((dat '()))
;;      ;; ;; ;; redo me 	   (debug:print-info 0 *default-log-port* "Getting data for field " field)
;;      ;; ;; ;; redo me 	   (sqlite3:for-each-row
;;      ;; ;; ;; redo me 	    (lambda (id val)
;;      ;; ;; ;; redo me 	      (set! dat (cons (list id val) dat)))
;;      ;; ;; ;; redo me 	    (db:get-db db run-id)
;;      ;; ;; ;; redo me 	    (conc "SELECT id," field " FROM tests;"))
;;      ;; ;; ;; redo me 	   (debug:print-info 0 *default-log-port* "found " (length dat) " items for field " field)
;;      ;; ;; ;; redo me 	   (let ((qry (sqlite3:prepare db (conc "UPDATE tests SET " field "=? WHERE id=?;"))))
;;      ;; ;; ;; redo me 	     (for-each
;;      ;; ;; ;; redo me 	      (lambda (item)
;;      ;; ;; ;; redo me 		(let ((newval ;; (sdb:qry 'getid 
;;      ;; ;; ;; redo me 		       (cadr item))) ;; )
;;      ;; ;; ;; redo me 		  (if (not (equal? newval (cadr item)))
;;      ;; ;; ;; redo me 		      (debug:print-info 0 *default-log-port* "Converting " (cadr item) " to " newval " for test #" (car item)))
;;      ;; ;; ;; redo me 		  (sqlite3:execute qry newval (car item))))
;;      ;; ;; ;; redo me 	      dat)
;;      ;; ;; ;; redo me 	     (sqlite3:finalize! qry))))
;;      ;; ;; ;; redo me        (db:close-all dbstruct)
;;      ;; ;; ;; redo me        (list "uname" "rundir" "final_logf" "comment"))
;;      ;; ;; ;; redo me       (set! *didsomething* #t)))
;; 
;; ;; TODO: restore this functionality
;; 
;;      #;(if (args:get-arg "-import-megatest.db")
;;          (begin
;;            (db:multi-db-sync 
;;             (db:setup #f)
;;             'killservers
;;             'dejunk
;;             'adj-testids
;;             'old2new
;;             ;; 'new2old
;;             )
;;            (set! *didsomething* #t)))
;;      
;;      #;(when (args:get-arg "-sync-brute-force")
;;        ((server:get-bruteforce-syncer (db:setup #t) persist-until-sync: #t))
;;        (set! *didsomething* #t))
;;      
;;      #;(if (args:get-arg "-sync-to-megatest.db")
;;          (let* ((dbstruct (db:setup #f))
;;      	   (tmpdbpth (cdr (dbr:dbstruct-tmpdb dbstruct)))
;;      	   (lockfile (conc tmpdbpth ".lock"))
;;      	   (locked   (common:simple-file-lock lockfile)) 
;;      	   (res      (if locked
;;      			 (db:multi-db-sync 
;;      			  dbstruct
;;      			  'new2old)
;;      			 #f)))
;;            (if res
;;      	  (begin
;;      	    (common:simple-file-release-lock lockfile)
;;      	    (print "Synced " res " records to megatest.db"))
;;      	  (print "Skipping sync, there is a sync in progress."))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-sync-to")
;;          (let ((toppath (launch:setup)))
;;            (tasks:sync-to-postgres *configdat* (args:get-arg "-sync-to"))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-list-test-time")
;;           (let* ((toppath (launch:setup))) 
;;           (task:get-test-times)  
;;           (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-list-run-time")
;;           (let* ((toppath (launch:setup))) 
;;           (task:get-run-times)  
;;           (set! *didsomething* #t)))
;;           
;;      (if (args:get-arg "-generate-html")
;;          (let* ((toppath (launch:setup)))
;;            (if (tests:create-html-tree #f)
;;                (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html")
;;                (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-generate-html-structure")
;;          (let* ((toppath (launch:setup)))
;;            ;(if (tests:create-html-tree #f)
;;       				(if (tests:create-html-summary #f)
;;                (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
;;                (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-syscheck")
;;          (begin
;;            (mutils:syscheck common:raw-get-remote-host-load
;;      		       server:get-best-guess-address
;;      		       configf:read-config)
;;            (set! *didsomething* #t)))
;;      
;;      (if (args:get-arg "-extract-skeleton")
;;          (let* ((toppath (launch:setup)))
;;            (genexample:extract-skeleton-area (args:get-arg "-extract-skeleton"))
;;            (set! *didsomething* #t)))
;;      
;;      ;;======================================================================
;;      ;; Exit and clean up
;;      ;;======================================================================
;;      
;;      (if (not *didsomething*)
;;          (debug:print 0 *default-log-port* help)
;;          (bdat-time-to-exit-set! *bdat* #t)
;;          )
;;      ;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")
;;      
;;      ;; join the watchdog thread if it has been thread-start!ed  (it may not have been started in the case of a server that never enters running state)
;;      ;;   (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
;;      ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
;;      #;(let* ((watchdog (bdat-watchdog *bdat*)))
;;        (if (thread? watchdog)
;; 	   (case (thread-state watchdog)
;; 	     ((ready running blocked sleeping terminated dead)
;; 	      (thread-join! watchdog)))))
;;      
;;      (bdat-time-to-exit-set! *bdat* #t)
;;      
;;      (if (not (eq? *globalexitstatus* 0))
;;          (if (or (args:get-arg "-run")(args:get-arg "-runtests")(args:get-arg "-runall"))
;;              (begin
;; 	       (debug:print 0 *default-log-port* "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
;; 	       (exit 0))
;;              (case *globalexitstatus*
;; 	       ((0)(exit 0))
;; 	       ((1)(exit 1))
;; 	       ((2)(exit 2))
;; 	       (else (exit 3)))))
;;      )
;; 
;; ;; (import megatest-main commonmod)
;; ;; (import srfi-18)