@@ -18,25 +18,37 @@
 
 (declare (unit servermod))
 
 (declare (uses commonmod))
 (declare (uses configfmod))
+(declare (uses mtmod))
 (declare (uses debugprint))
 (declare (uses mtargs))
 
 (module servermod
 	*
+
+(import scheme
+	chicken)
 	
 (use (srfi 18) extras s11n)
 (use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
 (use directory-utils posix-extras matchable utils)
 (use spiffy uri-common intarweb http-client spiffy-request-vars)
 
-(import commonmod
+(import ports
+	data-structures
+	files
+	srfi-4
+	typed-records
+	
+	commonmod
 	configfmod
 	debugprint
-	(prefix mtargs args:))
+	(prefix mtargs args:)
+	mtmod
+	)
 
 (include "common_records.scm")
 (include "db_records.scm")
 
 (define (server:make-server-url hostport)
@@ -159,14 +171,10 @@
     (unsetenv "TARGETHOST_LOGF")
     ;; (if (get-environment-variable "TARGETHOST")(unsetenv "TARGETHOST"))
     (thread-join! log-rotate)
     (pop-directory)))
 
-;; given a path to a server log return: host port startseconds server-id
-;; any changes to number of elements returned by this fuction will dirctly affect server:record->url,server:record->id,server:kill,server:get-num-alive which use match let 
-;; example of what it's looking for in the log file:
-;;     SERVER STARTED: 10.38.175.67:50216 AT 1616502350.0 server-id: 4907e90fc55c7a09694e3f658c639cf4 
 
 (define (server:logf-get-start-info logf)
   (let ((server-rx    (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+) server-id: (\\S+) pid: (\\d+)")) ;; SERVER STARTED: host:port AT timesecs server id
         (dbprep-rx    (regexp "^SERVER: dbprep"))
         (dbprep-found 0)
@@ -199,150 +207,20 @@
 				   (string->number port)
 				   (string->number start)
 				   server-id
 				   (string->number pid)))
 			    (else
-			     (debug:print 0 *current-log-port* "ERROR: did not recognise SERVER line info "mlst)
+			     (debug:print 0 *default-log-port* "ERROR: did not recognise SERVER line info "mlst)
 			     bad-dat))))
 	       (begin 
 		 (if dbprep-found
 		     (begin
 		       (debug:print-info 2 *default-log-port* "Server is in dbprep at " (common:human-time))
 		       (thread-sleep! 0.5)) ;; was 25 sec but that blocked things from starting?
 		     (debug:print-info 0 *default-log-port* "Unable to get server info from " logf " at " (seconds->time-string (current-seconds))))
 		 bad-dat))))))))
 
-;; ;; get a list of servers from the log files, with all relevant data
-;; ;; ( mod-time host port start-time pid )
-;; ;;
-;; (define (server:get-list areapath #!key (limit #f))
-;;   (let ((fname-rx    (regexp "^(|.*/)server-(\\d+)-(\\S+).log$"))
-;; 	(day-seconds (* 24 60 60)))
-;;     ;; if the directory exists continue to get the list
-;;     ;; otherwise attempt to create the logs dir and then
-;;     ;; continue
-;;     (if (if (directory-exists? (conc areapath "/logs"))
-;; 	    '()
-;; 	    (if (file-write-access? areapath)
-;; 		(begin
-;; 		  (condition-case
-;; 		   (create-directory (conc areapath "/logs") #t)
-;; 		   (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
-;; 		   (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn)))
-;; 		  (directory-exists? (conc areapath "/logs")))
-;; 		'()))
-;; 
-;;         ;; Get the list of server logs.
-;; 	(let* (
-;;                ;; For some reason, when I uncomment the below line, ext-tests sometimes starts 1000's of servers.
-;;                ;; (exiting-servers (system (conc "bash -c 'rm -f `grep -il exiting " areapath "/logs/server-*-*.log 2> /dev/null`'")))
-;;                (server-logs   (glob (conc areapath "/logs/server-*-*.log")))
-;; 	       (num-serv-logs (length server-logs)))
-;; 	  (if (or (null? server-logs) (= num-serv-logs 0))
-;;               (let ()
-;;                  (debug:print 2  *default-log-port* "There are no servers running at " (common:human-time))
-;; 	         '()
-;;               )
-;; 	      (let loop ((hed  (string-chomp (car server-logs)))
-;; 			 (tal  (cdr server-logs))
-;; 			 (res '()))
-;; 		(let* ((mod-time  (handle-exceptions
-;; 				   exn
-;; 				   (begin
-;; 				     (debug:print 0 *default-log-port* "server:get-list: failed to get modification time on " hed ", exn=" exn)
-;; 				     (current-seconds)) ;; 0
-;; 				   (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted
-;; 		       (down-time (- (current-seconds) mod-time))
-;; 		       (serv-dat  (if (or (< num-serv-logs 10)
-;; 				  	  (< down-time 900)) ;; day-seconds))
-;; 				      (server:logf-get-start-info hed)
-;; 				      '())) ;; don't waste time processing server files not touched in the 15 minutes if there are more than ten servers to look at
-;; 		       (serv-rec (cons mod-time serv-dat))
-;; 		       (fmatch   (string-match fname-rx hed))
-;; 		       (pid      (if fmatch (string->number (list-ref fmatch 2)) #f))
-;; 		       (new-res  (if (null? serv-dat)
-;; 				     res
-;; 				     (cons (append serv-rec (list pid)) res)))) ;; any changes to number of elements in new-res will dirctly affect server:record->url,server:record->id,server:kill,server:get-num-alive which uses match let 
-;; 		  (if (null? tal)
-;; 		      (if (and limit
-;; 			       (> (length new-res) limit))
-;; 			  new-res ;; (take new-res limit)  <= need intelligent sorting before this will work
-;; 			  new-res)
-;; 		      (loop (string-chomp (car tal)) (cdr tal) new-res)))))))))
-
-#;(define (server:get-num-alive srvlst)
-  (let ((num-alive 0))
-    (for-each
-     (lambda (server)
-        (handle-exceptions
-          exn
-         (begin 
-          (debug:print-info 0 *default-log-port*  "Unable to get server start-time and/or mod-time from " server ", exn=" exn))
-       (match-let (((mod-time host port start-time server-id pid)
-		    server))
-	 (let* ((uptime  (- (current-seconds) mod-time))
-		(runtime (if start-time
-			     (- mod-time start-time)
-			     0)))
-	   (if (< uptime 5)(set! num-alive (+ num-alive 1)))))))
-     srvlst)
-    num-alive))
-
-;; ;; given a list of servers get a list of valid servers, i.e. at least
-;; ;; 10 seconds old, has started and is less than 1 hour old and is
-;; ;; active (i.e. mod-time < 10 seconds
-;; ;;
-;; ;; mod-time host port start-time pid
-;; ;;
-;; ;; sort by start-time descending. I.e. get the oldest first. Young servers will thus drop off
-;; ;; and servers should stick around for about two hours or so.
-;; ;;
-;; (define (server:get-best srvlst)
-;;   (let* ((nums (server:get-num-servers))
-;; 	 (now  (current-seconds))
-;; 	 (slst (sort
-;; 		(filter (lambda (rec)
-;; 			  (if (and (list? rec)
-;; 				   (> (length rec) 2))
-;; 			      (let ((start-time (list-ref rec 3))
-;; 				    (mod-time   (list-ref rec 0)))
-;; 				;; (print "start-time: " start-time " mod-time: " mod-time)
-;; 				(and start-time mod-time
-;; 				     (> (- now start-time) 0)    ;; been running at least 0 seconds
-;; 				     (< (- now mod-time)   16)   ;; still alive - file touched in last 16 seconds
-;; 				     (or (not (configf:lookup *configdat* "server" "runtime")) ;; skip if not set
-;; 					 (< (- now start-time)       
-;; 					    (+ (- (string->number (configf:lookup *configdat* "server" "runtime"))
-;; 					       180)
-;; 					    (random 360)))) ;; under one hour running time +/- 180
-;; 				     ))
-;; 			      #f))
-;; 			srvlst)
-;; 		(lambda (a b)
-;; 		  (< (list-ref a 3)
-;; 		     (list-ref b 3))))))
-;;     (if (> (length slst) nums)
-;; 	(take slst nums)
-;; 	slst)))
-
-;; ;; switch from server:get-list to server:get-servers-info
-;; ;;
-;; (define (server:get-first-best areapath)
-;;   (let ((srvrs (server:get-best (server:get-list areapath))))
-;;     (if (and srvrs
-;; 	     (not (null? srvrs)))
-;; 	(car srvrs)
-;; 	#f)))
-;; 
-;; (define (server:get-rand-best areapath)
-;;   (let ((srvrs (server:get-best (server:get-list areapath))))
-;;     (if (and (list? srvrs)
-;; 	     (not (null? srvrs)))
-;; 	(let* ((len (length srvrs))
-;; 	       (idx (random len)))
-;; 	  (list-ref srvrs idx))
-;; 	#f)))
 
 (define (server:record->id servr)
   (handle-exceptions
    exn
    (begin 
@@ -364,43 +242,10 @@
 	       servr))
     (if (and host port)
 	(conc host ":" port)
 	#f))))
 
-
-;; if server-start-last exists, and wasn't old enough, wait <idle time> + 1, then call this function recursively until it is old enough.
-;; if it is old enough, overwrite it and wait 0.25 seconds.
-;; if it then has the wrong server key, wait <idle time> + 1 and call this function recursively.
-;;
-#;(define (server:wait-for-server-start-last-flag areapath)
-  (let* ((start-flag (conc areapath "/logs/server-start-last"))
-	 ;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
-	 (idletime    (configf:lookup-number *configdat* "server" "idletime" default: 4))
-	 (server-key (conc (get-host-name) "-" (current-process-id))))
-    (if (file-exists? start-flag)
-	(let* ((fmodtime (file-modification-time start-flag))
-	       (delta    (- (current-seconds) fmodtime))
-	       (old-enough   (> delta idletime))
-               (new-server-key ""))
-          ;; write start-flag file, wait 0.25s, then if previously the start-flag file was older than <idletime> seconds, and the new file still has the same server key as you just wrote, return #t.
-	  ;; the intention is to make sure nfs can read the file we just wrote, and make sure it was written by us, and not another process.
-           (if (and old-enough
-		    (begin
-                      (debug:print-info 2 *default-log-port* "Writing " start-flag)
-		      (with-output-to-file start-flag (lambda () (print server-key)))
-		      (thread-sleep! 0.25)
-		      (set! new-server-key (with-input-from-file start-flag (lambda () (read-line))))
-		      (equal? server-key new-server-key)))
-	       #t
-               ;; If either of the above conditions is not true, print a "Gating server start" message, wait <idle-time> + 1, then call this function recursively. 
-	       (begin
-		 (debug:print-info 0 *default-log-port* "Gating server start, last start: "
-				   (seconds->time-string fmodtime) ", time since last start: " delta ", required idletime: " idletime ", gating reason:" (if old-enough "another job started a server" "too soon to start another server"))
-		 
-		 (thread-sleep! ( + 1 idletime))
-		 (server:wait-for-server-start-last-flag areapath)))))))
-
 ;; oldest server alive determines host then choose random of youngest
 ;; five servers on that host
 ;;
 (define (server:get-servers-info areapath)
   ;; (assert *toppath* "FATAL: server:get-servers-info called before *toppath* has been set.")
@@ -564,170 +409,10 @@
 		   exn
 		 (debug:print 0 *default-log-port* "WARNING: failed to delete old server info file "sfile)
 		 (delete-file sfile))))))
      sfiles)))
 
-;; would like to eventually get rid of this
-;;
-(define (common:on-homehost?)
-  (if (eq? (rmt:transport-mode) 'http)
-      (server:choose-server *toppath* 'home?)
-      #t)) ;; there is no homehost for tcp and nfs is always on home so #t should work
-
-;; kind start up of server, wait before allowing another server for a given
-;; area to be launched
-;;
-(define (server:kind-run areapath)
-  ;; look for $MT_RUN_AREA_HOME/logs/server-start-last
-  ;; and wait for it to be at least <server idletime> seconds old
-  ;; (server:wait-for-server-start-last-flag areapath)
-  (let loop ()
-    (if (> (alist-ref 'adj-proc-load (common:get-normalized-cpu-load #f)) 2)
-	(begin
-	  (if (common:low-noise-print 30 "our-host-load")
-	      (debug:print 0 *default-log-port* "WARNING: system load is high, waiting to start server."))
-	  (loop))))
-  (if (< (server:choose-server areapath 'count) 20)
-      (server:run areapath))
-  #;(if (not (server:check-if-running areapath)) ;; why try if there is already a server running?
-      (let* ((lock-file    (conc areapath "/logs/server-start.lock")))
-	(let* ((start-flag (conc areapath "/logs/server-start-last")))
-	  (common:simple-file-lock-and-wait lock-file expire-time: 25)
-	  (debug:print-info  2 *default-log-port* "server:kind-run: touching " start-flag)
-	  (system (conc "touch " start-flag)) ;; lazy but safe
-	  (server:run areapath)
-	  (thread-sleep! 20) ;; don't release the lock for at least a few seconds. And allow time for the server startup to get to "SERVER STARTED".
-	  (common:simple-file-release-lock lock-file)))
-      (debug:print-info 0 *default-log-port* "Found server already running. NOT trying to start another.")))
-
-;; this one seems to be the general entry point
-;;
-(define (server:start-and-wait areapath #!key (timeout 60))
-  (let ((give-up-time (+ (current-seconds) timeout)))
-    (let loop ((server-info (server:check-if-running areapath))
-	       (try-num    0))
-      (if (or server-info
-	      (> (current-seconds) give-up-time)) ;; server-url will be #f if no server available.
-	  (server:record->url server-info)
-	  (let* ( (servers (server:choose-server areapath 'all-valid))
-                (num-ok (if servers (length (server:choose-server areapath 'all-valid)) 0)))
-	    (if (and (> try-num 0)  ;; first time through simply wait a little while then try again
-		     (< num-ok 1))  ;; if there are no decent candidates for servers then try starting a new one
-		(server:run areapath))
-	    (thread-sleep! 5)
-	    (loop (server:check-if-running areapath)
-		  (+ try-num 1)))))))
-
-(define (server:get-num-servers #!key (numservers 2))
-  (let ((ns (string->number
-	     (or (configf:lookup *configdat* "server" "numservers") "notanumber"))))
-    (or ns numservers)))
-
-;; no longer care if multiple servers are started by accident. older servers will drop off in time.
-;;
-(define (server:check-if-running areapath) ;;  #!key (numservers "2"))
-  (let* ((ns            (server:get-num-servers)) ;; get the setting the for maximum number of servers allowed
-	 (servers       (server:choose-server areapath 'best-ten))) ;; (server:get-best (server:get-list areapath))))
-    (if (or (and servers
-		 (null? servers))
-	    (not servers))
-	    ;; (and (list? servers)
-	    ;;	 (< (length servers) (+ 1 (random ns))))) ;; somewhere between 1 and numservers
-        #f
-        (let loop ((hed (car servers))
-                   (tal (cdr servers)))
-          (let ((res (server:check-server hed)))
-            (if res
-                hed
-                (if (null? tal)
-                    #f
-                    (loop (car tal)(cdr tal)))))))))
-
-;; ping the given server
-;;
-(define (server:check-server server-record)
-  (let* ((server-url (server:record->url server-record))
-         (server-id  (server:record->id server-record)) 
-         (res        (server:ping server-url server-id)))
-    (if res
-        server-url
-	#f)))
-
-(define (server:kill servr)
-  (handle-exceptions
-    exn
-    (begin 
-      (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " servr ", exn=" exn)     
-    #f)
-  (match-let (((hostname port start-time server-id pid)
-	       servr))
-    (tasks:kill-server hostname pid))))
-
-;; ;; called in megatest.scm, host-port is string hostname:port
-;; ;;
-;; ;; NOTE: This is NOT called directly from clients as not all transports support a client running
-;; ;;       in the same process as the server.
-;; ;;
-;; (define (server:ping host:port server-id #!key (do-exit #f))
-;;   (let* ((host-port (cond
-;; 		     ((string? host:port)
-;; 		      (let ((slst (string-split   host:port ":")))
-;; 			(if (eq? (length slst) 2)
-;; 			    (list (car slst)(string->number (cadr slst)))
-;; 			    #f)))
-;; 		     (else
-;; 		      #f))))
-;;     (cond
-;;      ((and (list? host-port)
-;; 	   (eq? (length host-port) 2))
-;;       (let* ((myrunremote (make-and-init-remote *toppath*))
-;; 	     (iface       (car host-port))
-;; 	     (port        (cadr host-port))
-;; 	     (server-dat  (client:connect iface port server-id myrunremote))
-;; 	     (login-res   (rmt:login-no-auto-client-setup myrunremote)))
-;; 	(http-transport:close-connections myrunremote)
-;; 	(if (and (list? login-res)
-;; 		 (car login-res))
-;; 	    (begin
-;; 	      ;; (print "LOGIN_OK")
-;; 	      (if do-exit (exit 0))
-;; 	      #t)
-;; 	    (begin
-;; 	      ;; (print "LOGIN_FAILED")
-;; 	      (if do-exit (exit 1))
-;; 	      #f))))
-;;      (else 
-;;       (if host:port
-;; 	  (debug:print 0 *default-log-port*  "ERROR: bad host:port "host:port))
-;;       (if do-exit
-;; 	  (exit 1)
-;; 	  #f)))))
-;; 
-;; ;; run ping in separate process, safest way in some cases
-;; ;;
-;; (define (server:ping-server ifaceport)
-;;   (with-input-from-pipe 
-;;    (conc (common:get-megatest-exe) " -ping " ifaceport)
-;;    (lambda ()
-;;      (let loop ((inl (read-line))
-;; 		(res "NOREPLY"))
-;;        (if (eof-object? inl)
-;; 	   (case (string->symbol res)
-;; 	     ((NOREPLY)  #f)
-;; 	     ((LOGIN_OK) #t)
-;; 	     (else       #f))
-;; 	   (loop (read-line) inl))))))
-;; 
-;; ;; NOT USED (well, ok, reference in rpc-transport but otherwise not used).
-;; ;;
-;; (define (server:login toppath)
-;;   (lambda (toppath)
-;;     (set! *db-last-access* (current-seconds)) ;; might not be needed.
-;;     (if (equal? *toppath* toppath)
-;; 	#t
-;; 	#f)))
-
 ;; timeout is hms string: 1h 5m 3s, default is 1 minute
 ;; This is currently broken. Just use the number of hours with no unit.
 ;; Default is 600 seconds.
 ;;
 (define (server:expiration-timeout)
@@ -875,86 +560,13 @@
 		      (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."))))))
 
-(define (common:wait-for-homehost-load maxnormload msg)
-  (let loop ((start-time (current-seconds))) ;; we saw some instances of this being called before *toppath* was set. This might be an early setup race. This delay should help but it is impossible to test...
-    (if (not *toppath*)
-	(begin
-	  (debug:print 0 *default-log-port* "ERROR: common:wait-for-homehost-load called before *toppath* set.")
-	  (thread-sleep! 30)
-	  (if (< (- (current-seconds) start-time) 300)
-	      (loop start-time)))))
-  (case (rmt:transport-mode)
-    ((http)
-     (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
-			#f
-			(server:choose-server *toppath* 'homehost)))
-            (hh     (if hh-dat (car hh-dat) #f)))
-       (common:wait-for-normalized-load maxnormload msg hh)))
-    (else
-     (common:wait-for-normalized-load maxnormload msg (get-host-name)))))
-    
-;;======================================================================
-;; 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 (and *toppath*              ;; do nothing if *toppath* not yet provided
-	   (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") ".mtdb/main.db"))
-                 (read-only (not (file-write-access? dbfile)))
-                 (dbstruct (db:setup))) ;; (db:setup-db *dbstruct-dbs* *toppath* #f))) ;;  #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* "   .mtdb/main.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 .mtdb/main.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))))
-
 ;;======================================================================
 ;; E X I T   H A N D L I N G
 ;;======================================================================
-
-;; (define (common:run-sync?)
-;;   (and *toppath*               ;; gate if called before *toppath* is set
-;;        (common:on-homehost?)
-;;        (args:get-arg "-server")))
-
 
 (define (std-signal-handler signum)
   ;; (signal-mask! signum)
   (set! *time-to-exit* #t) 
   ;;(debug:print-info 13 *default-log-port* "got signal "signum)
@@ -973,65 +585,38 @@
 
 
 (set-signal-handler! signal/int  std-signal-handler)  ;; ^C
 (set-signal-handler! signal/term std-signal-handler)
 ;;======================================================================
-;; 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)))
+;; 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)))))
 
 ;;======================================================================
 ;; 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
@@ -1097,11 +682,11 @@
      ;; 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 "
-			   effective-normalized-load "  continuing."))
+			   normalized-effective-load "  continuing."))
 	  (debug:print 0 *default-log-port* "Load on " effective-host ", "
 		       first" could not be retrieved. Giving up and continuing."))))))
 
 ;;======================================================================
 ;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load