@@ -75,5 +75,1154 @@
 	       (cond ;; verbosity arg
 		((args:get-arg "-q") 'v)
 		((args:get-arg "-q") 'q)
 		(else #f))))
 
+;;======================================================================
+;; 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)
+	  (begin
+	    (thread-sleep! 1)
+	    (if (eq? wait-time 1) ;; only one second left, steal the lock
+		(begin
+		  (debug:print-info 0 *default-log-port* "stealing lock for " keyname)
+		  (common:faux-unlock keyname force: #t)))
+	    (common:faux-lock keyname wait-time: (- wait-time 1)))
+	  #f)
+      (begin
+        (rmt:no-sync-set keyname (conc (current-process-id)))
+        (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))))
+
+(define (common:faux-unlock keyname #!key (force #f))
+  (if (or force (equal? (conc (current-process-id)) (conc (rmt:no-sync-get/default keyname #f))))
+      (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))
+
+
+(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)
+                       (conc "viewscreen " cmd))))
+    (debug:print-info 02 *default-log-port* "Running command: " fullcmd)
+    (cond
+     (with-vars     (common:without-vars  fullcmd))
+     (with-orig-env (common:with-orig-env fullcmd))
+     (else          (common:without-vars  fullcmd "MT_.*")))))
+		  
+;; 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)
+  (let* ((loadinfo                         (rmt:get-latest-host-load hostname)) ;; if this host happens to have been recently used by a test reuse the load data
+         (load                             (car loadinfo))
+         (load-sample-time                 (cdr loadinfo))
+         (load-sample-age                  (- (current-seconds) load-sample-time))
+         (loadinfo-timeout-seconds         6) ;; this was 20 seconds, seems way too lax. Switch to 6 seconds
+         (host-last-update-timeout-seconds 4)
+         (host-rec (hash-table-ref/default *host-loads* hostname #f))
+         )
+    (cond
+     ((< load-sample-age loadinfo-timeout-seconds)
+      (list #t
+            load-sample-time
+            load))
+     ((and host-rec
+           (< (current-seconds) (+ (host-last-update host-rec) host-last-update-timeout-seconds)))
+      (list #t
+            (host-last-update host-rec)
+            (host-last-cpuload host-rec )))
+     ((common:unix-ping hostname)
+      (list #t
+            (current-seconds)
+            (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)
+                          (string-match (regexp "^\\S+$") x))
+                        hosts-raw)))
+    (for-each
+     (lambda (hostname)
+       (let* ((rec       (let ((h (hash-table-ref/default *host-loads* hostname #f)))
+                          (if h
+                              h
+                              (let ((h (make-host)))
+                                (hash-table-set! *host-loads* hostname h)
+                                h))))
+              (host-info         (common:get-host-info hostname))
+              (is-reachable      (car host-info))
+              (last-reached-time (cadr host-info))
+              (load              (caddr host-info)))
+         (host-reachable-set!    rec is-reachable)
+         (host-last-update-set!  rec last-reached-time)
+         (host-last-cpuload-set! rec load)))
+     hosts)))
+
+;; 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)
+  (let ((datlist 	(sort (hash-table->alist ht)
+                              (lambda (a b)
+                                (string< (car a)(car b))))))
+    (if (null? datlist)
+    	(tipfunc #f path) ;; really shouldn't get here
+	(s:ul
+	 (map (lambda (x)
+		(let* ((levelname (car x))
+		       (y         (cdr x))
+		       (newpath   (append path (list levelname)))
+		       (leaf      (or (not (hash-table? y))
+				      (null? (hash-table-keys y)))))
+		  (if leaf
+		      (s:li (tipfunc y newpath))
+		      (s:li
+		       (list 
+			levelname
+			(common:htree->html y newpath tipfunc))))))
+	      datlist)))))
+
+;; 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))
+  ;; called often especially at start up. use mutex to eliminate collisions
+  (mutex-lock! *homehost-mutex*)
+  (cond
+   (*home-host*
+    (mutex-unlock! *homehost-mutex*)
+    *home-host*)
+   ((not *toppath*)
+    (mutex-unlock! *homehost-mutex*)
+    (launch:setup) ;; safely mutexed now
+    (if (> trynum 0)
+	(begin
+	  (thread-sleep! 2)
+	  (common:get-homehost trynum: (- trynum 1)))
+	#f))
+   (else
+    (let* ((currhost (get-host-name))
+	   (bestadrs (server:get-best-guess-address currhost))
+	   ;; first look in config, then look in file .homehost, create it if not found
+	   (homehost (or (configf:lookup *configdat* "server" "homehost" )
+			 (handle-exceptions
+			     exn
+			     (if (> trynum 0)
+				 (let ((delay-time (* (- 5 trynum) 5)))
+				   (mutex-unlock! *homehost-mutex*)
+				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
+						delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
+						", exn=" exn)
+				   (thread-sleep! delay-time)
+				   (common:get-homehost trynum: (- trynum 1)))
+				 (begin
+				   (mutex-unlock! *homehost-mutex*)
+				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
+						"] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
+						((condition-property-accessor 'exn 'message) exn))
+				   (exit 1)))
+			   (let ((hhf (conc *toppath* "/.homehost")))
+			     (if (common:file-exists? hhf)
+				 (with-input-from-file hhf read-line)
+				 (if (file-write-access? *toppath*)
+				     (begin
+				       (with-output-to-file hhf
+					 (lambda ()
+					   (print bestadrs)))
+				       (begin
+					 (mutex-unlock! *homehost-mutex*)
+					 (car (common:get-homehost))))
+				     #f))))))
+	   (at-home  (or (equal? homehost currhost)
+			 (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)))
+
+;;======================================================================
+;; 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"))
+	 (mthome-cfgfile (conc *toppath* "/.mtviews.config")))
+    (if (common:file-exists? mthome-cfgfile)
+	(read-config mthome-cfgfile view-cfgdat #t))
+    ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
+    (if (common:file-exists? home-cfgfile)
+	(read-config home-cfgfile view-cfgdat #t))
+    view-cfgdat))
+
+;;======================================================================
+;; 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.
+					 (read-config (conc *toppath* "/runconfigs.config")
+						      #f #t)
+					 (make-hash-table))))
+			   string<?))
+	(target-patt (args:get-arg "-target")))
+    (if target-patt
+	(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")
+	  #f)
+      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
+	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
+	  #f)
+      (let* ((tp (common:get-toppath #f))
+	     (lt (conc tp "/lt")))
+	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
+	lt)))
+
+(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 (std-exit-procedure)
+  ;;(common:telemetry-log-close)
+  (on-exit (lambda () 0))
+  ;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
+  (let ((no-hurry  (if *time-to-exit* ;; hurry up
+		       #f
+		       (begin
+			 (set! *time-to-exit* #t)
+			 #t))))
+    (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.")
+    (if (and no-hurry (debug:debug-mode 18))
+	(rmt:print-db-stats))
+    (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
+                              (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated
+			      (if *task-db*    
+				  (let ((db (cdr *task-db*)))
+				    (if (sqlite3:database? db)
+					(begin
+					  (sqlite3:interrupt! db)
+					  (sqlite3:finalize! db #t)
+					  ;; (vector-set! *task-db* 0 #f)
+					  (set! *task-db* #f)))))
+                              (http-client#close-all-connections!)
+                              ;; (if (and *runremote*
+                              ;;          (remote-conndat *runremote*))
+                              ;;     (begin
+                              ;;       (http-client#close-all-connections!))) ;; for http-client
+                              (if (not (eq? *default-log-port* (current-error-port)))
+                                  (close-output-port *default-log-port*))
+			      (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))
+	  (th2 (make-thread (lambda ()
+			      (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...")
+			      (if no-hurry
+                                  (begin
+                                    (thread-sleep! 5)) ;; give the clean up few seconds to do it's stuff
+                                  (begin
+      				  (thread-sleep! 2)))
+      			      (debug:print 4 *default-log-port* " ... done")
+      			      )
+			    "clean exit")))
+      (thread-start! th1)
+      (thread-start! th2)
+      (thread-join! th1)
+      )
+    )
+
+  0)
+
+;; 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?)
+	  (let ((dbstruct (db:setup #t)))
+	    (debug:print-info 13 *default-log-port* "after db:setup with dbstruct=" dbstruct)
+	    (cond
+	     ((dbr:dbstruct-read-only dbstruct)
+	      (debug:print-info 13 *default-log-port* "loading read-only watchdog")
+	      (common:readonly-watchdog dbstruct))
+	     (else
+	      (debug:print-info 13 *default-log-port* "loading writable-watchdog.")
+              (let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "brute-force-sync")))
+                (cond
+                 ((equal? syncer "brute-force-sync")
+                  (server:writable-watchdog-bruteforce dbstruct))
+                 ((equal? syncer "delta-sync")
+                  (server:writable-watchdog-deltasync dbstruct))
+                 (else
+                  (debug:print-error 0 *default-log-port* "Unknown server/sync-method specified ("syncer") - valid values are brute-force-sync and delta-sync.")
+                  (exit 1)))
+                ;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
+                )))
+	    (debug:print-info 13 *default-log-port* "watchdog done."))
+	  (debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
+
+(define (common:wait-for-homehost-load maxnormload msg)
+  (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
+                     #f
+                     (common:get-homehost)))
+         (hh     (if hh-dat (car hh-dat) #f)))
+    (common:wait-for-normalized-load maxnormload msg hh)))
+
+(define (get-with-default val default)
+  (let ((val (args:get-arg val)))
+    (if val val default)))
+
+(define (common:run-sync?)
+    (and (common:on-homehost?)
+	 (args:get-arg "-server")))
+
+(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))))
+
+;; 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!
+	(if (equal? (configf:lookup *configdat* "setup" "use-cache") "no")
+	    (set! res #f)
+	    (if (equal? (configf:lookup *configdat* "setup" "use-cache") "yes")
+		(set! res #t))))
+    (if (args:get-arg "-no-cache")(set! res #f)) ;; overrides setting in "setup"
+    (if (getenv "MT_USE_CACHE")
+	(if (equal? (getenv "MT_USE_CACHE") "yes")
+	    (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))
+	 (force-result  (case force-type
+			  ((#f)     #f)
+			  ((always) #t)
+			  ((test)   (if (args:get-arg "-execute") ;; we are in a test
+					#t
+					#f))
+			  (else
+			   (debug:print 0 *default-log-port* "ERROR: Bad server force setting " force-setting ", forcing server.")
+			   #t)))) ;; default to requiring server
+    (if force-result
+	(begin
+	  (debug:print-info 0 *default-log-port* "forcing use of server, force setting is \"" force-setting "\".")
+	  #t)
+	#f)))
+
+(define (common:in-running-test?)
+  (and (args:get-arg "-execute") (get-environment-variable "MT_CMDINFO")))
+
+(define (debug:setup debug-arg verbose-arg) ;; debug-arg= #f, #t or 'noprop
+  (let ((debugstr (or debug-arg ;; (args:get-arg "-debug")
+		      ;; (args:get-arg "-debug-noprop")
+		      (get-environment-variable "MT_DEBUG_MODE"))))
+    (debug:calc-verbosity debugstr verbose-arg)
+    ;; (debug:check-verbosity *verbosity* debugstr)
+    ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
+    (if (not (verbosity))(set! (verbosity) 1))
+    (if (and (not (eq? debug-arg 'noprop))
+	     (or debug-arg
+		 (not (get-environment-variable "MT_DEBUG_MODE"))))
+	(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
+				    (string-intersperse (map conc (verbosity)) ",")
+				    (conc (verbosity)))))))
+
+;; 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))
+	 (rules      (common:val->alist (or rdat "") convert: #t))   ;; maxnload, maxnjobs, maxjobrate
+	 (maxnload   (common:alist-ref/default 'maxnload rules 1.5)) ;; max normalized load
+	 (maxnjobs   (common:alist-ref/default 'maxnjobs rules 1.5)) ;; max normalized number of jobs
+	 (maxjobrate (common:alist-ref/default 'maxjobrate rules (/ 1 6))) ;; max rate of submitting jobs to a given host in jobs/second
+	 (hosts      (filter (lambda (x)
+			       (string-match (regexp "^\\S+$") x))
+			     hosts-raw))
+         ;; (best-host #f)
+	 (get-rec    (lambda (hostname)
+		       ;; (print "get-rec hostname=" hostname)
+		       (let ((h (hash-table-ref/default *host-loads* hostname #f)))
+			 (if h
+			     h
+			     (let ((h (make-host)))
+			       (hash-table-set! *host-loads* hostname h)
+			       h)))))
+         (best-load 99999)
+         (curr-time (current-seconds))
+	 (get-hosts-sorted (lambda (hosts)
+			     (sort hosts (lambda (a b)
+					   (let ((a-rec (get-rec a))
+						 (b-rec (get-rec b)))
+					     ;; (print "a=" a " a-rec=" a-rec " host-last-used=" (host-last-used a-rec))
+					     ;; (print "b=" b " b-rec=" b-rec " host-last-used=" (host-last-used b-rec))
+					     (< (host-last-used a-rec)
+						(host-last-used b-rec))))))))
+    (debug:print 0 *default-log-port* "INFO: hosts-sorted=" (get-hosts-sorted hosts))
+    (if (null? hosts)
+	#f ;; no hosts to select from. All done and giving up now.
+	(let ((hosts-sorted (get-hosts-sorted hosts)))
+	  (common:update-host-loads-table hosts)
+	  (let loop ((hostname  (car hosts-sorted))
+		     (tal       (cdr hosts-sorted))
+		     (best-host #f))
+	    (let* ((rec       (get-rec hostname))
+		   (reachable (host-reachable     rec))
+		   (load      (host-last-cpuload  rec))
+		   (last-used (host-last-used     rec))
+		   (delta     (- curr-time last-used))
+		   (job-rate  (if (> delta 0)
+				  (/ 1 delta)
+				  999)) ;; jobs per second
+		   (new-best  
+		    (cond
+		     ((not reachable)
+		      (debug:print 0 *default-log-port* "Skipping host " hostname " as it cannot be reached.")
+		      best-host)
+		     ((and (< load maxnload)        ;; load is acceptable
+			   (< job-rate maxjobrate)) ;; job rate is acceptable
+		      (set! best-load load)
+		      hostname)
+		     (else best-host))))
+	      (debug:print 0 *default-log-port* "INFO: Trying host " hostname " with load " load ", last used " delta " seconds ago, with job-rate " job-rate " for running a test." )
+	      (if new-best
+		  (begin ;; found a host, return it
+		    (debug:print 0 *default-log-port* "INFO: Found host: " new-best " load: " load " last-used: " delta " seconds ago, with job-rate: " job-rate)
+		    (host-last-used-set! rec curr-time)
+		    new-best)
+		  (if (null? tal) #f (loop (car tal)(cdr tal) best-host)))))))))
+
+;; '(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" "")))
+
+
+;; 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
+  (debug:print-info 13 *default-log-port* "common:readonly-watchdog entered.")
+  ;; sync megatest.db to /tmp/.../megatst.db
+  (let* ((sync-cool-off-duration   3)
+        (golden-mtdb     (dbr:dbstruct-mtdb dbstruct))
+        (golden-mtpath   (db:dbdat-get-path golden-mtdb))
+        (tmp-mtdb        (dbr:dbstruct-tmpdb dbstruct))
+        (tmp-mtpath      (db:dbdat-get-path tmp-mtdb)))
+    (debug:print-info 0 *default-log-port* "Read-only periodic sync thread started.")
+    (let loop ((last-sync-time 0))
+      (debug:print-info 13 *default-log-port* "loop top tmp-mtpath="tmp-mtpath" golden-mtpath="golden-mtpath)
+      (let* ((duration-since-last-sync (- (current-seconds) last-sync-time)))
+        (debug:print-info 13 *default-log-port* "duration-since-last-sync="duration-since-last-sync)
+        (if (and (not *time-to-exit*)
+                 (< duration-since-last-sync sync-cool-off-duration))
+            (thread-sleep! (- sync-cool-off-duration duration-since-last-sync)))
+        (if (not *time-to-exit*)
+            (let ((golden-mtdb-mtime (file-modification-time golden-mtpath))
+                  (tmp-mtdb-mtime    (file-modification-time tmp-mtpath)))
+	      (if (> golden-mtdb-mtime tmp-mtdb-mtime)
+		  (if (< golden-mtdb-mtime (- (current-seconds) 3)) ;; file has NOT been touched in past three seconds, this way multiple servers won't fight to sync back
+		      (let ((res (db:multi-db-sync dbstruct 'old2new)))
+			(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)))
+
+
+;; 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?)
+      (if (common:api-changed?)
+	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
+                (dbfile  (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.db"))
+                (read-only (not (file-write-access? dbfile)))
+                (dbstruct (db:setup #t)))
+	    (debug:print 0 *default-log-port*
+			 "WARNING: Version mismatch!\n"
+			 "   expected: " (common:version-signature) "\n"
+			 "   got:      " (common:get-last-run-version))
+            (cond
+             ((get-environment-variable "MT_SKIP_DB_MIGRATE") #t)
+             ((and (common:file-exists? mtconf) (common:file-exists? dbfile) (not read-only)
+                   (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
+              (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
+              (handle-exceptions
+               exn
+               (begin
+                 (debug:print 0 *default-log-port* "Failed to switch versions. exn=" exn)
+                 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+                 (print-call-chain (current-error-port))
+                 (exit 1))
+               (common:cleanup-db dbstruct)))
+             ((not (common:file-exists? mtconf))
+              (debug:print 0 *default-log-port* "   megatest.config does not exist in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             ((not (common:file-exists? dbfile))
+              (debug:print 0 *default-log-port* "   megatest.db does not exist in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             ((not (eq? (current-user-id)(file-owner mtconf)))
+              (debug:print 0 *default-log-port* "   You do not own megatest.db in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             (read-only
+              (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))))
+
+        
+;; 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.
+;;
+(define (common:rotate-logs)
+  (let* ((all-files (make-hash-table))
+	 (stats     (make-hash-table))
+	 (inc-stat  (lambda (key)
+		      (hash-table-set! stats key (+ (hash-table-ref/default stats key 0) 1))))
+	(max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "300")))) ;; name -> age
+    (if (not (directory-exists? "logs"))(create-directory "logs"))
+    (directory-fold 
+     (lambda (file rem)
+       (handle-exceptions
+	exn
+	(begin
+	  (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore. exn=" exn)
+	  (debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	  ;; (print-call-chain (current-error-port)) ;; 
+	  )
+	(let* ((fullname  (conc "logs/" file))
+	       (mod-time  (file-modification-time fullname))
+	       (file-age  (- (current-seconds) mod-time))
+	       (file-old  (> file-age (* 48 60 60)))
+	       (file-big  (> (file-size fullname) 200000)))
+	  (hash-table-set! all-files file mod-time)
+	  (if (or (and (string-match "^.*.log" file)
+		       file-old
+		       file-big)
+		  (and (string-match "^server-.*.log" file)
+		       file-old))
+	      (let ((gzfile (conc fullname ".gz")))
+		(if (common:file-exists? gzfile)
+		    (begin
+		      (debug:print-info 0 *default-log-port* "removing " gzfile)
+		      (delete-file* gzfile)
+		      (hash-table-delete!  all-files gzfile) ;; needed?
+		      ))
+		(debug:print-info 0 *default-log-port* "compressing " file)
+		(system (conc "gzip " fullname))
+		(inc-stat "gzipped")
+		(hash-table-set! all-files (conc file ".gz") file-age)  ;; add the .gz file and remove the base file
+		(hash-table-delete! all-files file)
+		)
+	      (if (and (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
+		       (file-exists? fullname)) ;; just in case it was gzipped - will get it next time
+		  (handle-exceptions
+		   exn
+		   #f
+		   (if (directory? fullname)
+		       (begin
+			 (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
+			 (inc-stat "directories"))
+		       (begin
+			 (delete-file* fullname)
+			 (inc-stat "deleted")))
+		   (hash-table-delete! all-files file)))))))
+     '()
+     "logs")
+    (for-each
+     (lambda (category)
+       (let ((quant (hash-table-ref/default stats category 0)))
+	 (if (> quant 0)
+	     (debug:print-info 0 *default-log-port* category " log files: " quant))))
+     `("deleted" "gzipped" "directories"))
+    (let ((num-logs (hash-table-size all-files)))
+      (if (> num-logs max-allowed) ;; because NFS => don't let number of logs exceed 300
+	  (let ((files (take (sort (hash-table-keys all-files)
+				   (lambda (a b)
+				     (< (hash-table-ref all-files a)(hash-table-ref all-files b))))
+			     (- num-logs max-allowed))))
+	    (for-each
+	     (lambda (file)
+	       (let* ((fullname (conc "logs/" file)))
+		 (if (directory? fullname)
+		     (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
+		     (handle-exceptions
+		      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."))))))
+  
+;; 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
+;;
+(define (common:get-delay load-in numcpus)
+  (let* ((ratio (/ load-in numcpus))
+         (new-option (configf:lookup *configdat* "load" "new-load-method"))
+	 (paramstr   (or (configf:lookup *configdat* "load" "exp-params")
+			 "15 12 1281453987.9543 0.75")) ;; 5 4 10 1"))
+	 (paramlst   (map string->number (string-split paramstr))))
+    (if new-option
+	(begin
+          (cond ((and (>= ratio 0) (< ratio .5))
+		 0)
+		((and (>= ratio 0.5) (<= ratio .9))
+		 (* ratio (/ 5 .9)))
+		((and (> ratio .9) (<= ratio 1.1))
+		 (+ 5 (* (- ratio .9) (/ 55 .2)))) 
+		((> ratio 1.1)
+		 60)))
+	(match paramlst
+	  ((r1 r2 s1 s2)
+	   (debug:print 3 *default-log-port* "Using params r1=" r1 " r2=" r2 " s1=" s1 " s2=" s2)
+	   (min (max (/ (expt r1 (* r2 s2 ratio)) s1) 0) 30))
+	  (else
+	   (debug:print 0 *default-log-port* "BAD exp-params, should be \"r1 r2 s1 s2\" but got " paramstr)
+	   30)))))
+
+(define (common:print-delay-table)
+  (let loop ((x 0))
+    (print x "," (common:get-delay x 1))
+    (if (< x 2)
+	(loop (+ x 0.1)))))
+
+;; 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
+				 #!key (count 1000)
+				 (msg #f)(remote-host #f)(num-tries 5))
+  (let* ((loadavg     (common:get-cpu-load remote-host))
+	  ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
+	 (numcpus     (if (<= 1 numcpus-in)
+			  (common:get-num-cpus remote-host)
+			  numcpus-in))
+	 (first       (car loadavg))
+	 (next        (cadr loadavg))
+	 (adjmaxload  (* maxnormload (max 1 numcpus))) ;; possible bug
+						   ;; where numcpus
+						   ;; (or could be
+						   ;; maxload) is
+						   ;; zero, crude
+						   ;; fallback is to
+						   ;; at least use 1
+	 ;; effective load accounts for load jumps, this should elminate all the first-next-avg, adjwait, load-jump-limit
+	 ;; etc.
+	 (effective-load    (common:get-intercept first next))
+	 (recommended-delay (common:get-delay effective-load numcpus))
+	 (effective-host    (or remote-host "localhost"))
+	 (normalized-effective-load (/ effective-load numcpus))
+	 (will-wait                 (> normalized-effective-load maxnormload)))
+    (if (> recommended-delay 0)
+	(let* ((actual-delay (min recommended-delay 30)))
+	  (if (common:low-noise-print 30 (conc (round actual-delay) "-safe-load"))
+	      (debug:print-info 0 *default-log-port* "Load control, delaying "
+				actual-delay " seconds to maintain safe load. current normalized effective load is "
+				normalized-effective-load"."))
+	  (thread-sleep! actual-delay)))
+    
+    (cond
+     ;; bad data, try again to get the data
+     ((not will-wait)
+      (if (common:low-noise-print 30 (conc (round normalized-effective-load) "-load-acceptable-" effective-host))
+	  (debug:print 0 *default-log-port* "Effective load on " effective-host " is acceptable at " effective-load " continuing.")))
+     ((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
+	   (> num-tries 0))
+      (debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load "
+		   first ", we'll sleep 10s and try " num-tries " more times.")
+      (thread-sleep! 10)
+      (common:wait-for-cpuload maxnormload numcpus-in
+			       count: count remote-host: remote-host num-tries: (- num-tries 1)))
+     ;; need to wait for load to drop
+     ((and will-wait ;; (> first adjmaxload)
+	   (> count 0))
+      (debug:print-info 0 *default-log-port*
+			"Delaying 15" ;; adjwait
+			" seconds due to normalized effective load " normalized-effective-load ;; first
+			" exceeding max of " adjmaxload
+			" on server " (or remote-host (get-host-name))
+			" (normalized load-limit: " maxnormload ") " (if msg msg ""))
+      (thread-sleep! 15) ;; adjwait)
+      (common:wait-for-cpuload maxnormload numcpus count: (- count 1) msg: msg remote-host: remote-host)
+      ;; put the message here to indicate came out of waiting
+      (debug:print-info 1 *default-log-port*
+			"On host: " effective-host
+			", effective load: " effective-load
+			", numcpus: " numcpus
+			", normalized effective load: " normalized-effective-load
+			))
+     ;; overloaded and count expired (i.e. went to zero)
+     (else
+      (if (> num-tries 0) ;; should be "num-tries-left". 
+	  (if (common:low-noise-print 30 (conc (round effective-load) "-load-acceptable-" effective-host))
+	      (debug:print 0 *default-log-port* "Load on " effective-host " is acceptable at effective normalized load of "
+			   normalized-effective-load "  continuing."))
+	  (debug:print 0 *default-log-port* "Load on " effective-host ", "
+		       first" could not be retrieved. Giving up and continuing."))))))
+
+;; 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
+	(common:wait-for-cpuload maxnormload num-cpus 15 msg: msg remote-host: remote-host)
+	(begin
+	  (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)))))
+
+;; 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")
+      (with-input-from-pipe 
+       (conc (configf:lookup *configdat* "setup" "free-space-script") " " path)
+       (lambda ()
+	 (let ((res (read-line)))
+	   (if (string? res)
+	       (string->number res)))))
+      (get-unix-df path)))
+
+(define (common:check-space-in-dir dirpath required)
+  (let* ((dbspace  (if (directory? dirpath)
+		       (get-df dirpath)
+		       0)))
+    (list (> dbspace required)
+	  dbspace
+	  required
+	  dirpath)))
+
+
+(define (get-free-inodes path)
+  (if (configf:lookup *configdat* "setup" "free-inodes-script")
+      (with-input-from-pipe 
+	  (conc (configf:lookup *configdat* "setup" "free-inodes-script") " " path)
+	(lambda ()
+	  (let ((res (read-line)))
+	    (if (string? res)
+		(string->number res)))))
+      (get-unix-inodes path)))
+
+;;======================================================================
+;;  T E S T   L A U N C H I N G   P E R   I T E M   W I T H   H O S T   T Y P E S
+;;======================================================================
+;; 
+;; [hosts]
+;; arm cubie01 cubie02
+;; x86_64 zeus xena myth01
+;; allhosts #{g hosts arm} #{g hosts x86_64}
+;; 
+;; [host-types]
+;; general #MTLOWESTLOAD #{g hosts allhosts}
+;; arm     #MTLOWESTLOAD #{g hosts arm}
+;; nbgeneral nbjob run JOBCOMMAND -log $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME.$MT_TESTNAME-$MT_ITEM_PATH.lgo
+;;
+;; [host-rules]
+;; # maxnload   => max normalized load
+;; # maxnjobs   => max jobs per cpu
+;; # maxjobrate => max jobs per second
+;; general maxnload=1.1; maxnjobs=1.2; maxjobrate=0.1 
+;; 
+;; [launchers]
+;; envsetup general
+;; xor/%/n 4C16G
+;; % nbgeneral
+;; 
+;; [jobtools]
+;; # if defined and not "no" flexi-launcher will bypass "launcher" unless no match.
+;; flexi-launcher yes  
+;; launcher nbfake
+;;
+(define (common:get-launcher configdat testname itempath)
+  (let ((fallback-launcher (configf:lookup configdat "jobtools" "launcher")))
+    (if (and (configf:lookup configdat "jobtools" "flexi-launcher") ;; overrides launcher
+	     (not (equal? (configf:lookup configdat "jobtools" "flexi-launcher") "no")))
+	(let* ((launchers         (hash-table-ref/default configdat "launchers" '())))
+	  (if (null? launchers)
+	      fallback-launcher
+	      (let loop ((hed (car launchers))
+			 (tal (cdr launchers)))
+		(let ((patt      (car hed))
+		      (host-type (cadr hed)))
+		  (if (tests:match patt testname itempath)
+		      (begin
+			(debug:print-info 2 *default-log-port* "Have flexi-launcher match for " testname "/" itempath " = " host-type)
+			(let ((launcher (configf:lookup configdat "host-types" host-type)))
+			  (if launcher
+			      (let* ((launcher-parts (string-split launcher))
+				     (launcher-exe   (car launcher-parts)))
+				(if (equal? launcher-exe "#MTLOWESTLOAD") ;; this is our special case, we will find the lowest load and craft a nbfake commandline
+				    (let host-loop ((targ-host (common:get-least-loaded-host (cdr launcher-parts) host-type configdat))
+						    (count     100))
+				      (if targ-host
+					  (conc "remrun " targ-host)
+					  (if (> count 0)
+					      (begin
+						(debug:print 0 *default-log-port* "INFO: Waiting for a host for host-type " host-type)
+						(thread-sleep! (- 101 count))
+						(host-loop (common:get-least-loaded-host (cdr launcher-parts) host-type configdat)
+							   (- count 1)))
+					      (begin
+						(debug:print 0 *default-log-port* "FATAL: Failed to find a host from #MTLOWESTLOAD for host-type " host-type)
+						(exit)))))
+				    launcher))
+			      (begin
+				(debug:print-info 0 *default-log-port* "WARNING: no launcher found for host-type " host-type)
+				(if (null? tal)
+				    fallback-launcher
+				    (loop (car tal)(cdr tal)))))))
+		      ;; no match, try again
+		      (if (null? tal)
+			  fallback-launcher
+			  (loop (car tal)(cdr tal))))))))
+	fallback-launcher)))
+
+(define (common:get-pkts-dirs mtconf use-lt)
+  (let* ((pktsdirs-str (or (configf:lookup mtconf "setup"  "pktsdirs")
+			   (and use-lt
+				(conc (or *toppath*
+					  (current-directory))
+				      "/lt/.pkts"))))
+	 (pktsdirs  (if pktsdirs-str
+			(string-split pktsdirs-str " ")
+			#f)))
+    pktsdirs))
+
+(define (common:with-queue-db mtconf proc #!key (use-lt #f)(toppath-in #f))
+  (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
+	 (pktsdir  (if pktsdirs (car pktsdirs) #f))
+	 (toppath  (or (configf:lookup mtconf "scratchdat" "toppath")
+		       toppath-in))
+	 (pdbpath  (or (configf:lookup mtconf "setup"  "pdbpath") pktsdir)))
+    (cond
+     ((not (and  pktsdir toppath pdbpath))
+      (debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.")
+      (debug:print  0 *default-log-port* "  you need to have pktsdirs in the [setup] section."))
+     ((not (common:file-exists? pktsdir))
+      (debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir))
+     ((not (equal? (file-owner pktsdir)(current-effective-user-id)))
+      (debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
+     (else
+	(let* ((pdb  (open-queue-db pdbpath "pkts.db"
+				    schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
+	  (proc pktsdirs pktsdir pdb)
+	  (dbi:close pdb))))))
+
+;; check space in dbdir and in megatest dir
+;; returns: ok/not dbspace required-space
+;;
+(define (common:check-db-dir-space)
+  (let* ((required (string->number 
+                    ;; default is 1GB (or actually a billion bytes) This is the number of 1 kB blocks.
+		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
+			"1000000")))
+	 (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))
+	 (dbspace  (cadr spacedat))
+	 (required (caddr spacedat))
+	 (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)
+        (default-min-inodes-string "1000000")
+        (default-min-inodes (string->number default-min-inodes-string))
+        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes)))
+
+    (for-each 
+     (lambda (disk-num)
+       (let* ((dirpath    (cadr (assoc disk-num disks)))
+	      (freespc    (cond
+			   ((not (directory? dirpath))
+			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
+			    -1)
+			   ((not (file-write-access? dirpath))
+			    (if (common:low-noise-print 300 "disks not writeable " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
+			    -1)
+			   ((not (eq? (string-ref dirpath 0) #\/))
+			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
+			    -1)
+			   (else
+			    (get-df dirpath))))
+	      (free-inodes (cond
+			   ((not (directory? dirpath))
+			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
+			    -1)
+			   ((not (file-write-access? dirpath))
+			    (if (common:low-noise-print 300 "disks not writeable " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
+			    -1)
+			   ((not (eq? (string-ref dirpath 0) #\/))
+			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
+				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
+			    -1)
+			   (else
+			    (get-free-inodes dirpath))))
+             ;;(free-inodes (get-free-inodes dirpath))
+             )
+             (debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes)
+	 (if (and (> freespc bestsize)(> free-inodes min-inodes ))
+	     (begin
+	       (set! best     (cons disk-num dirpath))
+	       (set! bestsize freespc)))
+        ;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
+      ))
+     (map car disks))
+    (if (and best (> bestsize minsize))
+	best
+	#f))) ;; #f means no disk candidate found
+
+;; 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:set-last-run-version)
+  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))
+
+(define (common:get-last-run-version-number)
+  (string->number 
+   (substring (common:get-last-run-version) 0 6)))
+
+;; 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))))
+
+
+;; 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 
+   dbstruct
+   'schema
+   ;; 'new2old
+   'killservers
+   'adj-target
+   ;; 'old2new
+   'new2old
+   ;; (if full
+       '(dejunk)
+       ;; '())
+       )
+  (if (common:api-changed?)
+      (common:set-last-run-version)))
+
+(define common:get-area-name common:get-testsuite-name)
+
+(define (common:load-pkts-to-db mtconf #!key (use-lt #f))
+  (common:with-queue-db
+   mtconf
+   (lambda (pktsdirs pktsdir pdb)
+     (for-each
+      (lambda (pktsdir) ;; look at all
+	(cond
+	 ((not (common:file-exists? pktsdir))
+	  (debug:print 0 *default-log-port* "ERROR: packets directory " pktsdir " does not exist."))
+	 ((not (directory? pktsdir))
+	  (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not a directory."))
+	 ((not (file-read-access? pktsdir))
+	  (debug:print 0 *default-log-port* "ERROR: packets directory path " pktsdir " is not readable."))
+	 (else
+	  (debug:print-info 0 *default-log-port* "Loading packets found in " pktsdir)
+	  (let ((pkts (glob (conc pktsdir "/*.pkt"))))
+	    (for-each
+	     (lambda (pkt)
+	       (let* ((uuid    (cadr (string-match ".*/([0-9a-f]+).pkt" pkt)))
+		      (exists  (lookup-by-uuid pdb uuid #f)))
+		 (if (not exists)
+		     (let* ((pktdat (string-intersperse
+				     (with-input-from-file pkt read-lines)
+				     "\n"))
+			    (apkt   (pkt->alist pktdat))
+			    (ptype  (alist-ref 'T apkt)))
+		       (add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0)
+		       (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
+		     (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
+		     )))
+	     pkts)))))
+      pktsdirs))
+   use-lt: use-lt))
+
+;; 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))
+	     (pktalist (if parent
+			   (cons `(parent . ,parent)
+				 pktalist-in)
+			   pktalist-in)))
+	(let-values (((uuid pkt)
+		      (alist->pkt pktalist common:pkts-spec)))
+	  (hash-table-set! *pkts-info* 'last-parent uuid)
+	  (let ((pktsdir (or (hash-table-ref/default *pkts-info* 'pkts-dir #f)
+			     (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
+				    (pktsdir   (car pktsdirs))) ;; assume it is there
+			       (hash-table-set! *pkts-info* 'pkts-dir pktsdir)
+			       pktsdir))))
+            (handle-exceptions
+             exn
+             (debug:print-info 0 "failed to write out packet to " pktsdir ", exn=" exn) ;; don't care if this failed for now but MUST FIX - BUG!!
+             (if (not (file-exists? pktsdir))
+                 (create-directory pktsdir #t))
+             (with-output-to-file
+                 (conc pktsdir "/" uuid ".pkt")
+               (lambda ()
+                 (print pkt)))))))))
+