Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -197,10 +197,11 @@
 (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 *numcpus-cache* (make-hash-table))
 
 (use posix-extras pathname-expand files)
 
 ;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
 (let-values (( (chicken-release-number chicken-major-version)
@@ -225,14 +226,18 @@
                  (string-match "^-(s|ss|sx|script)$" (cadr argv)))
             (caddr argv))
            (else (car argv))))
          (fullpath (realpath this-script)))
     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*))
 
+;;======================================================================
 ;; when called from a wrapper I need sometimes to find the calling
 ;; wrapper, this is for dashboard to find the correct megatest.
 ;;
 (define (common:find-local-megatest #!optional (progname "megatest"))
   (let ((res (filter file-exists?
@@ -360,10 +365,11 @@
   (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"))
 
@@ -372,24 +378,25 @@
    (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)))
+  (- 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))))
 
-
+;;======================================================================
 ;; 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 
@@ -484,13 +491,12 @@
         (when (>= (age-wks daysfile) 1)
           (copy daysfile wksfile)
           (copy hrsfile daysfile))
         #t)
       #f))
-  
-        
-        
+
+;;======================================================================
 ;; Rotate logs, logic: 
 ;;                 if > 500k and older than 1 week:
 ;;                     remove previous compressed log and compress this log
 ;; WARNING: This proc operates assuming that it is in the directory above the
 ;;          logs directory you wish to log-rotate.
@@ -571,11 +577,12 @@
 		      exn
 		      (debug:print-error 0 *default-log-port* "failed to remove " fullname ", exn=" exn)
 		      (delete-file* fullname)))))
 	     files)
 	    (debug:print-info 0 *default-log-port* "Deleted " (length files) " files from logs, keeping " max-allowed " files."))))))
-  
+
+;;======================================================================
 ;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
 ;; Do NOT check if not on homehost!
 ;;
 (define (common:exit-on-version-changed)
   (if (common:on-homehost?)
@@ -614,10 +621,11 @@
               (debug:print 0 *default-log-port* "   You have read-only access to this area.  Cannot proceed with megatest version migration.")
               (exit 1))
              (else
               (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
               (exit 1)))))))
+;;======================================================================
 ;;      (begin
 ;;	(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
 ;;	(exit 1))))
 
 ;;======================================================================
@@ -781,10 +789,11 @@
     "REMOVING"
     "CLEANING"
     "ARCHIVE_REMOVING"
     ))
 
+;;======================================================================
 ;; BBnote: *common:std-statuses* dashboard filter control and test control status buttons defined here; used in set-fields-panel and dboard:make-controls
 ;; note these statuses are sorted from better to worse.
 ;; This sort order is important to dcommon:status-compare3 and db:set-state-status-and-roll-up-items
 (define *common:std-statuses*
   '(;; (0 "DELETED")  
@@ -818,10 +827,11 @@
   '("COMPLETED" "KILLED" "UNKNOWN" "INCOMPLETE" "ARCHIVED"))
 
 (define *common:not-started-ok-statuses* ;; if not one of these statuses when in not_started state treat as dead
   '("n/a" "na" "PASS" "FAIL" "WARN" "CHECK" "WAIVED" "DEAD" "SKIP"))
 
+;;======================================================================
 ;; group tests into buckets corresponding to rollup
 ;;; Running, completed-pass,  completed-non-pass + worst status, not started.
 ;; filter out 
 ;(define (common:categorize-items-for-rollup in-tests)
 ;  (
@@ -833,10 +843,11 @@
         (lambda (a b)
           (let ((a-num (cadr (or (assoc a items-order) '(0 0))))
                 (b-num (cadr (or (assoc b items-order) '(0 0)))))
             (acomp a-num b-num))))))
 
+;;======================================================================
 ;; ;; given a toplevel with currstate, currstatus apply state and status
 ;; ;;  => (newstate . newstatus)
 ;; (define (common:apply-state-status currstate currstatus state status)
 ;;   (let* ((cstate  (string->symbol (string-downcase currstate)))
 ;;          (cstatus (string->symbol (string-downcase currstatus)))
@@ -911,10 +922,11 @@
 			     (pathname-file *toppath*)
 			     #f)
 			 (common:get-toppath #f)))
       "please-set-setup-area-name")) ;; (pathname-file (current-directory)))))
 
+;;======================================================================
 ;; safe getting of toppath
 (define (common:get-toppath areapath)
   (or *toppath*
       (if areapath
 	  (begin
@@ -936,10 +948,13 @@
 		  (debug:print-error 0 *default-log-port* "Unable to find megatest home directory.")
 		  #f)
 		(loop (pathname-directory thepath)))))
       ))
 
+;;======================================================================
+;; redefine for future cleanup (converge on area-name, the more generic
+;;
 (define common:get-area-name common:get-testsuite-name)
 
 (define (common:get-db-tmp-area . junk)
   (if *db-cache-path*
       *db-cache-path*
@@ -976,18 +991,14 @@
 
 (define (common:run-sync?)
     (and (common:on-homehost?)
 	 (args:get-arg "-server")))
 
-;;   (let ((ohh (common:on-homehost?))
-;; 	(srv (args:get-arg "-server")))
-;;     (and ohh srv)))
-    ;; (debug:print-info 0 *default-log-port* "common:run-sync? ohh=" ohh ", srv=" srv)
-
 (define (common:human-time)
   (time->string (seconds->local-time (current-seconds)) "%Y-%m-%d %H:%M:%S"))
 
+;;======================================================================
 ;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp
 ;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server)
 ;;
 (define (common:readonly-watchdog dbstruct)
   (thread-sleep! 0.05) ;; delay for startup
@@ -1015,10 +1026,11 @@
 			(debug:print-info 13 *default-log-port* "rosync called, " res " records transferred."))))
               (loop (current-seconds)))
             #t)))
     (debug:print-info 0 *default-log-port* "Exiting readonly-watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" mtpath="golden-mtpath)))
 
+;;======================================================================
 ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
 (define (common:watchdog)
   (debug:print-info 13 *default-log-port* "common:watchdog entered.")
   (if (launch:setup)
       (if (common:on-homehost?)
@@ -1118,10 +1130,11 @@
 
 ;;======================================================================
 ;; M I S C   U T I L S
 ;;======================================================================
 
+;;======================================================================
 ;; convert stuff to a number if possible
 (define (any->number val)
   (cond 
    ((number? val) val)
    ((string? val) (string->number val))
@@ -1144,16 +1157,18 @@
 		 (set! res #t))))
 	 (string-split patts ","))
 	res)
       #t))
 
+;;======================================================================
 ;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
 (define (common:get-disks #!key (configf #f))
   (hash-table-ref/default 
    (or configf (read-config "megatest.config" #f #t))
    "disks" '("none" "")))
 
+;;======================================================================
 ;; return first command that exists, else #f
 ;;
 (define (common:which cmds)
   (if (null? cmds)
       #f
@@ -1176,10 +1191,11 @@
 	 (pathname-directory
 	  (pathname-directory 
 	   (pathname-directory exe-path))))
 	#f)))
 
+;;======================================================================
 ;; return first path that can be created or already exists and is writable
 ;;
 (define (common:get-create-writeable-dir dirs)
   (if (null? dirs)
       #f
@@ -1200,10 +1216,11 @@
 	      res
 	      (if (null? tal)
 		  #f
 		  (loop (car tal)(cdr tal))))))))
 
+;;======================================================================
 ;; return the youngest timestamp . filename
 ;;
 (define (common:get-youngest glob-list)
   (let ((all-files (apply append
 			  (map (lambda (patt)
@@ -1222,10 +1239,11 @@
 		  (list curmod fname)
 		  res)))
 	  '(0 "n/a")
 	  all-files)))
 
+;;======================================================================
 ;; use bash to expand a glob. Does NOT handle paths with spaces!
 ;;
 (define (common:bash-glob instr)
   (string-split
    (with-input-from-pipe
@@ -1234,10 +1252,11 @@
 
 ;;======================================================================
 ;; Some safety net stuff
 ;;======================================================================
 
+;;======================================================================
 ;; return input if it is a list or return null
 (define (common:list-or-null inlst #!key (ovrd #f)(message #f))
   (if (list? inlst)
       inlst
       (begin
@@ -1247,10 +1266,11 @@
 ;;======================================================================
 ;; T A R G E T S  ,   S T A T E ,   S T A T U S ,   
 ;;                    R U N N A M E    A N D   T E S T P A T T
 ;;======================================================================
 
+;;======================================================================
 ;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
 ;;
 (define (common:get-runconfig-targets #!key (configf #f))
   (let ((targs       (sort (map car (hash-table->alist
 				     (or configf ;; NOTE: There is no value in using runconfig:read here.
@@ -1263,10 +1283,11 @@
 	(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
@@ -1303,12 +1324,10 @@
       rtestpatt)
      (else 
       (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
       args-testpatt))))
 
-
-
 (define (common:false-on-exception thunk #!key (message #f))
   (handle-exceptions exn
                      (begin
                        (if message
                            (debug:print-info 0 *default-log-port* message))
@@ -1326,10 +1345,11 @@
   ;;;; TODO: catch permission denied exceptions and emit appropriate warnings
   (common:false-on-exception (lambda () (directory-exists? path-string))
                              message: (conc "Unable to access path: " path-string)
                              ))
 
+;;======================================================================
 ;; does the directory exist and do we have write access?
 ;;
 ;;    returns the directory or #f
 ;;
 (define (common:directory-writable? path-string)
@@ -1389,10 +1409,11 @@
 	      (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")
@@ -1399,10 +1420,11 @@
                (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))
@@ -1457,18 +1479,20 @@
 			 (equal? homehost bestadrs))))
       (set! *home-host* (cons homehost at-home))
       (mutex-unlock! *homehost-mutex*)
       *home-host*))))
 
+;;======================================================================
 ;; am I on the homehost?
 ;;
 (define (common:on-homehost?)
   (let ((hh (common:get-homehost)))
     (if hh
 	(cdr hh)
 	#f)))
 
+;;======================================================================
 ;; do we honor the caches of the config files?
 ;;
 (define (common:use-cache?)
   (let ((res #t)) ;; priority by order of evaluation
     (if *configdat* ;; sillyness here. can't use setup/use-cache to know if we can use the cached files!
@@ -1482,10 +1506,11 @@
 	    (set! res #t)
 	    (if (equal? (getenv "MT_USE_CACHE") "no")
 		(set! res #f))))    ;; overrides -no-cache switch
     res))
   
+;;======================================================================
 ;; force use of server?
 ;;
 (define (common:force-server?)
   (let* ((force-setting (configf:lookup *configdat* "server" "force"))
 	 (force-type    (if force-setting (string->symbol force-setting) #f))
@@ -1506,10 +1531,11 @@
 
 ;;======================================================================
 ;; M I S C   L I S T S
 ;;======================================================================
 
+;;======================================================================
 ;; items in lista are matched value and position in listb
 ;; return the remaining items in listb or #f
 ;;
 (define (common:list-is-sublist lista listb)
   (if (null? lista)
@@ -1528,10 +1554,11 @@
 			  (car talb)
 			  
 			  (cdr talb)))
 		#f)))))
 
+;;======================================================================
 ;; Needed for long lists to be sorted where (apply max ... ) dies
 ;;
 (define (common:max inlst)
   (let loop ((max-val (car inlst))
 	     (hed     (car inlst))
@@ -1540,10 +1567,11 @@
 	(loop (max hed max-val)
 	      (car tal)
 	      (cdr tal))
 	(max hed max-val))))
 
+;;======================================================================
 ;; get min or max, use > for max and < for min, this works around the limits on apply
 ;;
 (define (common:min-max comp lst)
   (if (null? lst)
       #f ;; better than an exception for my needs
@@ -1550,10 +1578,11 @@
       (fold (lambda (a b)
 	      (if (comp a b) a b))
 	    (car lst)
 	    lst)))
 
+;;======================================================================
 ;; get min or max, use > for max and < for min, this works around the limits on apply
 ;;
 (define (common:sum lst)
   (if (null? lst)
       0
@@ -1560,10 +1589,11 @@
       (fold (lambda (a b)
 	      (+ a b))
 	    (car lst)
 	    lst)))
 
+;;======================================================================
 ;; path list to hash-table tree
 ;;   ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c))))
 ;;
 (define (common:list->htree lst)
   (let ((resh (make-hash-table)))
@@ -1581,10 +1611,11 @@
 	       (hash-table-set! ht hed (make-hash-table))
 	       (loop ht hed tal)))))
      lst)
     resh))
 
+;;======================================================================
 ;; hash-table tree to html list tree
 ;;
 ;;   tipfunc takes two parameters: y the tip value and path the path to that point
 ;;
 (define (common:htree->html ht path tipfunc)
@@ -1606,10 +1637,11 @@
 		       (list 
 			levelname
 			(common:htree->html y newpath tipfunc))))))
 	      datlist)))))
 
+;;======================================================================
 ;; hash-table tree to alist tree
 ;;
 (define (common:htree->atree ht)
   (map (lambda (x)
 	 (cons (car x)
@@ -1621,10 +1653,11 @@
 
 ;;======================================================================
 ;; M U N G E   D A T A   I N T O   N I C E   F O R M S
 ;;======================================================================
 
+;;======================================================================
 ;; Generate an index for a sparse list of key values
 ;;   ( (rowname1 colname1 val1)(rowname2 colname2 val2) )
 ;;
 ;; => 
 ;;
@@ -1660,16 +1693,18 @@
 		    new-colnames
 		    (if (> curr-rownum rownum) curr-rownum rownum)
 		    (if (> curr-colnum colnum) curr-colnum colnum)
 		    ))))))
 
+;;======================================================================
 ;; if it looks like a number -> convert it to a number, else return it
 ;;
 (define (common:lazy-convert inval)
   (let* ((as-num (if (string? inval)(string->number inval) #f)))
     (or as-num inval)))
 
+;;======================================================================
 ;; convert string a=1; b=2; c=a silly thing; d=
 ;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
 ;;
 (define (common:val->alist val #!key (convert #f))
   (let ((val-list (string-split-fields ";\\s*" val #:infix)))
@@ -1687,10 +1722,11 @@
 
 ;;======================================================================
 ;; S Y S T E M   S T U F F
 ;;======================================================================
 
+;;======================================================================
 ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
 ;;
 (define (common:lazy-modification-time fpath)
   (handle-exceptions
       exn
@@ -1699,10 +1735,11 @@
       0)
     (if (file-exists? fpath)
 	(file-modification-time fpath)
 	0)))
 
+;;======================================================================
 ;; 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
 		      (begin
@@ -1715,19 +1752,21 @@
   (apply max
 	 (map
 	  common:lazy-modification-time 
 	  file-list))))
 
+;;======================================================================
 ;; return a nice clean pathname made absolute
 (define (common:nice-path dir)
   (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
     (if match ;; using ~ for home?
 	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
 	(normalize-pathname (if (absolute-pathname? dir)
 				dir
 				(conc (current-directory) "/" dir))))))
 
+;;======================================================================
 ;; make "nice-path" available in config files and the repl
 (define nice-path common:nice-path)
 
 (define (common:read-link-f path)
   (handle-exceptions
@@ -1738,19 +1777,21 @@
     (with-input-from-pipe
 	(conc "/bin/readlink -f " path)
       (lambda ()
 	(read-line)))))
 
+;;======================================================================
 ;; returns *effective load* (not normalized)
 ;;
 (define (common:get-intercept onemin fivemin)
   (if (< onemin fivemin) ;; load is decreasing, just use the onemin load
       onemin
       (let* ((load-change (- onemin fivemin))
 	     (tchange     (- 300 60)))
 	(max (+ onemin (* 60 (/ load-change tchange))) 0))))
 
+;;======================================================================
 ;; calculate a delay number based on a droop curve
 ;;    inputs are:
 ;;      - load-in, load as from uptime, NOT normalized
 ;;      - numcpus, number of cpus, ideally use the real cpus, not threads
 ;;
@@ -1784,10 +1825,12 @@
     (if (< x 2)
 	(loop (+ x 0.1)))))
 
 (define (get-cpu-load #!key (remote-host #f))
   (car (common:get-cpu-load remote-host)))
+
+;;======================================================================
 ;;   (let* ((load-res (process:cmd-run->list "uptime"))
 ;; 	 (load-rx  (regexp "load average:\\s+(\\d+)"))
 ;; 	 (cpu-load #f))
 ;;     (for-each (lambda (l)
 ;; 		(let ((match (string-search load-rx l)))
@@ -1796,10 +1839,11 @@
 ;; 			(if (number? newval)
 ;; 			    (set! cpu-load newval))))))
 ;; 	      (car load-res))
 ;;     cpu-load))
 
+;;======================================================================
 ;; get values from cached info from dropping file in logs dir
 ;;  e.g. key is host and dtype is normalized-load
 ;;
 (define (common:get-cached-info key dtype #!key (age 10))
   (if *toppath*
@@ -1849,11 +1893,11 @@
 	     (fullpath (conc fulldir "/" key "-" dtype ".log")))
 	(if (not (file-exists? fulldir))(create-directory fulldir #t))
 	(handle-exceptions
 	    exn
 	  (begin
-	    (debug:print 0 *default-log-path* "failed to write file " fullpath ", exn=" exn)
+	    (debug:print 0 *default-log-port* "failed to write file " fullpath ", exn=" exn)
 	    #f)
 	  (with-output-to-file fullpath (lambda ()(pp dat)))))
       #f))
 
 (define (common:raw-get-remote-host-load remote-host)
@@ -1864,10 +1908,11 @@
       #f) ;; more specific handling of errors needed
     (with-input-from-pipe 
      (conc "ssh " remote-host " cat /proc/loadavg")
      (lambda ()(list (read)(read)(read))))))
 
+;;======================================================================
 ;; get cpu load by reading from /proc/loadavg, return all three values
 ;;
 (define (common:get-cpu-load remote-host)
   (handle-exceptions
       exn
@@ -1894,10 +1939,11 @@
 		     (common:write-cached-info actual-hostname "cpu-load" result)
 		     result)
 		   '(-1 -1 -1))) ;; -1 is bad result
 	      (else '(-2 -2 -2))))))))
 
+;;======================================================================
 ;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads
 ;; returns alist '((adj-cpu-load . normalized-proc-load) ... etc.
 ;;  keys: adj-proc-load, adj-core-load, 1m-load, 5m-load, 15m-load
 ;;
 (define (common:get-normalized-cpu-load remote-host)
@@ -1977,10 +2023,11 @@
 
 (define (common:unix-ping hostname)
   (let ((res (system (conc "ping -c 1 " hostname " > /dev/null"))))
     (eq? res 0)))
 
+;;======================================================================
 ;; ideally put all this info into the db, no need to preserve it across moving homehost
 ;;
 ;; return list of
 ;;  ( reachable? cpuload update-time )
 (define (common:get-host-info hostname)
@@ -2008,10 +2055,11 @@
             (alist-ref 'adj-core-load (common:get-normalized-cpu-load hostname)))) ;; this is cheaper than you might think. get-normalized-cpu-load is cached for up to 5 seconds
      (else
       (list #f 0 -1) ;; bad host, don't use!
       ))))
 
+;;======================================================================
 ;; see defstruct host at top of file.
 ;;    host: reachable last-update last-used last-cpuload
 ;;
 (define (common:update-host-loads-table hosts-raw)
   (let* ((hosts (filter (lambda (x)
@@ -2032,10 +2080,11 @@
          (host-reachable-set!    rec is-reachable)
          (host-last-update-set!  rec last-reached-time)
          (host-last-cpuload-set! rec load)))
      hosts)))
 
+;;======================================================================
 ;; go through the hosts from least recently used to most recently used, pick the first that meets the load criteral from the
 ;; [host-rules] section.
 ;;
 (define (common:get-least-loaded-host hosts-raw host-type configdat)
   (let* ((rdat       (configf:lookup configdat "host-rules" host-type))
@@ -2104,11 +2153,10 @@
                      #f
                      (common:get-homehost)))
          (hh     (if hh-dat (car hh-dat) #f)))
     (common:wait-for-normalized-load maxnormload msg hh)))
 
-(define *numcpus-cache* (make-hash-table))
 (define (common:get-num-cpus remote-host)
   (let* ((actual-host (or remote-host (get-host-name))))
     ;; hosts had better not be changing the number of cpus too often!
     (or (hash-table-ref/default *numcpus-cache* actual-host #f)
 	(let* ((numcpus (or (common:get-cached-info actual-host "num-cpus" age: (+ 2592000 (random 3600)))
@@ -2133,10 +2181,11 @@
 				  (common:write-cached-info actual-host "num-cpus" result))
 			      result))))
 	  (hash-table-set! *numcpus-cache* actual-host numcpus)
 	  numcpus))))
 
+;;======================================================================
 ;; wait for normalized cpu load to drop below maxload
 ;;
 (define (common:wait-for-normalized-load maxnormload msg remote-host #!optional (rem-tries 5))
   (let ((num-cpus (common:get-num-cpus remote-host)))
     (if num-cpus
@@ -2145,10 +2194,11 @@
 	  (thread-sleep! (random 60)) ;; we failed to get num cpus. wait a bit and try again
 	  (if (> rem-tries 0)
 	      (common:wait-for-normalized-load maxnormload msg remote-host (- rem-tries 1))
 	      #f)))))
 
+;;======================================================================
 ;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
 ;;   count     - count down to zero, at some point we'd give up if the load never drops
 ;;   num-tries - count down to zero number tries to get numcpus
 ;;
 (define (common:wait-for-cpuload maxnormload numcpus-in
@@ -2222,10 +2272,11 @@
 	      (debug:print 0 *default-log-port* "Load on " effective-host " is acceptable at effective normalized load of "
 			   effective-normalized-load "  continuing."))
 	  (debug:print 0 *default-log-port* "Load on " effective-host ", "
 		       first" could not be retrieved. Giving up and continuing."))))))
 
+;;======================================================================
 ;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
 ;;
 ;; (define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f)(force-maxload #f)(num-tries 5))
 ;;   (let* ((loadavg (common:get-cpu-load remote-host))
 ;; 	 (numcpus (if (<= 1 numcpus-in) ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
@@ -2341,10 +2392,11 @@
 ;;======================================================================
 
 (define (common:get-disk-space-used fpath)
   (with-input-from-pipe (conc "/usr/bin/du -s " fpath) read))
 
+;;======================================================================
 ;; given path get free space, allows override in [setup]
 ;; with free-space-script /path/to/some/script.sh
 ;;
 (define (get-df path)
   (if (configf:lookup *configdat* "setup" "free-space-script")
@@ -2401,10 +2453,11 @@
     (list (> dbspace required)
 	  dbspace
 	  required
 	  dirpath)))
 
+;;======================================================================
 ;; check space in dbdir and in megatest dir
 ;; returns: ok/not dbspace required-space
 ;;
 (define (common:check-db-dir-space)
   (let* ((required (string->number 
@@ -2414,11 +2467,12 @@
 	 (dbdir    (common:get-db-tmp-area)) ;; (db:get-dbdir))
 	 (tdbspace (common:check-space-in-dir dbdir required))
 	 (mdbspace (common:check-space-in-dir *toppath* required)))
     (sort (list tdbspace mdbspace) (lambda (a b)
 				     (< (cadr a)(cadr b))))))
-    
+
+;;======================================================================
 ;; check available space in dbdir, exit if insufficient
 ;;
 (define (common:check-db-dir-and-exit-if-insufficient)
   (let* ((spacedat (car (common:check-db-dir-space))) ;; look only at worst for now
 	 (is-ok    (car spacedat))
@@ -2427,11 +2481,12 @@
 	 (dbdir    (cadddr spacedat)))
     (if (not is-ok)
 	(begin
 	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")
 	  (exit 1)))))
-  
+
+;;======================================================================
 ;; paths is list of lists ((name path) ... )
 ;;
 (define (common:get-disk-with-most-free-space disks minsize)
   (let* ((best     #f)
 	(bestsize 0)
@@ -2484,10 +2539,11 @@
      (map car disks))
     (if (and best (> bestsize minsize))
 	best
 	#f))) ;; #f means no disk candidate found
 
+;;======================================================================
 ;; convert a spec string to a list of vectors #( rx  action rx-string )
 (define (common:spec-string->list-of-specs spec-string actions)
   (let ((spec-strings  (string-split-fields "\\s*;\\s*" spec-string #:infix))
 	(actions-regex (regexp (conc "^(.*)\\s+(" (string-intersperse (map conc actions) "|") ")"))))
     (filter
@@ -2499,10 +2555,11 @@
 		  (begin
 		    (debug:print 0 *default-log-port* "WARNING: Unrecognised rule \"" s "\" in clean-up specification.")
 		    #f))))
 	  spec-strings))))
   
+;;======================================================================
 ;; given a list of specs rx . rule and a file return the first matching rule
 ;; 
 (define (common:file-find-rule fname rules) ;; rule is vector #( rx action rx-string)
   (let loop ((rule   (car rules))
 	     (tail   (cdr rules)))
@@ -2512,10 +2569,11 @@
 	  rule ;; return the whole rule so regex can be printed etc.
 	  (if (null? tail)
 	      #f
 	      (loop (car tail)(cdr tail)))))))
 
+;;======================================================================
 ;; given a spec apply some rules to a directory
 ;;
 ;;  WARNING: This function will REMOVE files - be sure your spec and path is correct!
 ;;
 ;; spec format:
@@ -2563,17 +2621,17 @@
     ))
 
 ;;======================================================================
 ;; E N V I R O N M E N T   V A R S
 ;;======================================================================
+
 (define (bb-check-path #!key (msg "check-path: "))
   (let ((path (or (get-environment-variable "PATH") "none")))
     (debug:print-info 0 *default-log-port* (conc msg" : $PATH="path))
     (if (string-match "^.*/isoenv-core/.*" path)
         (debug:print-error 0 *default-log-port* (conc msg" : !!ISOENV PRESENT!!")) ;; remove for prod
         (debug:print-info 1 *default-log-port* (conc msg" : **no isoenv present**")))))
-
 	      
 (define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR" "MAKEFLAGS" "MAKEF" "MAKEOVERRIDES")))
   ;;(bb-check-path msg: "save-environment-as-files entry")
   (let ((envvars (get-environment-variables))
         (whitesp (regexp "[^a-zA-Z0-9_\\-:,\\.\\/%$]"))
@@ -2610,11 +2668,10 @@
 				   "# export "
 				   "export ")
 			       key "=" delim (mungeval val) delim)))
                     envvars)))))
 
-
 (define (common:get-param-mapping #!key (flavor #f))
   "returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches"
   (let ((default '(("tag-expr"  . "-tagexpr")
                    ("mode-patt" . "-modepatt")
                    ("run-name"  . "-runname")
@@ -2629,10 +2686,11 @@
         (map (lambda (x)
                (cons (string->symbol (conc "-" (car x))) (cdr x)))
              default)
         default)))
 
+;;======================================================================
 ;; set some env vars from an alist, return an alist with original values
 ;; (("VAR" "value") ...)
 ;; a value of #f means "unset this var"
 ;;
 (define (alist->env-vars lst)
@@ -2648,11 +2706,11 @@
 			  (unsetenv var))))
 		  lst)
 	res)
       '()))
 
-
+;;======================================================================
 ;; clear vars matching pattern, run proc, set vars back
 ;; if proc is a string run that string as a command with
 ;; system.
 ;;
 (define *common:orig-env*
@@ -2698,11 +2756,10 @@
      vars
      (lambda (var val)
        (setenv var val)))
     vars))
 
-
 (define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f))
   (let* ((pre-cmd  (dtests:get-pre-command))
          (post-cmd (dtests:get-post-command))
          (fullcmd  (if (or pre-cmd post-cmd)
                        (conc pre-cmd cmd post-cmd)
@@ -2715,10 +2772,11 @@
 		  
 ;;======================================================================
 ;; 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
@@ -2783,15 +2841,17 @@
     ((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 ...
@@ -2822,19 +2882,21 @@
      '(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
 ;;
@@ -2887,12 +2949,12 @@
 					    (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
 ;;
@@ -2998,10 +3060,11 @@
     ((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")
@@ -3027,10 +3090,11 @@
 
 ;;======================================================================
 ;; L O C K I N G   M E C H A N I S M S 
 ;;======================================================================
 
+;;======================================================================
 ;; faux-lock is deprecated. Please use simple-lock below
 ;;
 (define (common:faux-lock keyname #!key (wait-time 8)(allow-lock-steal #t))
   (if (rmt:no-sync-get/default keyname #f) ;; do not be tempted to compare to pid. locking is a one-shot action, if already locked for this pid it doesn't actually count
       (if (> wait-time 0)
@@ -3051,18 +3115,18 @@
       (begin
         (if (rmt:no-sync-get/default keyname #f) (rmt:no-sync-del! keyname))
         #t)
       #f))
 
+;;======================================================================
 ;; simple lock. improve and converge on this one.
 ;;
 (define (common:simple-lock keyname)
   (rmt:no-sync-get-lock keyname))
 
 (define (common:simple-unlock keyname #!key (force #f))
   (rmt:no-sync-del! keyname))
-
 
 ;;======================================================================
 ;;
 ;;======================================================================
 
@@ -3078,13 +3142,13 @@
    ((equal? status "KILLREQ") "purple")
    ((equal? status "RUNNING") "blue")
    ((equal? status "ABORT")   "brown")
    (else "black")))
 
-;; ;;======================================================================
-;; ;; N A N O M S G   C L I E N T
-;; ;;======================================================================
+;;======================================================================
+;; N A N O M S G   C L I E N T
+;;======================================================================
 ;; 
 ;; 
 ;; 
 ;; (define (common:send-dboard-main-changed)
 ;;   (let* ((dashboard-ips (mddb:get-dashboards)))
@@ -3227,49 +3291,51 @@
 	fallback-launcher)))
 
 ;;======================================================================
 ;; NMSG AND NEW API
 ;;======================================================================
-
-;; nm based server experiment, keep around for now.
-;;
-(define (nm:start-server dbconn #!key (given-host-name #f))
-  (let* ((srvdat    (start-raw-server given-host-name: given-host-name))
-	 (host-name (srvdat-host srvdat))
-	 (soc       (srvdat-soc srvdat)))
-    
-    ;; start the queue processor (save for second round of development)
-    ;;
-    (thread-start! (make-thread! (lambda ()(queue-processor dbconn) "Queue processor")))
-    ;; msg is an alist
-    ;;  'r host:port  <== where to return the data
-    ;;  'p params     <== data to apply the command to
-    ;;  'e j|s|l      <== encoding of the params. default is s (sexp), if not specified is assumed to be default
-    ;;  'c command    <== look up the function to call using this key
-    ;;
-    (let loop ((msg-in (nn-recv soc)))
-      (if (not (equal? msg-in "quit"))
-	  (let* ((dat        (decode msg-in))
-		 (host-port  (alist-ref 'r dat)) ;; this is for the reverse req rep where the server is a client of the original client
-		 (params     (alist-ref 'p dat))
-		 (command    (let ((c (alist-ref 'c dat)))(if c (string->symbol c) #f)))
-		 (all-good   (and host-port params command (hash-table-exists? *commands* command))))
-	    (if all-good
-		(let ((cmddat (make-qitem
-			       command:   command
-			       host-port: host-port
-			       params:    params)))
-		  (queue-push cmddat) 		;; put request into the queue
-		  (nn-send soc "queued"))         ;; reply with "queued"
-		(print "ERROR: ["(common:human-time)"] BAD request " dat))
-	    (loop (nn-recv soc)))))
-    (nn-close soc)))
+;; 
+;; ;;======================================================================
+;; ;; nm based server experiment, keep around for now.
+;; ;;
+;; (define (nm:start-server dbconn #!key (given-host-name #f))
+;;   (let* ((srvdat    (start-raw-server given-host-name: given-host-name))
+;; 	 (host-name (srvdat-host srvdat))
+;; 	 (soc       (srvdat-soc srvdat)))
+;;     
+;;     ;; start the queue processor (save for second round of development)
+;;     ;;
+;;     (thread-start! (make-thread! (lambda ()(queue-processor dbconn) "Queue processor")))
+;;     ;; msg is an alist
+;;     ;;  'r host:port  <== where to return the data
+;;     ;;  'p params     <== data to apply the command to
+;;     ;;  'e j|s|l      <== encoding of the params. default is s (sexp), if not specified is assumed to be default
+;;     ;;  'c command    <== look up the function to call using this key
+;;     ;;
+;;     (let loop ((msg-in (nn-recv soc)))
+;;       (if (not (equal? msg-in "quit"))
+;; 	  (let* ((dat        (decode msg-in))
+;; 		 (host-port  (alist-ref 'r dat)) ;; this is for the reverse req rep where the server is a client of the original client
+;; 		 (params     (alist-ref 'p dat))
+;; 		 (command    (let ((c (alist-ref 'c dat)))(if c (string->symbol c) #f)))
+;; 		 (all-good   (and host-port params command (hash-table-exists? *commands* command))))
+;; 	    (if all-good
+;; 		(let ((cmddat (make-qitem
+;; 			       command:   command
+;; 			       host-port: host-port
+;; 			       params:    params)))
+;; 		  (queue-push cmddat) 		;; put request into the queue
+;; 		  (nn-send soc "queued"))         ;; reply with "queued"
+;; 		(print "ERROR: ["(common:human-time)"] BAD request " dat))
+;; 	    (loop (nn-recv soc)))))
+;;     (nn-close soc)))
 
 ;;======================================================================
 ;; D A S H B O A R D   U S E R   V I E W S
 ;;======================================================================
 
+;;======================================================================
 ;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
 ;;
 (define (common:load-views-config)
   (let* ((view-cfgdat    (make-hash-table))
 	 (home-cfgfile   (conc (get-environment-variable "HOME") "/.mtviews.config"))
@@ -3282,23 +3348,25 @@
     view-cfgdat))
 
 ;;======================================================================
 ;; H I E R A R C H I C A L   H A S H   T A B L E S
 ;;======================================================================
-
+;;
 ;; Every element including top element is a vector:
 ;;   <vector subhash value>
 
 (define (hh:make-hh #!key (ht #f)(value #f))
   (vector (or ht    (make-hash-table)) value))
 
+;;======================================================================
 ;; used internally
 (define-inline (hh:set-ht! hh ht)       (vector-set! hh 0 ht))
 (define-inline (hh:get-ht hh)           (vector-ref  hh 0))
 (define-inline (hh:set-value! hh value) (vector-set! hh 1 value))
 (define-inline (hh:get-value  hh value) (vector-ref  hh 1))
 
+;;======================================================================
 ;; given a hierarchial hash and some keys look up the value ...
 ;;
 (define (hh:get hh . keys)
   (if (null? keys)
       (vector-ref hh 1) ;; we have reached the end of the line, return the value sought
@@ -3308,10 +3376,11 @@
 	      (if sub-hh
 		  (apply hh:get sub-hh (cdr keys))
 		  #f))
 	    #f))))
 
+;;======================================================================
 ;; given a hierarchial hash, a value and some keys, add needed hierarcy and insert the value
 ;;
 (define (hh:set! hh value . keys)
   (if (null? keys)
       (hh:set-value! hh value) ;; we have reached the end of the line, store the value
@@ -3324,11 +3393,12 @@
 		    (apply hh:set! new-sub-hh value (cdr keys)))
 		  (apply hh:set! sub-hh value (cdr keys))))    ;; call the sub-hierhash with remaining keys
 	    (begin
 	      (hh:set-ht! hh (make-hash-table))
 	      (apply hh:set! hh value keys))))))
-  
+
+;;======================================================================
 ;; Manage pkts, used in servers, tests and likely other contexts so put
 ;; in common
 ;;======================================================================
 
 (define common:pkts-spec
@@ -3362,10 +3432,11 @@
 	 (pktsdirs  (if pktsdirs-str
 			(string-split pktsdirs-str " ")
 			#f)))
     pktsdirs))
 
+;;======================================================================
 ;; use-lt is use linktree "lt" link to find pkts dir
 (define (common:save-pkt pktalist-in mtconf use-lt #!key (add-only #f)) ;; add-only saves the pkt only if there is a parent already
   (if (or add-only
 	  (hash-table-exists? *pkts-info* 'last-parent))
       (let* ((parent   (hash-table-ref/default *pkts-info* 'last-parent #f))
@@ -3448,10 +3519,11 @@
 (define (common:get-pkt-alists pkts)
   (map (lambda (x)
 	 (alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
        pkts))
 
+;;======================================================================
 ;; given list of pkts (alist mode) return list of D cards as Unix epoch, sorted descending
 ;; also delete duplicates by target i.e. (car pkt)
 ;;
 (define (common:get-pkt-times pkts)
   (delete-duplicates
@@ -3460,12 +3532,11 @@
 	   `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x))))
 	 pkts)
     (lambda (a b)(> (cdr a)(cdr b))))      ;; sort descending
    (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target
 
-
-
+;;======================================================================
 ;; accept an alist or hash table containing envvar/env value pairs (value of #f causes unset) 
 ;;   execute thunk in context of environment modified as per this list
 ;;   restore env to prior state then return value of eval'd thunk.
 ;;   ** this is not thread safe **
 (define (common:with-env-vars delta-env-alist-or-hash-table thunk)
@@ -3505,11 +3576,10 @@
       rv)))
 
 (define *common:thread-punchlist* (make-hash-table))
 (define (common:send-thunk-to-background-thread thunk #!key (name #f))
   ;;(BB> "launched thread " name)
-
   ;; we need a unique name for the thread.
   (let* ((realname (if name
                        (if (not (hash-table-ref/default *common:thread-punchlist* name #f))
                            name
                            (conc name"-" (symbol->string (gensym))))
@@ -3536,68 +3606,69 @@
                #t) ;; just ignore it, it might have died in the meantime so joining it will throw an exception
              (thread-join! thread))
            )))
    (hash-table-keys *common:thread-punchlist*)))
 
-(define *common:telemetry-log-state* 'startup)
-(define *common:telemetry-log-socket* #f)
-
-(define (common:telemetry-log-open)
-  (if (eq? *common:telemetry-log-state* 'startup)
-      (let* ((serverhost (configf:lookup *configdat* "telemetry" "host"))
-             (serverport (configf:lookup-number *configdat* "telemetry" "port"))
-             (user (or (get-environment-variable "USER") "unknown"))
-             (host (or (get-environment-variable "HOST") "unknown")))
-        (set! *common:telemetry-log-state*
-              (handle-exceptions
-               exn
-               (begin
-                 (debug:print-info 0 *default-log-port* "common-telemetry-log open udp port failure")
-                 'broken)
-               (if (and serverhost serverport user host)
-                   (let* ((s (udp-open-socket)))
-                     ;;(udp-bind! s #f 0)
-                     (udp-connect! s serverhost serverport)
-                     (set! *common:telemetry-log-socket* s)
-                     'open)
-                   'not-needed))))))
-  
-(define (common:telemetry-log event #!key (payload '()))
-  (if (eq? *common:telemetry-log-state* 'startup)
-      (common:telemetry-log-open))
-
-  (if (eq? 'open *common:telemetry-log-state*)
-      (handle-exceptions
-       exn
-       (begin
-         (debug:print-info 0 *default-log-port* "common-telemetry-log comms failure ; disabled (no server?)")
-         ;;(define *common:telemetry-log-state* 'broken-or-no-server-preclose)
-         ;;(common:telemetry-log-close)
-         (define *common:telemetry-log-state* 'broken-or-no-server)
-         (set! *common:telemetry-log-socket* #f)
-         )
-       (if (and *common:telemetry-log-socket* event) ;; TODO - filter on event against telemetry.want-events
-           (let* ((user (or (get-environment-variable "USER") "unknown"))
-                  (host (or (get-environment-variable "HOST") "unknown"))
-                  (start (conc "[megatest "event"]"))
-                  (toppath (or *toppath* "/dev/null"))
-                  (payload-serialized
-                   (base64:base64-encode
-                    (z3:encode-buffer
-                     (with-output-to-string (lambda () (pp payload))))))
-                  (msg     (conc user":"host":"start":"(current-process-id)":"(car (argv))":"
-                                 toppath":"payload-serialized)))
-             (udp-send *common:telemetry-log-socket* msg))))))
-  
-(define (common:telemetry-log-close)
-  (when (or (member *common:telemetry-log-state* '(broken-or-no-server-preclose open)) *common:telemetry-log-socket*)
-    (handle-exceptions
-     exn
-     (begin
-       (define *common:telemetry-log-state* 'closed-fail)
-       (debug:print-info 0 *default-log-port* "common-telemetry-log closure failure")
-       )
-     (begin
-       (define *common:telemetry-log-state* 'closed)
-       (udp-close-socket *common:telemetry-log-socket*)
-       (set! *common:telemetry-log-socket* #f)))))
+;;======================================================================
+;; (define *common:telemetry-log-state* 'startup)
+;; (define *common:telemetry-log-socket* #f)
+;; 
+;; (define (common:telemetry-log-open)
+;;   (if (eq? *common:telemetry-log-state* 'startup)
+;;       (let* ((serverhost (configf:lookup *configdat* "telemetry" "host"))
+;;              (serverport (configf:lookup-number *configdat* "telemetry" "port"))
+;;              (user (or (get-environment-variable "USER") "unknown"))
+;;              (host (or (get-environment-variable "HOST") "unknown")))
+;;         (set! *common:telemetry-log-state*
+;;               (handle-exceptions
+;;                exn
+;;                (begin
+;;                  (debug:print-info 0 *default-log-port* "common-telemetry-log open udp port failure")
+;;                  'broken)
+;;                (if (and serverhost serverport user host)
+;;                    (let* ((s (udp-open-socket)))
+;;                      ;;(udp-bind! s #f 0)
+;;                      (udp-connect! s serverhost serverport)
+;;                      (set! *common:telemetry-log-socket* s)
+;;                      'open)
+;;                    'not-needed))))))
+;;   
+;; (define (common:telemetry-log event #!key (payload '()))
+;;   (if (eq? *common:telemetry-log-state* 'startup)
+;;       (common:telemetry-log-open))
+;; 
+;;   (if (eq? 'open *common:telemetry-log-state*)
+;;       (handle-exceptions
+;;        exn
+;;        (begin
+;;          (debug:print-info 0 *default-log-port* "common-telemetry-log comms failure ; disabled (no server?)")
+;;          ;;(define *common:telemetry-log-state* 'broken-or-no-server-preclose)
+;;          ;;(common:telemetry-log-close)
+;;          (define *common:telemetry-log-state* 'broken-or-no-server)
+;;          (set! *common:telemetry-log-socket* #f)
+;;          )
+;;        (if (and *common:telemetry-log-socket* event) ;; TODO - filter on event against telemetry.want-events
+;;            (let* ((user (or (get-environment-variable "USER") "unknown"))
+;;                   (host (or (get-environment-variable "HOST") "unknown"))
+;;                   (start (conc "[megatest "event"]"))
+;;                   (toppath (or *toppath* "/dev/null"))
+;;                   (payload-serialized
+;;                    (base64:base64-encode
+;;                     (z3:encode-buffer
+;;                      (with-output-to-string (lambda () (pp payload))))))
+;;                   (msg     (conc user":"host":"start":"(current-process-id)":"(car (argv))":"
+;;                                  toppath":"payload-serialized)))
+;;              (udp-send *common:telemetry-log-socket* msg))))))
+;;   
+;; (define (common:telemetry-log-close)
+;;   (when (or (member *common:telemetry-log-state* '(broken-or-no-server-preclose open)) *common:telemetry-log-socket*)
+;;     (handle-exceptions
+;;      exn
+;;      (begin
+;;        (define *common:telemetry-log-state* 'closed-fail)
+;;        (debug:print-info 0 *default-log-port* "common-telemetry-log closure failure")
+;;        )
+;;      (begin
+;;        (define *common:telemetry-log-state* 'closed)
+;;        (udp-close-socket *common:telemetry-log-socket*)
+;;        (set! *common:telemetry-log-socket* #f)))))
 

Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -524,10 +524,11 @@
 ;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
 ;;
 (define (configf:var-is? cfgdat section var expected-val)
   (equal? (configf:lookup cfgdat section var) expected-val))
 
+;; redefines
 (define config-lookup configf:lookup)
 (define configf:read-file read-config)
 
 ;; safely look up a value that is expected to be a number, return
 ;; a default (#f unless provided)
@@ -554,12 +555,13 @@
 (define (configf:set-section-var cfgdat section var val)
   (let ((sectdat (configf:get-section cfgdat section)))
     (hash-table-set! cfgdat section
                      (configf:assoc-safe-add sectdat var val))))
 
-    ;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
-    ;;	    (list var val))))
+;;======================================================================
+;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
+;;	    (list var val))))
 
 (define (setup)
   (let* ((configf (find-config "megatest.config"))
 	 (config  (if configf (read-config configf #f #t) #f)))
     (if config

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -577,10 +577,12 @@
 	(cadr t-sort)
 	3)))
 
 (define (get-curr-sort)
   (vector-ref *tests-sort-options* *tests-sort-reverse*))
+
+;;======================================================================
 
 (debug:setup)
 
 ;; (define uidat #f)
 

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -109,11 +109,11 @@
 ;;======================================================================
 
 (define (db:general-sqlite-error-dump exn stmt . params)
   (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
     ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
-    (print "err-status: " err-status)
+    ;; (print "err-status: " err-status)
     (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
     (print-call-chain (current-error-port))))
 
 ;; convert to -inline 
 ;;
@@ -457,11 +457,11 @@
 	  exn
 	(begin
 	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
 	  (thread-sleep! 3)
 	  (sqlite3:interrupt! db)
-	  (db:safely-close-sqlite3-db db stmtcache try-num: (- try-num 1)))
+	  (db:safely-close-sqlite3-db db stmt-cache try-num: (- try-num 1)))
 	(if (sqlite3:database? db)
 	    (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
 	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
 	      (sqlite3:finalize! db)
 	      #t)
@@ -1084,11 +1084,11 @@
 	  (for-each
 	   (lambda (server)
              (handle-exceptions
              exn
              (begin 
-               (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " servr ", exn=" exn)     
+               (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " server ", exn=" exn)     
                #f)
 	     (match-let (((mod-time host port start-time server-id pid) server))
 	       (if (and host pid)
 		   (tasks:kill-server host pid)))))
 	   servers)
@@ -2916,11 +2916,11 @@
 ;; Get run-ids for runs with same target but different runnames and NOT run-id
 ;;
 (define (db:get-prev-run-ids dbstruct run-id)
   (let* ((keyvals (db:get-key-val-pairs dbstruct run-id))
 	 (kvalues (map cadr keyvals))
-	 (keys    (rmt:get-keys))
+	 (keys    (db:get-keys dbstruct))
 	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
     (let ((prev-run-ids '()))
       (if (null? keyvals)
           '()
           (begin
@@ -3538,12 +3538,13 @@
       #f ;; default result
       test-id))))
 
 (define (db:get-test-times dbstruct run-name target)
   (let ((res `())
-        (qry 	(conc "select testname, item_path, run_duration, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname = ? and target = ?  ;")))
-   
+        (qry 	(conc "select testname, item_path, run_duration, "
+		      (string-join (db:get-keys dbstruct) " || '/' || ")
+		      " as target from tests inner join runs on tests.run_id = runs.id where runs.runname = ? and target = ?  ;")))
   (db:with-db 
     dbstruct
     #f ;; this is for the main runs db
     #f ;; does not modify db
     (lambda (db)

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -211,11 +211,11 @@
 
     (let loop ((minutes   (calc-minutes))
 	       (cpu-load  (alist-ref 'adj-core-load (common:get-normalized-cpu-load #f)))
 	       (disk-free (get-df (current-directory)))
                (last-sync (current-seconds)))
-      (common:telemetry-log "zombie" (conc "launch:monitor-job - top of loop encountered at "(current-seconds)" with last-sync="last-sync))
+      ;; (common:telemetry-log "zombie" (conc "launch:monitor-job - top of loop encountered at "(current-seconds)" with last-sync="last-sync))
       (let* ((over-time     (> (current-seconds) (+ last-sync update-period)))
              (new-cpu-load  (let* ((load  (alist-ref 'adj-core-load (common:get-normalized-cpu-load #f)))
                                    (delta (abs (- load cpu-load))))
                               (if (> delta 0.1) ;; don't bother updating with small changes
                                   load
@@ -233,11 +233,11 @@
              (test-info   (rmt:get-test-info-by-id run-id test-id))
              (state       (db:test-get-state test-info))
              (status      (db:test-get-status test-info))
              (kill-reason  "no kill reason specified")
              (kill-job?    #f))
-        (common:telemetry-log "zombie" (conc "launch:monitor-job - decision time encountered at "(current-seconds)" with last-sync="last-sync" do-sync="do-sync" over-time="over-time" update-period="update-period))
+        ;; (common:telemetry-log "zombie" (conc "launch:monitor-job - decision time encountered at "(current-seconds)" with last-sync="last-sync" do-sync="do-sync" over-time="over-time" update-period="update-period))
         (cond
          ((test-get-kill-request run-id test-id)
           (set! kill-reason "KILLING TEST since received kill request (KILLREQ)")
           (set! kill-job? #t))
          ((and runtlim (> (- (current-seconds) start-seconds) runtlim))
@@ -252,13 +252,14 @@
         (debug:print 4 *default-log-port* "cpu: " new-cpu-load " disk: " new-disk-free " last-sync: " last-sync " do-sync: " do-sync)
         (launch:handle-zombie-tests run-id)
         (when do-sync
           ;;(with-output-to-file (conc (getenv "MT_TEST_RUN_DIR") "/last-loadinfo.log" #:append)
           ;;  (lambda () (pp (list (current-seconds) new-cpu-load new-disk-free (calc-minutes)))))
-          (common:telemetry-log "zombie" (conc  "launch:monitor-job - dosync started at "(current-seconds)))
+          ;; (common:telemetry-log "zombie" (conc  "launch:monitor-job - dosync started at "(current-seconds)))
           (tests:update-central-meta-info run-id test-id new-cpu-load new-disk-free (calc-minutes) #f #f)
-          (common:telemetry-log "zombie" (conc "launch:monitor-job - dosync finished at "(current-seconds))))
+          ;; (common:telemetry-log "zombie" (conc "launch:monitor-job - dosync finished at "(current-seconds)))
+	  )
         
 	(if kill-job? 
 	    (begin
               (debug:print-info 0 *default-log-port* "proceeding to kill test: "kill-reason)
 	      (mutex-lock! m)

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -51,10 +51,12 @@
 	  (if cinfo
 	      cinfo
 	      (if (server:check-if-running areapath)
 		  (client:setup areapath)
 		  #f))))
+
+;;======================================================================
 
 (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
 
 ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
 ;;

Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -38,10 +38,11 @@
 (defstruct alldat
   (areapath #f)
   (ulexdat  #f)
   )
 
+;;======================================================================
 ;; return the handle struct for sending queries to a specific database
 ;;  - initializes the connection object if this is the first access
 ;;    - finds the "captain" and asks who to talk to for the given dbfname
 ;;    - establishes the connection to the current dbowner
 ;;