@@ -61,183 +61,10 @@
 (import servermod)
 
 (declare (uses margsmod))
 (import margsmod)
 
-(include "common_records.scm")
-
-;;======================================================================
-;; (require-library margs)
-;; (include "margs.scm")
-
-;; (define old-exit exit)
-;; 
-;; (define (exit . code)
-;;   (if (null? code)
-;;       (old-exit)
-;;       (old-exit code)))
-
-(define (common:debug-setup)
-  (debug:setup (cond ;; debug arg
-		((args:get-arg "-debug-noprop") 'noprop)
-		((args:get-arg "-debug")         #t)
-		(else #f))
-	       (cond ;; verbosity arg
-		((args:get-arg "-q") 'v)
-		((args:get-arg "-q") 'q)
-		(else #f))))
-(define *numcpus-cache* (make-hash-table))
-
-;;======================================================================
-
-(define (common:get-sync-lock-filepath)
-  (let* ((tmp-area     (common:get-db-tmp-area))
-         (lockfile     (conc tmp-area "/megatest.db.sync-lock")))
-    lockfile))
-
-;;======================================================================
-	  (debug:print 0 *default-log-port* "Failed to find this executable! Using what can be found on the path")
-
-;;======================================================================
-;; 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)
 ;;
@@ -250,11 +77,10 @@
     *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
@@ -294,10 +120,16 @@
 	   (at-home  (or (equal? homehost currhost)
 			 (equal? homehost bestadrs))))
       (set! *home-host* (cons homehost at-home))
       (mutex-unlock! *homehost-mutex*)
       *home-host*))))
+(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)))
 
 ;;======================================================================
 ;; am I on the homehost?
 ;;======================================================================
 ;;======================================================================
@@ -307,1031 +139,9 @@
   (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: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 1) 
-	(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". maxnormload = " maxnormload " numcpus = " numcpus " loadavg = " loadavg " effective-load = " effective-load))
-	  (thread-sleep! actual-delay)))
-    
-    (cond
-     ;; bad data, try again to get the data
-     ((not will-wait)
-      (if (common:low-noise-print 3600 (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)))
-
-;; 		(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)))
-;;======================================================================
-;;======================================================================
-;;======================================================================
-;;======================================================================
-;;======================================================================
-(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)))
-
-;;======================================================================
-;; use to transition to area-name
-(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)))))))))
-;;        (set! *common:telemetry-log-socket* #f)))))
-