Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -197,10 +197,12 @@
 mofiles/commonmod.o : megatest-fossil-hash.scm
 mofiles/dbmod.o     : mofiles/commonmod.o mofiles/keysmod.o mofiles/tasksmod.o mofiles/odsmod.o
 mofiles/commonmod.o : mofiles/processmod.o
 mofiles/rmtmod.o    : mofiles/dbmod.o mofiles/commonmod.o mofiles/apimod.o
 mofiles/apimod.o    : mofiles/dbmod.o
+mofiles/runsmod.o   : mofiles/testsmod.o
+
 # Removed from megamod.o dep:   mofiles/ftail.o
 mofiles/megamod.o   : \
    mofiles/rmtmod.o \
    mofiles/commonmod.o \
    mofiles/apimod.o \

Index: common-inc.scm
==================================================================
--- common-inc.scm
+++ common-inc.scm
@@ -75,113 +75,10 @@
     fullpath))
 (define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
 (define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
 (define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))
 
-(define *common:logpro-exit-code->status-sym-alist*
-  '( ( 0 . pass )
-     ( 1 . fail )
-     ( 2 . warn )
-     ( 3 . check )
-     ( 4 . waived )
-     ( 5 . abort )
-     ( 6 . skip )))
-
-(define (common:logpro-exit-code->status-sym exit-code)
-  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))
-
-(define (common:worse-status-sym ss1 ss2)
-  (let loop ((status-syms-remaining '(abort fail check skip warn waived pass)))
-    (cond
-     ((null? status-syms-remaining)
-      'fail)
-     ((eq? (car status-syms-remaining) ss1)
-      ss1)
-     ((eq? (car status-syms-remaining) ss2)
-      ss2)
-     (else
-      (loop (cdr status-syms-remaining))))))
-
-(define (common:steps-can-proceed-given-status-sym status-sym)
-  (if (member status-sym '(warn waived pass))
-      #t
-      #f))
-
-(define (status-sym->string status-sym)
-  (case status-sym
-      ((pass) "PASS")
-    ((fail) "FAIL")
-    ((warn) "WARN")
-    ((check) "CHECK")
-    ((waived) "WAIVED")
-    ((abort) "ABORT")
-    ((skip) "SKIP")
-    (else "FAIL")))
-
-(define (common:logpro-exit-code->test-status exit-code)
-  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))
-
-(define (common:clear-caches)
-  (set! *target*             (make-hash-table))
-  (set! *keys*               (make-hash-table))
-  (set! *keyvals*            (make-hash-table))
-  (set! *toptest-paths*      (make-hash-table))
-  (set! *test-paths*         (make-hash-table))
-  (set! *test-ids*           (make-hash-table))
-  (set! *test-info*          (make-hash-table))
-  (set! *run-info-cache*     (make-hash-table))
-  (set! *env-vars-by-run-id* (make-hash-table))
-  (set! *test-id-cache*      (make-hash-table)))
-
-;; Generic string database
-(define sdb:qry #f) ;; (make-sdb:qry)) ;;  'init #f)
-;; Generic path database
-(define *fdb* #f)
-
-(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
-
-;;======================================================================
-;; V E R S I O N
-;;======================================================================
-
-(define (common:get-full-version)
-  (conc megatest-version "-" megatest-fossil-hash))
-
-(define (common:version-signature)
-  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
-
-;; from metadat lookup MEGATEST_VERSION
-;;
-(define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB
-  (rmt:get-var "MEGATEST_VERSION"))
-
-(define (common:get-last-run-version-number)
-  (string->number 
-   (substring (common:get-last-run-version) 0 6)))
-
-(define (common:set-last-run-version)
-  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))
-
-;; postive number if megatest version > db version
-;; negative number if megatest version < db version
-(define (common:version-db-delta)
-         (- megatest-version (common:get-last-run-version-number)))
-
-(define (common:version-changed?)
-  (not (equal? (common:get-last-run-version)
-               (common:version-signature))))
-
-(define (common:api-changed?)
-  (not (equal? (substring (->string megatest-version) 0 4)
-               (substring (conc (common:get-last-run-version)) 0 4))))
-
-
-(define (common:get-sync-lock-filepath)
-  (let* ((tmp-area     (common:get-db-tmp-area))
-         (lockfile     (conc tmp-area "/megatest.db.sync-lock")))
-    lockfile))
-    
 ;; Move me elsewhere ...
 ;; RADT => Why do we meed the version check here, this is called only if version misma
 ;;
 (define (common:cleanup-db dbstruct #!key (full #f))
   (apply db:multi-db-sync 
@@ -454,55 +351,10 @@
 
 ;;======================================================================
 ;; U S E F U L   S T U F F
 ;;======================================================================
 
-;; convert things to an alist or assoc list, #f gets converted to ""
-;;
-(define (common:to-alist dat)
-  (cond
-   ((list? dat)   (map common:to-alist dat))
-   ((vector? dat)
-    (map common:to-alist (vector->list dat)))
-   ((pair? dat)
-    (cons (common:to-alist (car dat))
-	  (common:to-alist (cdr dat))))
-   ((hash-table? dat)
-    (map common:to-alist (hash-table->alist dat)))
-   (else
-    (if dat
-	dat
-	""))))
-
-(define (common:alist-ref/default key alist default)
-  (or (alist-ref key alist) default))
-
-(define (common:low-noise-print waitval . keys)
-  (let* ((key      (string-intersperse (map conc keys) "-" ))
-	 (lasttime (hash-table-ref/default *common:denoise* key 0))
-	 (currtime (current-seconds)))
-    (if (> (- currtime lasttime) waitval)
-	(begin
-	  (hash-table-set! *common:denoise* key currtime)
-	  #t)
-	#f)))
-
-(define (common:get-megatest-exe)
-  (or (getenv "MT_MEGATEST") "megatest"))
-
-(define (common:read-encoded-string instr)
-  (handle-exceptions
-   exn
-   (handle-exceptions
-    exn
-    (begin
-      (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
-      (print-call-chain (current-error-port))
-      #f)
-    (read (open-input-string (base64:base64-decode instr))))
-   (read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))
-
 ;; dot-locking egg seems not to work, using this for now
 ;; if lock is older than expire-time then remove it and try again
 ;; to get the lock
 ;;
 (define (common:simple-file-lock fname #!key (expire-time 300))
@@ -547,45 +399,35 @@
 ;;======================================================================
 
 ;; (define *verbosity*         1)
 ;; (define *logging*           #f)
 
-(define (get-with-default val default)
-  (let ((val (args:get-arg val)))
-    (if val val default)))
-
-(define (assoc/default key lst . default)
-  (let ((res (assoc key lst)))
-    (if res (cadr res)(if (null? default) #f (car default)))))
-
-(define (common:get-testsuite-name)
-  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
-      (configf:lookup *configdat* "setup" "testsuite" )
-      (getenv "MT_TESTSUITE_NAME")
-      (if (string? *toppath* )
-          (pathname-file *toppath*)
-          #f))) ;; (pathname-file (current-directory)))))
-
-(define common:get-area-name common:get-testsuite-name)
-
-(define (common:get-db-tmp-area . junk)
-  (if *db-cache-path*
-      *db-cache-path*
-      (if *toppath* ;; common:get-create-writeable-dir
-	  (handle-exceptions
-	      exn
-	      (begin
-		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path*)
-		(exit 1))
-	    (let ((dbpath (common:get-create-writeable-dir
-			   (list (conc "/tmp/" (current-user-name)
-				       "/megatest_localdb/"
-				       (common:get-testsuite-name) "/"
-				       (string-translate *toppath* "/" ".")))))) ;;  #t))))
-	      (set! *db-cache-path* dbpath)
-	      dbpath))
-	  #f)))
+(define (common:set-last-run-version)
+  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))
+
+;; postive number if megatest version > db version
+;; negative number if megatest version < db version
+(define (common:version-db-delta)
+         (- megatest-version (common:get-last-run-version-number)))
+
+(define (common:version-changed?)
+  (not (equal? (common:get-last-run-version)
+               (common:version-signature))))
+
+;; from metadat lookup MEGATEST_VERSION
+;;
+(define (common:get-last-run-version) ;; RADT => How does this work in send-receive function??; assume it is the value saved in some DB
+  (rmt:get-var "MEGATEST_VERSION"))
+
+(define (common:get-last-run-version-number)
+  (string->number 
+   (substring (common:get-last-run-version) 0 6)))
+
+(define (common:api-changed?)
+  (not (equal? (substring (->string megatest-version) 0 4)
+               (substring (conc (common:get-last-run-version)) 0 4))))
+
 
 ;;======================================================================
 ;; E X I T   H A N D L I N G
 ;;======================================================================
 
@@ -763,105 +605,10 @@
 	(filter (lambda (x)
 		  (patt-list-match x target-patt))
 		targs)
 	targs)))
 
-;; Lookup a value in runconfigs based on -reqtarg or -target
-;; 
-(define (runconfigs-get config var)
-  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
-    (if targ
-	(or (configf:lookup config targ var)
-	    (configf:lookup config "default" var))
-	(configf:lookup config "default" var))))
-
-(define (common:args-get-state)
-  (or (args:get-arg "-state")(args:get-arg ":state")))
-
-(define (common:args-get-status)
-  (or (args:get-arg "-status")(args:get-arg ":status")))
-
-(define (common:args-get-testpatt rconf)
-  (let* (;; (tagexpr       (args:get-arg "-tagexpr"))
-         ;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
-         (testpatt-key  (or (args:get-arg "-modepatt") (args:get-arg "--modepatt") "TESTPATT"))
-         (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
-         (rtestpatt     (if rconf (runconfigs-get rconf testpatt-key) #f)))
-    (cond
-     ((or (args:get-arg "--modepatt") (args:get-arg "-modepatt")) ;; modepatt is a forced setting, when set it MUST refer to an existing PATT in the runconfig
-      (if rconf
-	  (let* ((patts-from-mode-patt	  (runconfigs-get rconf testpatt-key)))
-	    (debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key " "  patts-from-mode-patt)
-	    patts-from-mode-patt)
-	  (begin
-	    (debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key) ;;  " " patts-from-mode-patt)
-	    #f)))     ;; We do NOT fall back to "%"
-     ;; (tags-testpatt
-     ;;  (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
-     ;;  tags-testpatt)
-     ((and (equal? args-testpatt "%") rtestpatt)
-      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
-      rtestpatt)
-     (else 
-      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
-      args-testpatt))))
-
-
-
-(define (common:get-linktree)
-  (or (getenv "MT_LINKTREE")
-      (if *configdat*
-	  (configf:lookup *configdat* "setup" "linktree")
-	  (if *toppath*
-	      (conc *toppath* "/lt")
-	      #f))))
-
-(define (common:args-get-runname)
-  (let ((res (or (args:get-arg "-runname")
-		 (args:get-arg ":runname")
-		 (getenv "MT_RUNNAME"))))
-    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
-    res))
-
-(define (common:get-fields cfgdat)
-  (let ((fields (hash-table-ref/default cfgdat "fields" '())))
-    (map car fields)))
-
-(define (common:args-get-target #!key (split #f)(exit-if-bad #f))
-  (let* ((keys    (if (hash-table? *configdat*) (common:get-fields *configdat*) '()))
-	 (numkeys (length keys))
-	 (target  (or (args:get-arg "-reqtarg")
-		      (args:get-arg "-target")
-		      (getenv "MT_TARGET")))
-	 (tlist   (if target (string-split target "/" #t) '()))
-	 (valid   (if target
-		      (or (null? keys) ;; probably don't know our keys yet
-			  (and (not (null? tlist))
-			       (eq? numkeys (length tlist))
-			       (null? (filter string-null? tlist))))
-		      #f)))
-    (if valid
-	(if split
-	    tlist
-	    target)
-	(if target
-	    (begin
-	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
-	      (if exit-if-bad (exit 1))
-	      #f)
-	    #f))))
-
-;; looking only (at least for now) at the MT_ variables craft the full testname
-;;
-(define (common:get-full-test-name)
-  (if (getenv "MT_TEST_NAME")
-      (if (and (getenv "MT_ITEMPATH")
-               (not (equal? (getenv "MT_ITEMPATH") "")))
-          (getenv "MT_TEST_NAME")
-          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
-      #f))
-
 ;; logic for getting homehost. Returns (host . at-home)
 ;; IF *toppath* is not set, wait up to five seconds trying every two seconds
 ;; (this is to accomodate the watchdog)
 ;;
 (define (common:get-homehost #!key (trynum 5))

Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -31,23 +31,133 @@
 	srfi-69 ports
 	regex-case regex hostinfo srfi-4
 	pkts (prefix dbi dbi:)
 	stack
 	md5
-	message-digest)
-
-;; (import processmod)
-(import stml2)
+	message-digest
+	(prefix mtconfigf configf:)
+	stml2
+	(prefix margs args:)
+	z3 (prefix base64 base64:))
 
 (include "common_records.scm")
 (include "megatest-fossil-hash.scm")
 (include "megatest-version.scm")
 
  ;; no need to export this
 (define *verbosity-cache* (make-hash-table))
 (define *verbosity* 0)
 
+
+
+;; GLOBALS
+
+;; CONTEXTS
+#;(defstruct cxt
+  (taskdb #f)
+  (cmutex (make-mutex)))
+;; (define *contexts* (make-hash-table))
+;; (define *context-mutex* (make-mutex))
+
+;; ;; safe method for accessing a context given a toppath
+;; ;;
+;; (define (common:with-cxt toppath proc)
+;;   (mutex-lock! *context-mutex*)
+;;   (let ((cxt (hash-table-ref/default *contexts* toppath #f)))
+;;     (if (not cxt)
+;;         (set! cxt (let ((x (make-cxt)))(hash-table-set! *contexts* toppath x) x)))
+;;     (let ((cxt-mutex (cxt-mutex cxt)))
+;;       (mutex-unlock! *context-mutex*)
+;;       (mutex-lock! cxt-mutex)
+;;       (let ((res (proc cxt)))
+;;         (mutex-unlock! cxt-mutex)
+;;         res))))
+        
+;; A hash table that can be accessed by #{scheme ...} calls in
+;; config files. Allows communicating between confgs
+;;
+(define *user-hash-data* (make-hash-table))
+
+(define *db-keys* #f)
+
+(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
+(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
+(define *runconfigdat* #f)   ;; run configs data
+(define *configdat*    #f)   ;; megatest.config data
+(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
+(define *toppath*      #f)
+(define *already-seen-runconfig-info* #f)
+
+(define *test-meta-updated* (make-hash-table))
+(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
+(define *passnum*           0) ;; when running track calls to run-tests or similar
+;; (define *alt-log-file* #f)  ;; used by -log
+(define *common:denoise*    (make-hash-table)) ;; for low noise printing
+(define *default-log-port*  (current-error-port))
+(define *default-area-tag* "local")
+
+;; DATABASE
+(define *dbstruct-db*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
+;; db access
+(define *db-last-access*      (current-seconds)) ;; last db access, used in server
+(define *db-write-access*     #t)
+;; db sync
+(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
+(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
+(define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync*
+;; task db
+(define *task-db*             #f) ;; (vector db path-to-db)
+(define *db-access-allowed*   #t) ;; flag to allow access
+(define *db-access-mutex*     (make-mutex))
+(define *db-transaction-mutex* (make-mutex))
+(define *db-cache-path*       #f)
+(define *db-with-db-mutex*    (make-mutex))
+(define *db-api-call-time*    (make-hash-table)) ;; hash of command => (list of times)
+;; no sync db
+(define *no-sync-db*          #f)
+
+;; SERVER
+(define *my-client-signature* #f)
+(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
+(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
+;; (define *max-cache-size*    0)
+(define *logged-in-clients* (make-hash-table))
+(define *server-id*         #f)
+(define *server-info*       #f)  ;; good candidate for easily convert to non-global
+(define *time-to-exit*      #f)
+(define *server-run*        #t)
+(define *run-id*            #f)
+(define *server-kind-run*   (make-hash-table))
+(define *home-host*         #f)
+;; (define *total-non-write-delay* 0)
+(define *heartbeat-mutex*   (make-mutex))
+(define *api-process-request-count* 0)
+(define *max-api-process-requests* 0)
+(define *server-overloaded*  #f)
+
+;; client
+(define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 
+
+;; RPC transport
+(define *rpc:listener*      #f)
+
+;; KEY info
+(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
+(define *keys*              (make-hash-table)) ;; cache the keys here
+(define *keyvals*           (make-hash-table))
+(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
+(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
+(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
+(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
+
+(define *run-info-cache*     (make-hash-table)) ;; run info is stable, no need to reget
+(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
+(define *homehost-mutex*     (make-mutex))
+
+;; Miscellaneous
+(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers
+
 ;; this was cached based on results from profiling but it turned out the profiling
 ;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
 ;; in for now but can probably take it out later.
 ;;
 (define (debug:calc-verbosity vstr verbose quiet) ;; verbose and quiet are #f or enabled
@@ -138,10 +248,105 @@
 	  ;;    (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
 		;; (exec-fn 'db:log-event res))
 	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
 	  (apply print "INFO: (" n ") " params) ;; res)
 	  )))) ;; )
+
+;; Lookup a value in runconfigs based on -reqtarg or -target
+;; 
+(define (runconfigs-get config var)
+  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
+    (if targ
+	(or (configf:lookup config targ var)
+	    (configf:lookup config "default" var))
+	(configf:lookup config "default" var))))
+
+(define (common:args-get-state)
+  (or (args:get-arg "-state")(args:get-arg ":state")))
+
+(define (common:args-get-status)
+  (or (args:get-arg "-status")(args:get-arg ":status")))
+
+(define (common:args-get-testpatt rconf)
+  (let* (;; (tagexpr       (args:get-arg "-tagexpr"))
+         ;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
+         (testpatt-key  (or (args:get-arg "-modepatt") (args:get-arg "--modepatt") "TESTPATT"))
+         (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
+         (rtestpatt     (if rconf (runconfigs-get rconf testpatt-key) #f)))
+    (cond
+     ((or (args:get-arg "--modepatt") (args:get-arg "-modepatt")) ;; modepatt is a forced setting, when set it MUST refer to an existing PATT in the runconfig
+      (if rconf
+	  (let* ((patts-from-mode-patt	  (runconfigs-get rconf testpatt-key)))
+	    (debug:print-info 0 *default-log-port* "modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key " "  patts-from-mode-patt)
+	    patts-from-mode-patt)
+	  (begin
+	    (debug:print-info 0 *default-log-port* " modepatt defined is: "testpatt-key" runconfigs values for  " testpatt-key) ;;  " " patts-from-mode-patt)
+	    #f)))     ;; We do NOT fall back to "%"
+     ;; (tags-testpatt
+     ;;  (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
+     ;;  tags-testpatt)
+     ((and (equal? args-testpatt "%") rtestpatt)
+      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
+      rtestpatt)
+     (else 
+      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
+      args-testpatt))))
+
+
+
+(define (common:get-linktree)
+  (or (getenv "MT_LINKTREE")
+      (if *configdat*
+	  (configf:lookup *configdat* "setup" "linktree")
+	  (if *toppath*
+	      (conc *toppath* "/lt")
+	      #f))))
+
+(define (common:args-get-runname)
+  (let ((res (or (args:get-arg "-runname")
+		 (args:get-arg ":runname")
+		 (getenv "MT_RUNNAME"))))
+    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
+    res))
+
+(define (common:get-fields cfgdat)
+  (let ((fields (hash-table-ref/default cfgdat "fields" '())))
+    (map car fields)))
+
+(define (common:args-get-target #!key (split #f)(exit-if-bad #f))
+  (let* ((keys    (if (hash-table? *configdat*) (common:get-fields *configdat*) '()))
+	 (numkeys (length keys))
+	 (target  (or (args:get-arg "-reqtarg")
+		      (args:get-arg "-target")
+		      (getenv "MT_TARGET")))
+	 (tlist   (if target (string-split target "/" #t) '()))
+	 (valid   (if target
+		      (or (null? keys) ;; probably don't know our keys yet
+			  (and (not (null? tlist))
+			       (eq? numkeys (length tlist))
+			       (null? (filter string-null? tlist))))
+		      #f)))
+    (if valid
+	(if split
+	    tlist
+	    target)
+	(if target
+	    (begin
+	      (debug:print-error 0 *default-log-port* "Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/") ", have " tlist " for elements")
+	      (if exit-if-bad (exit 1))
+	      #f)
+	    #f))))
+
+;; looking only (at least for now) at the MT_ variables craft the full testname
+;;
+(define (common:get-full-test-name)
+  (if (getenv "MT_TEST_NAME")
+      (if (and (getenv "MT_ITEMPATH")
+               (not (equal? (getenv "MT_ITEMPATH") "")))
+          (getenv "MT_TEST_NAME")
+          (conc (getenv "MT_TEST_NAME") "/" (getenv "MT_ITEMPATH")))
+      #f))
 
 
 ;;======================================================================
 ;; S T A T E S   A N D   S T A T U S E S
 ;;======================================================================
@@ -595,569 +800,177 @@
     (length (glob (conc "/proc/" pid "/fd/*")))
     (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
   )
 )
 
-  
-
-;; GLOBALS
-
-;; CONTEXTS
-#;(defstruct cxt
-  (taskdb #f)
-  (cmutex (make-mutex)))
-;; (define *contexts* (make-hash-table))
-;; (define *context-mutex* (make-mutex))
-
-;; ;; safe method for accessing a context given a toppath
-;; ;;
-;; (define (common:with-cxt toppath proc)
-;;   (mutex-lock! *context-mutex*)
-;;   (let ((cxt (hash-table-ref/default *contexts* toppath #f)))
-;;     (if (not cxt)
-;;         (set! cxt (let ((x (make-cxt)))(hash-table-set! *contexts* toppath x) x)))
-;;     (let ((cxt-mutex (cxt-mutex cxt)))
-;;       (mutex-unlock! *context-mutex*)
-;;       (mutex-lock! cxt-mutex)
-;;       (let ((res (proc cxt)))
-;;         (mutex-unlock! cxt-mutex)
-;;         res))))
-        
-;; A hash table that can be accessed by #{scheme ...} calls in
-;; config files. Allows communicating between confgs
-;;
-(define *user-hash-data* (make-hash-table))
-
-(define *db-keys* #f)
-
-(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
-(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
-(define *runconfigdat* #f)   ;; run configs data
-(define *configdat*    #f)   ;; megatest.config data
-(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
-(define *toppath*      #f)
-(define *already-seen-runconfig-info* #f)
-
-(define *test-meta-updated* (make-hash-table))
-(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
-(define *passnum*           0) ;; when running track calls to run-tests or similar
-;; (define *alt-log-file* #f)  ;; used by -log
-(define *common:denoise*    (make-hash-table)) ;; for low noise printing
-(define *default-log-port*  (current-error-port))
-(define *default-area-tag* "local")
-
-;; DATABASE
-(define *dbstruct-db*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
-;; db access
-(define *db-last-access*      (current-seconds)) ;; last db access, used in server
-(define *db-write-access*     #t)
-;; db sync
-(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
-(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
-(define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync*
-;; task db
-(define *task-db*             #f) ;; (vector db path-to-db)
-(define *db-access-allowed*   #t) ;; flag to allow access
-(define *db-access-mutex*     (make-mutex))
-(define *db-transaction-mutex* (make-mutex))
-(define *db-cache-path*       #f)
-(define *db-with-db-mutex*    (make-mutex))
-(define *db-api-call-time*    (make-hash-table)) ;; hash of command => (list of times)
-;; no sync db
-(define *no-sync-db*          #f)
-
-;; SERVER
-(define *my-client-signature* #f)
-(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
-(define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
-;; (define *max-cache-size*    0)
-(define *logged-in-clients* (make-hash-table))
-(define *server-id*         #f)
-(define *server-info*       #f)  ;; good candidate for easily convert to non-global
-(define *time-to-exit*      #f)
-(define *server-run*        #t)
-(define *run-id*            #f)
-(define *server-kind-run*   (make-hash-table))
-(define *home-host*         #f)
-;; (define *total-non-write-delay* 0)
-(define *heartbeat-mutex*   (make-mutex))
-(define *api-process-request-count* 0)
-(define *max-api-process-requests* 0)
-(define *server-overloaded*  #f)
-
-;; client
-(define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 
-
-;; RPC transport
-(define *rpc:listener*      #f)
-
-;; KEY info
-(define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
-(define *keys*              (make-hash-table)) ;; cache the keys here
-(define *keyvals*           (make-hash-table))
-(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
-(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
-(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
-(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
-
-(define *run-info-cache*     (make-hash-table)) ;; run info is stable, no need to reget
-(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
-(define *homehost-mutex*     (make-mutex))
-
-;; Miscellaneous
-(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-;; (define (common:low-noise-print alldat waitval . keys)
-;;   (let* ((key      (string-intersperse (map conc keys) "-" ))
-;; 	 (lasttime (hash-table-ref/default (alldat-denoise alldat) key 0))
-;; 	 (currtime (current-seconds)))
-;;     (if (> (- currtime lasttime) waitval)
-;; 	(begin
-;; 	  (hash-table-set! (alldat-denoise alldat) key currtime)
-;; 	  #t)
-;; 	#f)))
-;; 
-;; (define (common:version-signature alldat)
-;;   (conc (alldat-megatest-version alldat)
-;; 	"-" (substring (alldat-megatest-fossil-hash alldat) 0 4)))
-;; 
-;; (define (common:get-fields cfgdat)
-;;   (let ((fields (hash-table-ref/default cfgdat "fields" '())))
-;;     (map car fields)))
-;; 
-;; ;;======================================================================
-;; ;; T I M E   A N D   D A T E
-;; ;;======================================================================
-;; 
-;; ;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
-;; (define (common:hms-string->seconds tstr)
-;;   (let ((parts     (string-split-fields "\\w+" tstr))
-;; 	(time-secs 0)
-;; 	;; s=seconds, m=minutes, h=hours, d=days, M=months, y=years, w=weeks
-;; 	(trx       (regexp "(\\d+)([smhdMyw])")))
-;;     (for-each (lambda (part)
-;; 		(let ((match  (string-match trx part)))
-;; 		  (if match
-;; 		      (let ((val (string->number (cadr match)))
-;; 			    (unt (caddr match)))
-;; 			(if val 
-;; 			    (set! time-secs (+ time-secs (* val
-;; 							    (case (string->symbol unt)
-;; 							      ((s) 1)
-;; 							      ((m) 60) ;; minutes
-;; 							      ((h) 3600)
-;; 							      ((d) 86400)
-;; 							      ((w) 604800)
-;; 							      ((M) 2628000) ;; aproximately one month
-;; 							      ((y) 31536000)
-;; 							      (else #f))))))))))
-;; 	      parts)
-;;     time-secs))
-;; 		       
-;; (define (seconds->hr-min-sec secs)
-;;   (let* ((hrs (quotient secs 3600))
-;; 	 (min (quotient (- secs (* hrs 3600)) 60))
-;; 	 (sec (- secs (* hrs 3600)(* min 60))))
-;;     (conc (if (> hrs 0)(conc hrs "hr ") "")
-;; 	  (if (> min 0)(conc min "m ")  "")
-;; 	  sec "s")))
-;; 
-;; (define (seconds->time-string sec)
-;;   (time->string 
-;;    (seconds->local-time sec) "%H:%M:%S"))
-;; 
-;; (define (seconds->work-week/day-time sec)
-;;   (time->string
-;;    (seconds->local-time sec) "ww%V.%u %H:%M"))
-;; 
-;; (define (seconds->work-week/day sec)
-;;   (time->string
-;;    (seconds->local-time sec) "ww%V.%u"))
-;; 
-;; (define (seconds->year-work-week/day sec)
-;;   (time->string
-;;    (seconds->local-time sec) "%yww%V.%w"))
-;; 
-;; (define (seconds->year-work-week/day-time sec)
-;;   (time->string
-;;    (seconds->local-time sec) "%Yww%V.%w %H:%M"))
-;; 
-;; (define (seconds->year-week/day-time sec)
-;;   (time->string
-;;    (seconds->local-time sec) "%Yw%V.%w %H:%M"))
-;; 
-;; (define (seconds->quarter sec)
-;;   (case (string->number
-;; 	 (time->string 
-;; 	  (seconds->local-time sec)
-;; 	  "%m"))
-;;     ((1 2 3) 1)
-;;     ((4 5 6) 2)
-;;     ((7 8 9) 3)
-;;     ((10 11 12) 4)
-;;     (else #f)))
-;; 
-;; ;; basic ISO8601 format (e.g. "2017-02-28 06:02:54") date time => Unix epoch
-;; ;;
-;; (define (common:date-time->seconds datetime)
-;;   (local-time->seconds (string->time datetime "%Y-%m-%d %H:%M:%S")))
-;; 
-;; ;; given span of seconds tstart to tend
-;; ;; find start time to mark and mark delta
-;; ;;
-;; (define (common:find-start-mark-and-mark-delta tstart tend)
-;;   (let* ((deltat   (- (max tend (+ tend 10)) tstart)) ;; can't handle runs of less than 4 seconds. Pad it to 10 seconds ...
-;; 	 (result   #f)
-;; 	 (min      60)
-;; 	 (hr       (* 60 60))
-;; 	 (day      (* 24 hr))
-;; 	 (yr       (* 365 day)) ;; year
-;; 	 (mo       (/ yr 12))
-;; 	 (wk       (* day 7)))
-;;     (for-each
-;;      (lambda (max-blks)
-;;        (for-each
-;; 	(lambda (span) ;; 5 2 1
-;; 	  (if (not result)
-;; 	      (for-each 
-;; 	       (lambda (timeunit timesym) ;; year month day hr min sec
-;; 		 (if (not result)
-;; 		     (let* ((time-blk (* span timeunit))
-;; 			    (num-blks (quotient deltat time-blk)))
-;; 		       (if (and (> num-blks 4)(< num-blks max-blks))
-;; 			   (let ((first (* (quotient tstart time-blk) time-blk)))
-;; 			     (set! result (list span timeunit time-blk first timesym))
-;; 			     )))))
-;; 	       (list yr mo wk day hr min 1)
-;; 	       '(     y  mo w  d   h  m   s))))
-;; 	(list 8 6 5 2 1)))
-;;      '(5 10 15 20 30 40 50 500))
-;;     (if values
-;; 	(apply values result)
-;; 	(values 0 day 1 0 'd))))
-;; 
-;; ;; given x y lim return the cron expansion
-;; ;;
-;; (define (common:expand-cron-slash x y lim)
-;;   (let loop ((curr x)
-;; 	     (res  `()))
-;;     (if (< curr lim)
-;; 	(loop (+ curr y) (cons curr res))
-;; 	(reverse res))))
-;; 
-;; ;; expand a complex cron string to a list of cron strings
-;; ;;
-;; ;;  x/y   => x, x+y, x+2y, x+3y while x+Ny<max_for_field
-;; ;;  a,b,c => a, b ,c
-;; ;;
-;; ;;   NOTE: with flatten a lot of the crud below can be factored down.
-;; ;;
-;; (define (common:cron-expand cron-str)
-;;   (if (list? cron-str)
-;;       (flatten
-;;        (fold (lambda (x res)
-;; 	       (if (list? x)
-;; 		   (let ((newres (map common:cron-expand x)))
-;; 		     (append x newres))
-;; 		   (cons x res)))
-;; 	     '()
-;; 	     cron-str)) ;; (map common:cron-expand cron-str))
-;;       (let ((cron-items (string-split cron-str))
-;; 	    (slash-rx   (regexp "(\\d+)/(\\d+)"))
-;; 	    (comma-rx   (regexp ".*,.*"))
-;; 	    (max-vals   '((min        . 60)
-;; 			  (hour       . 24)
-;; 			  (dayofmonth . 28) ;;; BUG!!!! This will be a bug for some combinations
-;; 			  (month      . 12)
-;; 			  (dayofweek  . 7))))
-;; 	(if (< (length cron-items) 5) ;; bad spec
-;; 	    cron-str ;; `(,cron-str)              ;; just return the string, something downstream will fix it
-;; 	    (let loop ((hed  (car cron-items))
-;; 		       (tal  (cdr cron-items))
-;; 		       (type 'min)
-;; 		       (type-tal '(hour dayofmonth month dayofweek))
-;; 		       (res  '()))
-;; 	      (regex-case
-;; 		  hed
-;; 		(slash-rx ( _ base incr ) (let* ((basen          (string->number base))
-;; 						 (incrn          (string->number incr))
-;; 						 (expanded-vals  (common:expand-cron-slash basen incrn (alist-ref type max-vals)))
-;; 						 (new-list-crons (fold (lambda (x myres)
-;; 									 (cons (conc (if (null? res)
-;; 											 ""
-;; 											 (conc (string-intersperse res " ") " "))
-;; 										     x " " (string-intersperse tal " "))
-;; 									       myres))
-;; 								       '() expanded-vals)))
-;; 					    ;; (print "new-list-crons: " new-list-crons)
-;; 					    ;; (fold (lambda (x res)
-;; 					    ;; 	    (if (list? x)
-;; 					    ;; 		(let ((newres (map common:cron-expand x)))
-;; 					    ;; 		  (append x newres))
-;; 					    ;; 		(cons x res)))
-;; 					    ;; 	  '()
-;; 					    (flatten (map common:cron-expand new-list-crons))))
-;; 		;;					    (map common:cron-expand (map common:cron-expand new-list-crons))))
-;; 		(else (if (null? tal)
-;; 			  cron-str
-;; 			  (loop (car tal)(cdr tal)(car type-tal)(cdr type-tal)(append res (list hed)))))))))))
-;; 		      
-;; 	    
-;; ;; given a cron string and the last time event was processed return #t to run or #f to not run
-;; ;;
-;; ;;  min    hour   dayofmonth month  dayofweek
-;; ;; 0-59    0-23   1-31       1-12   0-6          ### NOTE: dayofweek does not include 7
-;; ;;
-;; ;;  #t => yes, run the job
-;; ;;  #f => no, do not run the job
-;; ;;
-;; (define (common:cron-event cron-str now-seconds-in last-done) ;; ref-seconds = #f is NOW.
-;;   (let* ((cron-items     (map string->number (string-split cron-str)))
-;; 	 (now-seconds    (or now-seconds-in (current-seconds)))
-;; 	 (now-time       (seconds->local-time now-seconds))
-;; 	 (last-done-time (seconds->local-time last-done))
-;; 	 (all-times      (make-hash-table)))
-;;     ;; (print "cron-items: " cron-items "(length cron-items): " (length cron-items))
-;;     (if (not (eq? (length cron-items) 5)) ;; don't even try to figure out junk strings
-;; 	#f
-;; 	(match-let (((     cmin chour cdayofmonth cmonth    cdayofweek)
-;; 		     cron-items)
-;; 		    ;; 0     1    2        3         4    5      6
-;; 		    ((nsec nmin nhour ndayofmonth nmonth nyr ndayofweek n7 n8 n9)
-;; 		     (vector->list now-time))
-;; 		    ((lsec lmin lhour ldayofmonth lmonth lyr ldayofweek l7 l8 l9)
-;; 		     (vector->list last-done-time)))
-;; 	  ;; create all possible time slots
-;; 	  ;; remove invalid slots due to (for example) day of week
-;; 	  ;; get the start and end entries for the ref-seconds (current) time
-;; 	  ;; if last-done > ref-seconds => this is an ERROR!
-;; 	  ;; does the last-done time fall in the legit region?
-;; 	  ;;    yes => #f  do not run again this command
-;; 	  ;;    no  => #t  ok to run the command
-;; 	  (for-each ;; month
-;; 	   (lambda (month)
-;; 	     (for-each ;; dayofmonth
-;; 	      (lambda (dom)
-;; 		(for-each
-;; 		 (lambda (hr) ;; hour
-;; 		   (for-each
-;; 		    (lambda (minute) ;; minute
-;; 		      (let ((copy-now (apply vector (vector->list now-time))))
-;; 			(vector-set! copy-now 0 0) ;; force seconds to zero
-;; 			(vector-set! copy-now 1 minute)
-;; 			(vector-set! copy-now 2 hr)
-;; 			(vector-set! copy-now 3 dom)  ;; dom is already corrected for zero referenced
-;; 			(vector-set! copy-now 4 month)
-;; 			(let* ((copy-now-secs (local-time->seconds copy-now))
-;; 			       (new-copy      (seconds->local-time copy-now-secs))) ;; remake the time vector
-;; 			  (if (or (not cdayofweek)
-;; 				  (equal? (vector-ref new-copy 6)
-;; 					  cdayofweek)) ;; if the day is specified and a match OR if the day is NOT specified
-;; 			      (if (or (not cdayofmonth)
-;; 				      (equal? (vector-ref new-copy 3)
-;; 					      (+ 1 cdayofmonth))) ;; if the month is specified and a match OR if the month is NOT specified
-;; 				  (hash-table-set! all-times copy-now-secs new-copy))))))
-;; 		    (if cmin
-;; 			`(,cmin)  ;; if given cmin, have to use it
-;; 			(list (- nmin 1) nmin (+ nmin 1))))) ;; minute
-;; 		 (if chour
-;; 		     `(,chour)
-;; 		     (list (- nhour 1) nhour (+ nhour 1))))) ;; hour
-;; 	      (if cdayofmonth
-;; 		  `(,cdayofmonth)
-;; 		  (list (- ndayofmonth 1) ndayofmonth (+ ndayofmonth 1)))))
-;; 	   (if cmonth
-;; 	       `(,cmonth)
-;; 	       (list (- nmonth 1) nmonth (+ nmonth 1))))
-;; 	  (let ((before #f)
-;; 		(is-in  #f))
-;; 	    (for-each
-;; 	     (lambda (moment)
-;; 	       (if (and before
-;; 			(<= before now-seconds)
-;; 			(>= moment now-seconds))
-;; 		   (begin
-;; 		     ;; (print)
-;; 		     ;; (print "Before: " (time->string (seconds->local-time before)))
-;; 		     ;; (print "Now:    " (time->string (seconds->local-time now-seconds)))
-;; 		     ;; (print "After:  " (time->string (seconds->local-time moment)))
-;; 		     ;; (print "Last:   " (time->string (seconds->local-time last-done)))
-;; 		     (if (<  last-done before)
-;; 			 (set! is-in before))
-;; 		     ))
-;; 	       (set! before moment))
-;; 	     (sort (hash-table-keys all-times) <))
-;; 	    is-in)))))
-;; 
-;; (define (common:extended-cron  cron-str now-seconds-in last-done)
-;;   (let ((expanded-cron (common:cron-expand cron-str)))
-;;     (if (string? expanded-cron)
-;; 	(common:cron-event expanded-cron now-seconds-in last-done)
-;; 	(let loop ((hed (car expanded-cron))
-;; 		   (tal (cdr expanded-cron)))
-;; 	  (if (common:cron-event hed now-seconds-in last-done)
-;; 	      #t
-;; 	      (if (null? tal)
-;; 		  #f
-;; 		  (loop (car tal)(cdr tal))))))))
-;; 
-;; ;;======================================================================
-;; ;; C O L O R S
-;; ;;======================================================================
-;;       
-;; (define (common:name->iup-color name)
-;;   (case (string->symbol (string-downcase name))
-;;     ((red)    "223 33 49")
-;;     ((grey)   "192 192 192")
-;;     ((orange) "255 172 13")
-;;     ((purple) "This is unfinished ...")))
-;; 
-;; ;; (define (common:get-color-for-state-status state status)
-;; ;;   (case (string->symbol state)
-;; ;;     ((COMPLETED)
-;; ;;      (case (string->symbol status)
-;; ;;        ((PASS)        "70  249 73")
-;; ;;        ((WARN WAIVED) "255 172 13")
-;; ;;        ((SKIP)        "230 230 0")
-;; ;;        (else "223 33 49")))
-;; ;;     ((LAUNCHED)         "101 123 142")
-;; ;;     ((CHECK)            "255 100 50")
-;; ;;     ((REMOTEHOSTSTART)  "50  130 195")
-;; ;;     ((RUNNING)          "9   131 232")
-;; ;;     ((KILLREQ)          "39  82  206")
-;; ;;     ((KILLED)           "234 101 17")
-;; ;;     ((NOT_STARTED)      "240 240 240")
-;; ;;     (else               "192 192 192")))
-;; 
-;; (define (common:iup-color->rgb-hex instr)
-;;   (string-intersperse 
-;;    (map (lambda (x)
-;;           (number->string x 16))
-;;         (map string->number
-;;              (string-split instr)))
-;;    "/"))
-;; 
-;; ;; dot-locking egg seems not to work, using this for now
-;; ;; if lock is older than expire-time then remove it and try again
-;; ;; to get the lock
-;; ;;
-;; (define (common:simple-file-lock fname #!key (expire-time 300))
-;;     (if (file-exists? fname)
-;; 	(if (> (- (current-seconds)(file-modification-time fname)) expire-time)
-;; 	    (begin
-;;               (handle-exceptions exn #f (delete-file* fname))	
-;; 	      (common:simple-file-lock fname expire-time: expire-time))
-;; 	    #f)
-;; 	(let ((key-string (conc (get-host-name) "-" (current-process-id))))
-;; 	  (with-output-to-file fname
-;; 	    (lambda ()
-;; 	      (print key-string)))
-;; 	  (thread-sleep! 0.25)
-;; 	  (if (file-exists? fname)
-;; 	      (handle-exceptions exn
-;;                 #f 
-;;                 (with-input-from-file fname
-;; 	  	  (lambda ()
-;; 		    (equal? key-string (read-line)))))
-;; 	      #f))))
-;; 
-;; (define (common:simple-file-lock-and-wait fname #!key (expire-time 300))
-;;   (let ((end-time (+ expire-time (current-seconds))))
-;;     (let loop ((got-lock (common:simple-file-lock fname expire-time: expire-time)))
-;;       (if got-lock
-;; 	  #t
-;; 	  (if (> end-time (current-seconds))
-;; 	      (begin
-;; 		(thread-sleep! 3)
-;; 		(loop (common:simple-file-lock fname expire-time: expire-time)))
-;; 	      #f)))))
-;; 
-;; (define (common:simple-file-release-lock fname)
-;;   (handle-exceptions
-;;       exn
-;;       #f ;; I don't really care why this failed (at least for now)
-;;     (delete-file* fname)))
-;; 
-;; ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
-;; ;;
-;; (define (common:lazy-modification-time fpath)
-;;   (handle-exceptions
-;;       exn
-;;       0
-;;       (file-modification-time fpath)))
-;; 
-;; ;; find timestamp of newest file associated with a sqlite db file
-;; (define (common:lazy-sqlite-db-modification-time fpath)
-;;   (let* ((glob-list (handle-exceptions
-;; 			exn
-;; 			`(,(conc "/no/such/file, message: " ((condition-property-accessor 'exn 'message) exn)))
-;; 		      (glob (conc fpath "*"))))
-;;          (file-list (if (eq? 0 (length glob-list))
-;; 			'("/no/such/file")
-;; 			glob-list)))
-;;   (apply max
-;;    (map
-;;     common:lazy-modification-time 
-;;     file-list))))
-;; 
-;; 
-;; ;; execute thunk, return value.  If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
-;; ;; arguments - thunk, message
-;; (define (common:fail-safe thunk warning-message-on-exception)
-;;   (handle-exceptions
-;;    exn
-;;    (begin
-;;      (debug:print-info 0 *default-log-port* "notable but nonfatal condition - "warning-message-on-exception)
-;;      (debug:print-info 0 *default-log-port*
-;;                        (string-substitute "\n?Error:" "nonfatal condition:"
-;;                                           (with-output-to-string
-;;                                             (lambda ()
-;;                                               (print-error-message exn) ))))
-;;      (debug:print-info 0 *default-log-port* "    -- continuing after nonfatal condition...")
-;;      #f)
-;;    (thunk)))
-;; 
-;; (define getenv get-environment-variable)
-;; (define (safe-setenv key val)
-;;   (if (or (substring-index "!" key) (substring-index ":" key)) ;; variables containing : are for internal use and cannot be environment variables.
-;;       (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
-;;       (if (and (string? val)
-;; 	       (string? key))
-;; 	  (handle-exceptions
-;; 	      exn
-;; 	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
-;; 	    (setenv key val))
-;; 	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
-;; 
-;; (define home (getenv "HOME"))
-;; (define user (getenv "USER"))
-;; 
-;; 
-;; ;; returns list of fd count, socket count
-;; (define (get-file-descriptor-count #!key  (pid (current-process-id )))
-;;   (list
-;;     (length (glob (conc "/proc/" pid "/fd/*")))
-;;     (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
-;;   )
-;; )
-;;
+(define *common:logpro-exit-code->status-sym-alist*
+  '( ( 0 . pass )
+     ( 1 . fail )
+     ( 2 . warn )
+     ( 3 . check )
+     ( 4 . waived )
+     ( 5 . abort )
+     ( 6 . skip )))
+
+(define (common:logpro-exit-code->status-sym exit-code)
+  (or (alist-ref exit-code *common:logpro-exit-code->status-sym-alist*) 'fail))
+
+(define (common:worse-status-sym ss1 ss2)
+  (let loop ((status-syms-remaining '(abort fail check skip warn waived pass)))
+    (cond
+     ((null? status-syms-remaining)
+      'fail)
+     ((eq? (car status-syms-remaining) ss1)
+      ss1)
+     ((eq? (car status-syms-remaining) ss2)
+      ss2)
+     (else
+      (loop (cdr status-syms-remaining))))))
+
+(define (common:steps-can-proceed-given-status-sym status-sym)
+  (if (member status-sym '(warn waived pass))
+      #t
+      #f))
+
+(define (status-sym->string status-sym)
+  (case status-sym
+      ((pass) "PASS")
+    ((fail) "FAIL")
+    ((warn) "WARN")
+    ((check) "CHECK")
+    ((waived) "WAIVED")
+    ((abort) "ABORT")
+    ((skip) "SKIP")
+    (else "FAIL")))
+
+(define (common:logpro-exit-code->test-status exit-code)
+  (status-sym->string (common:logpro-exit-code->status-sym exit-code)))
+
+(define (common:clear-caches)
+  (set! *target*             (make-hash-table))
+  (set! *keys*               (make-hash-table))
+  (set! *keyvals*            (make-hash-table))
+  (set! *toptest-paths*      (make-hash-table))
+  (set! *test-paths*         (make-hash-table))
+  (set! *test-ids*           (make-hash-table))
+  (set! *test-info*          (make-hash-table))
+  (set! *run-info-cache*     (make-hash-table))
+  (set! *env-vars-by-run-id* (make-hash-table))
+  (set! *test-id-cache*      (make-hash-table)))
+
+;; Generic string database
+(define sdb:qry #f) ;; (make-sdb:qry)) ;;  'init #f)
+;; Generic path database
+(define *fdb* #f)
+
+(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.
+
+;;======================================================================
+;; V E R S I O N
+;;======================================================================
+
+(define (common:get-full-version)
+  (conc megatest-version "-" megatest-fossil-hash))
+
+(define (common:version-signature)
+  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
+
+
+(define (common:get-sync-lock-filepath)
+  (let* ((tmp-area     (common:get-db-tmp-area))
+         (lockfile     (conc tmp-area "/megatest.db.sync-lock")))
+    lockfile))
+    
+;;======================================================================
+;; U S E F U L   S T U F F
+;;======================================================================
+
+;; convert things to an alist or assoc list, #f gets converted to ""
+;;
+(define (common:to-alist dat)
+  (cond
+   ((list? dat)   (map common:to-alist dat))
+   ((vector? dat)
+    (map common:to-alist (vector->list dat)))
+   ((pair? dat)
+    (cons (common:to-alist (car dat))
+	  (common:to-alist (cdr dat))))
+   ((hash-table? dat)
+    (map common:to-alist (hash-table->alist dat)))
+   (else
+    (if dat
+	dat
+	""))))
+
+(define (common:alist-ref/default key alist default)
+  (or (alist-ref key alist) default))
+
+(define (common:low-noise-print waitval . keys)
+  (let* ((key      (string-intersperse (map conc keys) "-" ))
+	 (lasttime (hash-table-ref/default *common:denoise* key 0))
+	 (currtime (current-seconds)))
+    (if (> (- currtime lasttime) waitval)
+	(begin
+	  (hash-table-set! *common:denoise* key currtime)
+	  #t)
+	#f)))
+
+(define (common:get-megatest-exe)
+  (or (getenv "MT_MEGATEST") "megatest"))
+
+(define (common:read-encoded-string instr)
+  (handle-exceptions
+   exn
+   (handle-exceptions
+    exn
+    (begin
+      (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
+      (print-call-chain (current-error-port))
+      #f)
+    (read (open-input-string (base64:base64-decode instr))))
+   (read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))
+
+;;======================================================================
+;; Configf extentions
+;;======================================================================
+
+(define (get-with-default val default)
+  (let ((val (args:get-arg val)))
+    (if val val default)))
+
+(define (assoc/default key lst . default)
+  (let ((res (assoc key lst)))
+    (if res (cadr res)(if (null? default) #f (car default)))))
+
+(define (common:get-testsuite-name)
+  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
+      (configf:lookup *configdat* "setup" "testsuite" )
+      (getenv "MT_TESTSUITE_NAME")
+      (if (string? *toppath* )
+          (pathname-file *toppath*)
+          #f))) ;; (pathname-file (current-directory)))))
+
+(define common:get-area-name common:get-testsuite-name)
+
+(define (common:get-db-tmp-area . junk)
+  (if *db-cache-path*
+      *db-cache-path*
+      (if *toppath* ;; common:get-create-writeable-dir
+	  (handle-exceptions
+	      exn
+	      (begin
+		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path*)
+		(exit 1))
+	    (let ((dbpath (common:get-create-writeable-dir
+			   (list (conc "/tmp/" (current-user-name)
+				       "/megatest_localdb/"
+				       (common:get-testsuite-name) "/"
+				       (string-translate *toppath* "/" ".")))))) ;;  #t))))
+	      (set! *db-cache-path* dbpath)
+	      dbpath))
+	  #f)))
+
 
 ;; pulled from common_records.scm
 
 ;; globals - modules that include this need these here
 (define *logging* #f)

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -26,11 +26,12 @@
 (use canvas-draw)
 (import canvas-draw-iup)
 (use ducttape-lib)
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records
      sparse-vectors srfi-18
-     (prefix mtconfigf configf:)) 
+     (prefix mtconfigf configf:)
+     (prefix margs args:))
 (import (prefix sqlite3 sqlite3:))
 
 ;; (declare (uses common))
 ;; (declare (uses margs))
 ;; (declare (uses keys))
@@ -59,10 +60,12 @@
 (import rmtmod)
 (declare (uses runsmod))
 (import runsmod)
 (declare (uses dbmod))
 (import dbmod)
+(declare (uses testsmod))
+(import testsmod)
 
 (declare (uses dcommonmod))
 (import dcommonmod)
 
 (include "common_records.scm")
@@ -72,10 +75,11 @@
 ;; (include "megatest-fossil-hash.scm") ;; comes from megamod
 (include "vg_records.scm")
 
 ;; invoke the imports
 (declare (uses commonmod.import))
+(declare (uses testsmod.import))
 (declare (uses rmtmod.import))
 (declare (uses runsmod.import))
 (declare (uses megamod.import))
 (declare (uses dcommonmod.import))
 

Index: db-inc.scm
==================================================================
--- db-inc.scm
+++ db-inc.scm
@@ -2087,31 +2087,10 @@
 	  (set! res val))
 	db
 	(conc "SELECT " key " FROM runs WHERE id=?;")
 	run-id)
        res))))
-
-;; keys list to key1,key2,key3 ...
-(define (runs:get-std-run-fields keys remfields)
-  (let* ((header    (append keys remfields))
-	 (keystr    (conc (keys->keystr keys) ","
-			  (string-intersperse remfields ","))))
-    (list keystr header)))
-
-;; make a query (fieldname like 'patt1' OR fieldname 
-(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
-  (let ((patts (if (string? pattstr)
-		   (string-split pattstr ",")
-		   '("%"))))
-    (string-intersperse (map (lambda (patt)
-			       (let ((wildtype (if (substring-index "%" patt) "LIKE" "GLOB")))
-				 (conc fieldname " " wildtype " '" patt "'")))
-			     (if (null? patts)
-				 '("")
-				 patts))
-			comparator)))
-
 
 ;; register a test run with the db, this accesses the main.db and does NOT
 ;; use server api
 ;;
 (define (db:register-run dbstruct keyvals runname state status user contour-in)
@@ -4325,74 +4304,10 @@
 		  res))))
 
 ;;======================================================================
 ;; M I S C   M A N A G E M E N T   I T E M S 
 ;;======================================================================
-
-;; A routine to map itempaths using a itemmap
-;; patha and pathb must be strings or this will fail
-;;
-;; path-b is waiting on path-a
-;;
-(define (db:compare-itempaths test-b-name path-a path-b itemmaps )
-  (debug:print-info 6 *default-log-port* "ITEMMAPS: " itemmaps)
-  (let* ((itemmap    (tests:lookup-itemmap itemmaps test-b-name)))
-    (if itemmap
-	(let ((path-b-mapped (db:multi-pattern-apply path-b itemmap)))
-	  (debug:print-info 6 *default-log-port* "ITEMMAP is " itemmap ", path: " path-b ", mapped path: " path-b-mapped)
-	  (equal? path-a path-b-mapped))
-	(equal? path-b path-a))))
-
-;; A routine to convert test/itempath using a itemmap
-;; NOTE: to process only an itempath (i.e. no prepended testname)
-;;       just call db:multi-pattern-apply
-;;
-(define (db:convert-test-itempath path-in itemmap)
-  (debug:print-info 6 *default-log-port* "ITEMMAP is " itemmap)
-  (let* ((path-parts  (string-split path-in "/"))
-	 (test-name   (if (null? path-parts) "" (car path-parts)))
-	 (item-path   (string-intersperse (if (null? path-parts) '() (cdr path-parts)) "/")))
-    (conc test-name "/" 
-	  (db:multi-pattern-apply item-path itemmap))))
-
-;; patterns are:
-;;    "rx1"  "replacement1"\n
-;;    "rx2"  "replacement2"
-;; etc.
-;;
-(define (db:multi-pattern-apply item-path itemmap)
-  (let ((all-patts (string-split itemmap "\n")))
-    (if (null? all-patts)
-	item-path
-	(let loop ((hed (car all-patts))
-		   (tal (cdr all-patts))
-		   (res item-path))
-	  (let* ((parts (string-split hed))
-		 (patt  (car parts))
-
-		 (repl  (if (> (length parts) 1)(cadr parts) ""))
-
-		 (newr  (if (and patt repl)
-			    (begin
-                              (handle-exceptions
-                               exn
-                               (begin
-                                  (debug:print 0 *default-log-port*
-                                  "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
-                                 res)
-                              (string-substitute patt repl res))
-
-
-                              )
-			    (begin
-                              (debug:print 0 *default-log-port*
-                               "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
-			      res))))
-	    (if (null? tal)
-		newr
-		(loop (car tal)(cdr tal) newr)))))))
-
 
 
 
 ;; the new prereqs calculation, looks also at itempath if specified
 ;; all prereqs must be met

Index: dcommonmod.scm
==================================================================
--- dcommonmod.scm
+++ dcommonmod.scm
@@ -18,10 +18,11 @@
 
 ;;======================================================================
 
 (declare (unit dcommonmod))
 (declare (uses commonmod))
+(declare (uses testsmod))
 (declare (uses megamod))
 
 (module dcommonmod
 	*
 	
@@ -80,10 +81,11 @@
 	)
 
 (use (prefix mtconfigf configf:))
 
 (import commonmod)
+(import testsmod)
 (import megamod)
 (import canvas-draw)
 (import canvas-draw-iup)
 (use (prefix iup iup:))
 

Index: keys-inc.scm
==================================================================
--- keys-inc.scm
+++ keys-inc.scm
@@ -15,62 +15,5 @@
 ;; 
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
  
-;;======================================================================
-;; Run keys, these are used to hierarchially organise tests and run areas
-;;======================================================================
-
-(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
-  (string-intersperse keys ","))
-
-(define (args:usage . a) #f)
-
-;;======================================================================
-;; key <=> target routines
-;;======================================================================
-
-;; This invalidates using "/" in item names. Every key will be
-;; available via args:get-arg as :keyfield. Since this only needs to
-;; be called once let's use it to set the environment vars
-;;
-;; The setting of :keyfield in args should be turned off ASAP
-;;
-(define (keys:target-set-args keys target ht)
-  (if target
-      (let ((vals (string-split target "/")))
-	(if (eq? (length vals)(length keys))
-	    (for-each (lambda (key val)
-			(setenv key val)
-			(if ht (hash-table-set! ht (conc ":" key) val)))
-		      keys
-		      vals)
-	    (debug:print-error 0 *default-log-port* "wrong number of values in " target ", should match " keys))
-	vals)
-      (debug:print 4 *default-log-port* "ERROR: keys:target-set-args called with no target.")))
-
-;; given the keys (a list of vectors <key field> or a list of keys) and a target return a keyval list
-;; keyval list ( (key1 val1) (key2 val2) ...)
-(define (keys:target->keyval keys target)
-  (let* ((targlist (string-split target "/"))
-	 (numkeys  (length keys))
-	 (numtarg  (length targlist))
-	 (targtweaked (if (> numkeys numtarg)
-			  (append targlist (make-list (- numkeys numtarg) ""))
-			  targlist)))
-    (map (lambda (key targ)
-	   (list key targ))
-	 keys targtweaked)))
-
-;;======================================================================
-;; config file related routines
-;;======================================================================
-
-(define keys:config-get-fields common:get-fields)
-(define (keys:make-key/field-string confdat)
-  (let ((fields (configf:get-section confdat "fields")))
-    (string-join
-     (map (lambda (field)(conc (car field) " " (cadr field)))
-	  fields)
-     ",")))
-

Index: megamod.scm
==================================================================
--- megamod.scm
+++ megamod.scm
@@ -39,11 +39,11 @@
 ;; (declare (uses runconfigmod))
 (declare (uses runsmod))
 ;; (declare (uses servermod))
 ;; (declare (uses subrunmod))
 ;; (declare (uses tasksmod))
-;; (declare (uses testsmod))
+(declare (uses testsmod))
 ;; (declare (uses vgmod))
 
 (module megamod
 	*
 	
@@ -122,11 +122,11 @@
 ;; (import runconfigmod)
 (import runsmod)
 ;; (import servermod)
 ;; (import subrunmod)
 ;; (import tasksmod)
-;; (import testsmod)
+(import testsmod)
 ;; (import vgmod)
 
 (use (prefix ulex ulex:))
 
 (include "common_records.scm")
@@ -168,11 +168,11 @@
 (include "common-inc.scm")    ;; L5
 (include "db-inc.scm")        ;; L4
 (include "env-inc.scm")
 (include "http-transport-inc.scm")
 (include "items-inc.scm")
-(include "keys-inc.scm")
+;; (include "keys-inc.scm")
 (include "launch-inc.scm")     ;; L1
 (include "margs-inc.scm")
 (include "mt-inc.scm")
 (include "ods-inc.scm")        ;; L1
 (include "pgdb-inc.scm")

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -23,11 +23,12 @@
 (define (toplevel-command . a) #f)
 
 (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
      readline apropos json http-client directory-utils typed-records
      http-client srfi-18 extras format
-     (prefix mtconfigf configf:))
+     (prefix mtconfigf configf:)
+     (prefix margs args:))
 
 ;; Added for csv stuff - will be removed
 ;;
 (use sparse-vectors)
 
@@ -54,15 +55,18 @@
 (import rmtmod)
 (declare (uses dbmod))
 (import dbmod)
 (declare (uses runsmod))
 (import runsmod)
+(declare (uses testsmod))
+(import testsmod)
 (declare (uses megamod))
 (import megamod)
 
 ;; invoke the imports
 (declare (uses commonmod.import))
+(declare (uses testsmod.import))
 (declare (uses rmtmod.import))
 (declare (uses runsmod.import))
 (declare (uses megamod.import))
 
 (configf:set-debug-printers debug:print debug:print-info debug:print-error *default-log-port*)

Index: runs-inc.scm
==================================================================
--- runs-inc.scm
+++ runs-inc.scm
@@ -270,14 +270,10 @@
 		  (debug:print 0 *default-log-port* "ERROR: failed to run post-hook " run-post-hook ", check the log " log-file))
 	      (debug:print-info 0 *default-log-port* "running run-post-hook: \"" run-post-hook "\", log is " actual-logf)
 	      (system (conc run-post-hook " >> " actual-logf " 2>&1"))
 	      (debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))
 
-;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise.
-(define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon)
-  (null? (tests:filter-test-names-not-matched waitors-upon test-patt)))
-
 ;;======================================================================
 ;; runs:run-tests is called from megatest.scm and itself
 ;;======================================================================
 ;;
 ;;  test-names: Comma separated patterns same as test-patts but used in selection 

Index: runsmod.scm
==================================================================
--- runsmod.scm
+++ runsmod.scm
@@ -18,17 +18,19 @@
 
 ;;======================================================================
 
 (declare (unit runsmod))
 (declare (uses commonmod))
+(declare (uses testsmod))
 
 (module runsmod
 	*
 	
 (import scheme chicken data-structures extras)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable)
 (import commonmod)
+(import testsmod)
 ;; (use (prefix ulex ulex:))
 
 ;; (include "common_records.scm")
 (defstruct runs:dat
   reglen regfull
@@ -89,7 +91,11 @@
     (if (> (- currtime lasttime) waitval)
 	(begin
 	  (hash-table-set! *runs:denoise* key currtime)
 	  #t)
 	#f)))
+
+;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise.
+(define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon)
+  (null? (tests:filter-test-names-not-matched waitors-upon test-patt)))
 
 )

Index: tests-inc.scm
==================================================================
--- tests-inc.scm
+++ tests-inc.scm
@@ -20,105 +20,10 @@
 
 ;;======================================================================
 ;; Tests
 ;;======================================================================
 
-(define *java-script-lib* #f)
-
-(define (init-java-script-lib)
-  (set! *java-script-lib* (conc  (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
-  )
-
-;; Call this one to do all the work and get a standardized list of tests
-;;   gets paths from configs and finds valid tests 
-;;   returns hash of testname --> fullpath
-;;
-(define (tests:get-all)
-  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
-    (tests:get-valid-tests (make-hash-table) test-search-path)))
-
-(define (tests:get-tests-search-path cfgdat)
-  (let ((paths (let ((section (if cfgdat
-				  (configf:get-section cfgdat "tests-paths")
-				  #f)))
-		 (if section
-		     (map cadr section)
-		     '()))))
-    (filter (lambda (d)
-	      (if (directory-exists? d)
-		  d
-		  (begin
-		    (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
-			(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
-		    #f)))
-	    (append paths (list (conc *toppath* "/tests"))))))
-
-(define (tests:get-valid-tests test-registry tests-paths)
-  (if (null? tests-paths) 
-      test-registry
-      (let loop ((hed (car tests-paths))
-		 (tal (cdr tests-paths)))
-	(if (common:file-exists? hed)
-	    (for-each (lambda (test-path)
-			(let* ((tname   (last (string-split test-path "/")))
-			       (tconfig (conc test-path "/testconfig")))
-			  (if (and (not (hash-table-ref/default test-registry tname #f))
-				   (common:file-exists? tconfig))
-			      (hash-table-set! test-registry tname test-path))))
-		      (glob (conc hed "/*"))))
-	(if (null? tal)
-	    test-registry
-	    (loop (car tal)(cdr tal))))))
-
-(define (tests:filter-test-names-not-matched test-names test-patts)
-  (delete-duplicates
-   (filter (lambda (testname)
-	     (not (tests:match test-patts testname #f)))
-	   test-names)))
-
-
-(define (tests:filter-test-names test-names test-patts)
-  (delete-duplicates
-   (filter (lambda (testname)
-	     (tests:match test-patts testname #f))
-	   test-names)))
-
-;; itemmap is a list of testname patterns to maps
-;;     test1 .*/bar/(\d+) foo/\1
-;;     %     foo/([^/]+)  \1/bar
-;;
-;; # NOTE: the line with the single % could be the result of
-;; #       itemmap entry in requirements (legacy). The itemmap
-;; #       requirements entry is deprecated
-;;
-(define (tests:get-itemmaps tconfig)
-  (let ((base-itemmap  (configf:lookup tconfig "requirements" "itemmap"))
-	(itemmap-table (configf:get-section tconfig "itemmap")))
-    (append (if base-itemmap
-		(list (list "%" base-itemmap))
-		'())
-	    (if itemmap-table
-		itemmap-table
-		'()))))
-
-;; given a list of itemmaps (testname . map), return the first match
-;;
-(define (tests:lookup-itemmap itemmaps testname)
-  (let ((best-matches (filter (lambda (itemmap)
-				(tests:match (car itemmap) testname #f))
-			      itemmaps)))
-    (if (null? best-matches)
-	#f
-	(let ((res (car best-matches)))
-	  ;; (debug:print 0 *default-log-port* "res=" res)
-	  (cond
-	   ((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
-	   ((null? res)   #f)
-	   ((string? (cdr res)) (cdr res))  ;; it is a pair
-	   ((string? (cadr res))(cadr res)) ;; it is a list
-	   (else cadr res))))))
-
 ;; return items given config
 ;;
 (define (tests:get-items tconfig)
   (let ((items      (hash-table-ref/default tconfig "items" #f)) ;; items 4
 	(itemstable (hash-table-ref/default tconfig "itemstable" #f))) 
@@ -195,135 +100,10 @@
 			  (debug:print-error 0 *default-log-port* "test " test-name " has unrecognised waiton testname " x)
 			  #f)))
 		  newwaitors)
 	  config)))))
 					     
-;; given waiting-test that is waiting on waiton-test extend test-patt appropriately
-;;
-;;  genlib/testconfig               sim/testconfig
-;;  genlib/sch                      sim/sch/cell1
-;;
-;;  [requirements]                  [requirements]
-;;                                  mode itemwait
-;;                                  # trim off the cell to determine what to run for genlib
-;;                                  itemmap /.*
-;;
-;;                                  waiting-test is waiting on waiton-test so we need to create a pattern for waiton-test given waiting-test and itemmap
-;; BB> (tests:extend-test-patts "normal-second/2" "normal-second" "normal-first" '())
-;; observed -> "normal-first/2,normal-first/,normal-second/2,normal-second/"
-;; expected -> "normal-first,normal-second/2,normal-second/"
-;; testpatt = normal-second/2
-;; waiting-test = normal-second
-;; waiton-test = normal-first
-;; itemmaps = ()
-
-(define (tests:extend-test-patts test-patt waiting-test waiton-test itemmaps itemized-waiton)
-  (cond
-   (itemized-waiton
-    (let* ((itemmap          (tests:lookup-itemmap itemmaps waiton-test))
-           (patts            (string-split test-patt ","))
-           (waiting-test-len (+ (string-length waiting-test) 1))
-           (patts-waiton     (map (lambda (x)  ;; for each incoming patt that matches the waiting test
-                                    (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
-                                           (newpatt (conc waiton-test "/" (substring modpatt waiting-test-len (string-length modpatt)))))
-                                      ;; (conc waiting-test "/," waiting-test "/" (substring modpatt waiton-test-len (string-length modpatt)))))
-                                      ;; (print "in map, x=" x ", newpatt=" newpatt)
-                                      newpatt))
-                                  (filter (lambda (x)
-                                            (eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
-                                          patts)))
-           (extended-test-patt   (append patts (if (null? patts-waiton)
-                                                   (list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
-                                                   patts-waiton)))
-           (extended-test-patt-with-toplevels
-            (fold (lambda (testpatt-item accum )
-                    (let ((my-match (string-match "^([^%\\/]+)\\/.+$" testpatt-item)))
-                      (cons testpatt-item
-                            (if my-match
-                                (cons
-                                 (conc (cadr my-match) "/")
-                                 accum)
-                                accum))))
-                  '()
-                  extended-test-patt)))
-      (string-intersperse (delete-duplicates extended-test-patt-with-toplevels) ",")))
-   (else ;; not waiting on items, waiting on entire waiton test.
-    (let* ((patts (string-split test-patt ","))
-           (new-patts (if (member waiton-test patts)
-                          patts
-                          (cons waiton-test patts))))
-      (string-intersperse (delete-duplicates new-patts) ",")))))
-
-
-  
-;; tests:glob-like-match 
-(define (tests:glob-like-match patt str) 
-  (let ((like (substring-index "%" patt)))
-    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
-	   (newpatt  (if notpatt (substring patt 1) patt))
-	   (finpatt  (if like
-			(string-substitute (regexp "%") ".*" newpatt #f)
-			(string-substitute (regexp "\\*") ".*" newpatt #f)))
-	   (res      #f))
-      ;; (print "tests:glob-like-match => notpatt: " notpatt ", newpatt: " newpatt ", finpatt: " finpatt)
-      (set! res (string-match (regexp finpatt (if like #t #f)) str))
-      (if notpatt (not res) res))))
-
-;; if itempath is #f then look only at the testname part
-;;
-(define (tests:match patterns testname itempath #!key (required '()))
-  (if (string? patterns)
-      (let ((patts (append (string-split patterns ",") required)))
-	(if (null? patts) ;;; no pattern(s) means no match
-	    #f
-	    (let loop ((patt (car patts))
-		       (tal  (cdr patts)))
-	      ;; (print "loop: patt: " patt ", tal " tal)
-	      (if (string=? patt "")
-		  #f ;; nothing ever matches empty string - policy
-		  (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
-			 (test-patt  (cadr patt-parts))
-			 (item-patt  (cadddr patt-parts)))
-		    ;; special case: test vs. test/
-		    ;;   test  => "test" "%"
-		    ;;   test/ => "test" ""
-		    (if (and (not (substring-index "/" patt)) ;; no slash in the original
-			     (or (not item-patt)
-				 (equal? item-patt "")))      ;; should always be true that item-patt is ""
-			(set! item-patt "%"))
-		    ;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
-		    (if (and (tests:glob-like-match test-patt testname)
-			     (or (not itempath)
-				 (tests:glob-like-match (if item-patt item-patt "") itempath)))
-			#t
-			(if (null? tal)
-			    #f
-			    (loop (car tal)(cdr tal)))))))))))
-
-;; if itempath is #f then look only at the testname part
-;;
-(define (tests:match->sqlqry patterns)
-  (if (string? patterns)
-      (let ((patts (string-split patterns ",")))
-	(if (null? patts) ;;; no pattern(s) means no match, we will do no query
-	    #f
-	    (let loop ((patt (car patts))
-		       (tal  (cdr patts))
-		       (res  '()))
-	      ;; (print "loop: patt: " patt ", tal " tal)
-	      (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
-		     (test-patt  (cadr patt-parts))
-		     (item-patt  (cadddr patt-parts))
-		     (test-qry   (db:patt->like "testname" test-patt))
-		     (item-qry   (db:patt->like "item_path" item-patt))
-		     (qry        (conc "(" test-qry " AND " item-qry ")")))
-		;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
-		(if (null? tal)
-		    (string-intersperse (append (reverse res)(list qry)) " OR ")
-		    (loop (car tal)(cdr tal)(cons qry res)))))))
-      #f))
-
 ;; Check for waiver eligibility
 ;;
 (define (tests:check-waiver-eligibility testdat prev-testdat)
   (let* ((test-registry (make-hash-table))
 	 (testconfig  (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f))

Index: testsmod.scm
==================================================================
--- testsmod.scm
+++ testsmod.scm
@@ -23,12 +23,375 @@
 
 (module testsmod
 	*
 	
 (import scheme chicken data-structures extras)
-(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable)
+
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable
+	(prefix mtconfigf configf:)
+	regex srfi-13
+	)
 (import commonmod)
 ;; (use (prefix ulex ulex:))
 
-(include "common_records.scm")
+(define *java-script-lib* #f)
+
+(define (init-java-script-lib)
+  (set! *java-script-lib* (conc  (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
+  )
+
+;; A routine to map itempaths using a itemmap
+;; patha and pathb must be strings or this will fail
+;;
+;; path-b is waiting on path-a
+;;
+(define (db:compare-itempaths test-b-name path-a path-b itemmaps )
+  (debug:print-info 6 *default-log-port* "ITEMMAPS: " itemmaps)
+  (let* ((itemmap    (tests:lookup-itemmap itemmaps test-b-name)))
+    (if itemmap
+	(let ((path-b-mapped (db:multi-pattern-apply path-b itemmap)))
+	  (debug:print-info 6 *default-log-port* "ITEMMAP is " itemmap ", path: " path-b ", mapped path: " path-b-mapped)
+	  (equal? path-a path-b-mapped))
+	(equal? path-b path-a))))
+
+;; A routine to convert test/itempath using a itemmap
+;; NOTE: to process only an itempath (i.e. no prepended testname)
+;;       just call db:multi-pattern-apply
+;;
+(define (db:convert-test-itempath path-in itemmap)
+  (debug:print-info 6 *default-log-port* "ITEMMAP is " itemmap)
+  (let* ((path-parts  (string-split path-in "/"))
+	 (test-name   (if (null? path-parts) "" (car path-parts)))
+	 (item-path   (string-intersperse (if (null? path-parts) '() (cdr path-parts)) "/")))
+    (conc test-name "/" 
+	  (db:multi-pattern-apply item-path itemmap))))
+
+;;======================================================================
+;; Run keys, these are used to hierarchially organise tests and run areas
+;;======================================================================
+
+(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
+  (string-intersperse keys ","))
+
+(define (args:usage . a) #f)
+
+;;======================================================================
+;; key <=> target routines
+;;======================================================================
+
+;; This invalidates using "/" in item names. Every key will be
+;; available via args:get-arg as :keyfield. Since this only needs to
+;; be called once let's use it to set the environment vars
+;;
+;; The setting of :keyfield in args should be turned off ASAP
+;;
+(define (keys:target-set-args keys target ht)
+  (if target
+      (let ((vals (string-split target "/")))
+	(if (eq? (length vals)(length keys))
+	    (for-each (lambda (key val)
+			(setenv key val)
+			(if ht (hash-table-set! ht (conc ":" key) val)))
+		      keys
+		      vals)
+	    (debug:print-error 0 *default-log-port* "wrong number of values in " target ", should match " keys))
+	vals)
+      (debug:print 4 *default-log-port* "ERROR: keys:target-set-args called with no target.")))
+
+;; given the keys (a list of vectors <key field> or a list of keys) and a target return a keyval list
+;; keyval list ( (key1 val1) (key2 val2) ...)
+(define (keys:target->keyval keys target)
+  (let* ((targlist (string-split target "/"))
+	 (numkeys  (length keys))
+	 (numtarg  (length targlist))
+	 (targtweaked (if (> numkeys numtarg)
+			  (append targlist (make-list (- numkeys numtarg) ""))
+			  targlist)))
+    (map (lambda (key targ)
+	   (list key targ))
+	 keys targtweaked)))
+
+;;======================================================================
+;; config file related routines
+;;======================================================================
+
+(define keys:config-get-fields common:get-fields)
+(define (keys:make-key/field-string confdat)
+  (let ((fields (configf:get-section confdat "fields")))
+    (string-join
+     (map (lambda (field)(conc (car field) " " (cadr field)))
+	  fields)
+     ",")))
+
+;; patterns are:
+;;    "rx1"  "replacement1"\n
+;;    "rx2"  "replacement2"
+;; etc.
+;;
+(define (db:multi-pattern-apply item-path itemmap)
+  (let ((all-patts (string-split itemmap "\n")))
+    (if (null? all-patts)
+	item-path
+	(let loop ((hed (car all-patts))
+		   (tal (cdr all-patts))
+		   (res item-path))
+	  (let* ((parts (string-split hed))
+		 (patt  (car parts))
+
+		 (repl  (if (> (length parts) 1)(cadr parts) ""))
+
+		 (newr  (if (and patt repl)
+			    (begin
+                              (handle-exceptions
+                               exn
+                               (begin
+                                  (debug:print 0 *default-log-port*
+                                  "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
+                                 res)
+                              (string-substitute patt repl res))
+
+
+                              )
+			    (begin
+                              (debug:print 0 *default-log-port*
+                               "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
+			      res))))
+	    (if (null? tal)
+		newr
+		(loop (car tal)(cdr tal) newr)))))))
+
+;; given waiting-test that is waiting on waiton-test extend test-patt appropriately
+;;
+;;  genlib/testconfig               sim/testconfig
+;;  genlib/sch                      sim/sch/cell1
+;;
+;;  [requirements]                  [requirements]
+;;                                  mode itemwait
+;;                                  # trim off the cell to determine what to run for genlib
+;;                                  itemmap /.*
+;;
+;;                                  waiting-test is waiting on waiton-test so we need to create a pattern for waiton-test given waiting-test and itemmap
+;; BB> (tests:extend-test-patts "normal-second/2" "normal-second" "normal-first" '())
+;; observed -> "normal-first/2,normal-first/,normal-second/2,normal-second/"
+;; expected -> "normal-first,normal-second/2,normal-second/"
+;; testpatt = normal-second/2
+;; waiting-test = normal-second
+;; waiton-test = normal-first
+;; itemmaps = ()
+
+(define (tests:extend-test-patts test-patt waiting-test waiton-test itemmaps itemized-waiton)
+  (cond
+   (itemized-waiton
+    (let* ((itemmap          (tests:lookup-itemmap itemmaps waiton-test))
+           (patts            (string-split test-patt ","))
+           (waiting-test-len (+ (string-length waiting-test) 1))
+           (patts-waiton     (map (lambda (x)  ;; for each incoming patt that matches the waiting test
+                                    (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
+                                           (newpatt (conc waiton-test "/" (substring modpatt waiting-test-len (string-length modpatt)))))
+                                      ;; (conc waiting-test "/," waiting-test "/" (substring modpatt waiton-test-len (string-length modpatt)))))
+                                      ;; (print "in map, x=" x ", newpatt=" newpatt)
+                                      newpatt))
+                                  (filter (lambda (x)
+                                            (eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
+                                          patts)))
+           (extended-test-patt   (append patts (if (null? patts-waiton)
+                                                   (list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
+                                                   patts-waiton)))
+           (extended-test-patt-with-toplevels
+            (fold (lambda (testpatt-item accum )
+                    (let ((my-match (string-match "^([^%\\/]+)\\/.+$" testpatt-item)))
+                      (cons testpatt-item
+                            (if my-match
+                                (cons
+                                 (conc (cadr my-match) "/")
+                                 accum)
+                                accum))))
+                  '()
+                  extended-test-patt)))
+      (string-intersperse (delete-duplicates extended-test-patt-with-toplevels) ",")))
+   (else ;; not waiting on items, waiting on entire waiton test.
+    (let* ((patts (string-split test-patt ","))
+           (new-patts (if (member waiton-test patts)
+                          patts
+                          (cons waiton-test patts))))
+      (string-intersperse (delete-duplicates new-patts) ",")))))
+
+
+  
+;; tests:glob-like-match 
+(define (tests:glob-like-match patt str) 
+  (let ((like (substring-index "%" patt)))
+    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
+	   (newpatt  (if notpatt (substring patt 1) patt))
+	   (finpatt  (if like
+			(string-substitute (regexp "%") ".*" newpatt #f)
+			(string-substitute (regexp "\\*") ".*" newpatt #f)))
+	   (res      #f))
+      ;; (print "tests:glob-like-match => notpatt: " notpatt ", newpatt: " newpatt ", finpatt: " finpatt)
+      (set! res (string-match (regexp finpatt (if like #t #f)) str))
+      (if notpatt (not res) res))))
+
+;; if itempath is #f then look only at the testname part
+;;
+(define (tests:match patterns testname itempath #!key (required '()))
+  (if (string? patterns)
+      (let ((patts (append (string-split patterns ",") required)))
+	(if (null? patts) ;;; no pattern(s) means no match
+	    #f
+	    (let loop ((patt (car patts))
+		       (tal  (cdr patts)))
+	      ;; (print "loop: patt: " patt ", tal " tal)
+	      (if (string=? patt "")
+		  #f ;; nothing ever matches empty string - policy
+		  (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
+			 (test-patt  (cadr patt-parts))
+			 (item-patt  (cadddr patt-parts)))
+		    ;; special case: test vs. test/
+		    ;;   test  => "test" "%"
+		    ;;   test/ => "test" ""
+		    (if (and (not (substring-index "/" patt)) ;; no slash in the original
+			     (or (not item-patt)
+				 (equal? item-patt "")))      ;; should always be true that item-patt is ""
+			(set! item-patt "%"))
+		    ;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
+		    (if (and (tests:glob-like-match test-patt testname)
+			     (or (not itempath)
+				 (tests:glob-like-match (if item-patt item-patt "") itempath)))
+			#t
+			(if (null? tal)
+			    #f
+			    (loop (car tal)(cdr tal)))))))))))
+
+;; if itempath is #f then look only at the testname part
+;;
+(define (tests:match->sqlqry patterns)
+  (if (string? patterns)
+      (let ((patts (string-split patterns ",")))
+	(if (null? patts) ;;; no pattern(s) means no match, we will do no query
+	    #f
+	    (let loop ((patt (car patts))
+		       (tal  (cdr patts))
+		       (res  '()))
+	      ;; (print "loop: patt: " patt ", tal " tal)
+	      (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
+		     (test-patt  (cadr patt-parts))
+		     (item-patt  (cadddr patt-parts))
+		     (test-qry   (db:patt->like "testname" test-patt))
+		     (item-qry   (db:patt->like "item_path" item-patt))
+		     (qry        (conc "(" test-qry " AND " item-qry ")")))
+		;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
+		(if (null? tal)
+		    (string-intersperse (append (reverse res)(list qry)) " OR ")
+		    (loop (car tal)(cdr tal)(cons qry res)))))))
+      #f))
+
+;; keys list to key1,key2,key3 ...
+(define (runs:get-std-run-fields keys remfields)
+  (let* ((header    (append keys remfields))
+	 (keystr    (conc (keys->keystr keys) ","
+			  (string-intersperse remfields ","))))
+    (list keystr header)))
+
+;; make a query (fieldname like 'patt1' OR fieldname 
+(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
+  (let ((patts (if (string? pattstr)
+		   (string-split pattstr ",")
+		   '("%"))))
+    (string-intersperse (map (lambda (patt)
+			       (let ((wildtype (if (substring-index "%" patt) "LIKE" "GLOB")))
+				 (conc fieldname " " wildtype " '" patt "'")))
+			     (if (null? patts)
+				 '("")
+				 patts))
+			comparator)))
+
+;; Call this one to do all the work and get a standardized list of tests
+;;   gets paths from configs and finds valid tests 
+;;   returns hash of testname --> fullpath
+;;
+(define (tests:get-all)
+  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
+    (tests:get-valid-tests (make-hash-table) test-search-path)))
+
+(define (tests:get-tests-search-path cfgdat)
+  (let ((paths (let ((section (if cfgdat
+				  (configf:get-section cfgdat "tests-paths")
+				  #f)))
+		 (if section
+		     (map cadr section)
+		     '()))))
+    (filter (lambda (d)
+	      (if (directory-exists? d)
+		  d
+		  (begin
+		    (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
+			(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
+		    #f)))
+	    (append paths (list (conc *toppath* "/tests"))))))
+
+(define (tests:get-valid-tests test-registry tests-paths)
+  (if (null? tests-paths) 
+      test-registry
+      (let loop ((hed (car tests-paths))
+		 (tal (cdr tests-paths)))
+	(if (common:file-exists? hed)
+	    (for-each (lambda (test-path)
+			(let* ((tname   (last (string-split test-path "/")))
+			       (tconfig (conc test-path "/testconfig")))
+			  (if (and (not (hash-table-ref/default test-registry tname #f))
+				   (common:file-exists? tconfig))
+			      (hash-table-set! test-registry tname test-path))))
+		      (glob (conc hed "/*"))))
+	(if (null? tal)
+	    test-registry
+	    (loop (car tal)(cdr tal))))))
+
+(define (tests:filter-test-names-not-matched test-names test-patts)
+  (delete-duplicates
+   (filter (lambda (testname)
+	     (not (tests:match test-patts testname #f)))
+	   test-names)))
+
+
+(define (tests:filter-test-names test-names test-patts)
+  (delete-duplicates
+   (filter (lambda (testname)
+	     (tests:match test-patts testname #f))
+	   test-names)))
+
+;; itemmap is a list of testname patterns to maps
+;;     test1 .*/bar/(\d+) foo/\1
+;;     %     foo/([^/]+)  \1/bar
+;;
+;; # NOTE: the line with the single % could be the result of
+;; #       itemmap entry in requirements (legacy). The itemmap
+;; #       requirements entry is deprecated
+;;
+(define (tests:get-itemmaps tconfig)
+  (let ((base-itemmap  (configf:lookup tconfig "requirements" "itemmap"))
+	(itemmap-table (configf:get-section tconfig "itemmap")))
+    (append (if base-itemmap
+		(list (list "%" base-itemmap))
+		'())
+	    (if itemmap-table
+		itemmap-table
+		'()))))
+
+;; given a list of itemmaps (testname . map), return the first match
+;;
+(define (tests:lookup-itemmap itemmaps testname)
+  (let ((best-matches (filter (lambda (itemmap)
+				(tests:match (car itemmap) testname #f))
+			      itemmaps)))
+    (if (null? best-matches)
+	#f
+	(let ((res (car best-matches)))
+	  ;; (debug:print 0 *default-log-port* "res=" res)
+	  (cond
+	   ((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
+	   ((null? res)   #f)
+	   ((string? (cdr res)) (cdr res))  ;; it is a pair
+	   ((string? (cadr res))(cadr res)) ;; it is a list
+	   (else cadr res))))))
+
 
 )