Megatest

(define (tt:save-server-meta host port meta)
  (hash-table-set! *server-load* (conc host":"port) (cons meta (current-seconds))))

(define (tt:get-server-threads dat)
  (let* ((host (car  dat))
	 (port (cadr dat))
	 (dat  (tt:get-server-meta host port #t))
	 (meta (car dat)))
	 (meta (if dat (car dat) #f)))
    (if (list? meta)
	(alist-ref 'sload meta)
	#f)))
	(or (alist-ref 'sload meta) 99998)
	99999))) ;; absurd number means don't use this one

;; lazy get, does not auto-refresh meta, this might be a problem
;;
(define (tt:get-server-meta host port #!optional (do-ping #f))
  (let* ((get-meta (lambda ()
		     (let* ((dat  (hash-table-ref/default *server-load* (conc host":"port) #f)))
		       (if dat (car dat) #f))))
	 (meta     (get-meta)))
    (if (and (not meta)
	     do-ping)
	(begin
	  (tt:timed-ping host port #f)
	  (get-meta))
	meta)))

(define (tt:wait-on-server-load run-id ttdat)
  (if ttdat ;; if no server yet just pass on through
  (let* ((dbfname                 (dbmod:run-id->dbfname run-id))
	 (get-lowest-thread-load
	  (lambda ()
	    (let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
	      (car (map tt:get-server-threads sdats))))))
    (if ttdat
	(let loop ()
	  (if (> (get-lowest-thread-load) 5) ;; load is pretty high
	      (begin
		(debug:print 0 *default-log-port* "Servers appear overloaded, waiting...")
		(thread-sleep! 1)
		(loop))))
	(debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set"))))
      (let* ((dbfname                 (dbmod:run-id->dbfname run-id))
	     (get-lowest-thread-load
	      (lambda ()
		(let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
		  (car (map tt:get-server-threads sdats))))))
	(if ttdat
	    (let loop ()
	      (if (> (get-lowest-thread-load) 5) ;; load is pretty high
		  (begin
		    (debug:print 0 *default-log-port* "Servers appear overloaded, waiting...")
		    (thread-sleep! 1)
		    (loop))))
	    (debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set")))))

(define (tt:ping host port server-id #!optional (tries-left 5))
  (let*  ((res      (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id
	  (try-again (lambda ()
		       (if (> tries-left 0)
			   (begin
			     (thread-sleep! 1)