Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -22,12 +22,12 @@
 CSCOPTS=
 INSTALL=install
 SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm	\
            server.scm configf.scm db.scm keys.scm margs.scm		\
            process.scm runs.scm tasks.scm tests.scm genexample.scm	\
-           http-transport.scm tdb.scm client.scm mt.scm	\
-           ezsteps.scm lock-queue.scm rmt.scm api.scm		\
+           tdb.scm mt.scm	\
+           ezsteps.scm rmt.scm api.scm		\
            subrun.scm portlogger.scm archive.scm env.scm		\
            diff-report.scm cgisetup/models/pgdb.scm
 
 # module source files
 MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
@@ -116,20 +116,17 @@
 
 TCMTOBJS = \
 	api.o \
 	archive.o \
 	cgisetup/models/pgdb.o \
-	client.o \
 	common.o \
 	configf.o \
 	db.o \
 	env.o \
-	http-transport.o \
 	items.o \
 	keys.o \
 	launch.o \
-	lock-queue.o \
 	margs.o \
 	mt.o \
 	ods.o \
 	portlogger.o \
 	process.o \
@@ -192,11 +189,11 @@
 mofiles-made : $(MOFILES)
 	make $(MOIMPFILES)
 
 megatest.o : mofiles-made megatest-fossil-hash.scm megatest-version.scm $(MOFILES) $(MOIMPFILES)
 
-rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm megatest-version.scm
+rmt.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm megatest-version.scm
 
 common_records.scm : altdb.scm
 
 mofiles/dbfile.o : mofiles/commonmod.o
 
@@ -495,28 +492,29 @@
 	fi
 	if csi -ne '(import postgresql)'&> /dev/null;then \
 	   echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
 	fi
 
-portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
-	csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
+# portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
+#	csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o sync-hash.o tasks.o tdb.o tests.o tree.o
+
+unitdeps.dot : *scm ./utils/plot-uses
+	./utils/plot-uses todot *.scm > unitdeps.dot
+
+unitdeps.pdf : unitdeps.dot
+	dot unitdeps.dot -Tpdf -o unitdeps.pdf
+
+./utils/plot-uses : utils/plot-uses.scm
+	csc utils/plot-uses.scm
 
 # create a pdf dot graphviz diagram from notations in rmt.scm
 rmt.pdf : rmt.scm
 	grep ';;DOT' rmt.scm | sed -e 's/.*;;DOT //' > rmt.dot;dot -Tpdf rmt.dot -o rmt.pdf
 
 buildmanual:
 	cd docs/manual && make
 
-wikipage=plan
-editwiki:
-	cd docs/manual && ../../utils/editwiki $(wikipage)
-
-viewmanual:
-	arora docs/manual/megatest_manual.html
-
 targets:
 	@grep : Makefile | perl -ne '/^([A-Za-z0-9_-]+):/ && print "$$1\n"'
-
 
 unit :
 	cd tests;make unit

Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -17,11 +17,10 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 ;;======================================================================
 
 (declare (unit api))
-(declare (uses rmt))
 (declare (uses db))
 (declare (uses debugprint))
 (declare (uses dbmod))
 (declare (uses dbfile))
 (declare (uses tasks))

Index: apimod.scm
==================================================================
--- apimod.scm
+++ apimod.scm
@@ -18,17 +18,15 @@
 
 ;;======================================================================
 
 (declare (unit apimod))
 (declare (uses commonmod))
-(declare (uses ulex))
 
 (module apimod
 	*
 	
 (import scheme chicken data-structures extras)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
 (import commonmod)
-(import (prefix ulex ulex:))
 
 
 )

Index: archive.scm
==================================================================
--- archive.scm
+++ archive.scm
@@ -22,16 +22,18 @@
 (declare (uses db))
 (declare (uses debugprint))
 (declare (uses mtargs))
 (declare (uses common))
 (declare (uses commonmod))
+(declare (uses rmtmod))
 
 (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69
      format md5 message-digest srfi-18)
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 (include "common_records.scm")
 (include "db_records.scm")
 

ADDED   attic/client.scm
Index: attic/client.scm
==================================================================
--- /dev/null
+++ attic/client.scm
@@ -0,0 +1,46 @@
+
+;; Copyright 2006-2012, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+;; C L I E N T S
+;;======================================================================
+
+(declare (unit client))
+
+(declare (uses common))
+(declare (uses db))
+(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
+(declare (uses commonmod))
+
+(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
+     message-digest matchable spiffy uri-common intarweb http-client
+     spiffy-request-vars uri-common intarweb directory-utils)
+
+(import commonmod
+	debugprint)
+
+(module client
+*
+
+)
+
+(import client)
+
+(include "common_records.scm")
+(include "db_records.scm")
+

ADDED   attic/http-transport.scm
Index: attic/http-transport.scm
==================================================================
--- /dev/null
+++ attic/http-transport.scm
@@ -0,0 +1,708 @@
+
+;; Copyright 2006-2012, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+(declare (unit http-transport))
+
+(declare (uses common))
+(declare (uses debugprint))
+(declare (uses db))
+(declare (uses tests))
+(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
+(declare (uses server))
+;; (declare (uses daemon))
+(declare (uses portlogger))
+(declare (uses rmt))
+(declare (uses dbfile))
+(declare (uses commonmod))
+(declare (uses mtargs))
+
+(module http-transport
+*
+
+
+(import srfi-1 posix regex regex-case srfi-69 hostinfo md5
+	message-digest posix-extras spiffy uri-common intarweb http-client
+	spiffy-request-vars intarweb spiffy-directory-listing
+	(srfi 18) extras tcp s11n)
+
+(import scheme
+	chicken
+	
+	(prefix mtargs args:)
+	debugprint)
+
+;; Configurations for server
+(tcp-buffer-size 2048)
+(max-connections 2048) 
+
+(include "common_records.scm")
+(include "db_records.scm")
+(include "js-path.scm")
+
+(import dbfile commonmod)
+
+(require-library stml)
+(define (http-transport:make-server-url hostport)
+  (if (not hostport)
+      #f
+      (conc "http://" (car hostport) ":" (cadr hostport))))
+
+(define *server-loop-heart-beat* (current-seconds))
+
+;;======================================================================
+;; S E R V E R
+;; ======================================================================
+
+;; Call this to start the actual server
+;;
+
+(define *db:process-queue-mutex* (make-mutex))
+
+(define (http-transport:run hostn)
+  ;; Configurations for server
+  (tcp-buffer-size 2048)
+  (max-connections 2048) 
+  (debug:print 2 *default-log-port* "Attempting to start the server ...")
+  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
+	 (hostname        (get-host-name))
+	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
+					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
+					   (server:get-best-guess-address hostname)
+					   #f)))
+			    (if ipstr ipstr hostn))) ;; hostname))) 
+	 (start-port      (portlogger:open-run-close portlogger:find-port))
+	 (link-tree-path  (common:get-linktree))
+	 (tmp-area        (common:get-db-tmp-area))
+	 (start-file      (conc tmp-area "/.server-start")))
+    (debug:print-info 0 *default-log-port* "portlogger recommended port: " start-port)
+    ;; set some parameters for the server
+    (root-path     (if link-tree-path 
+		       link-tree-path
+		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
+    (handle-directory spiffy-directory-listing)
+    (handle-exception (lambda (exn chain)
+			(signal (make-composite-condition
+				 (make-property-condition 
+				  'server
+				  'message "server error")))))
+
+    ;; http-transport:handle-directory) ;; simple-directory-handler)
+    ;; Setup the web server and a /ctrl interface
+    ;;
+    (vhost-map `(((* any) . ,(lambda (continue)
+			       ;; open the db on the first call 
+				 ;; This is were we set up the database connections
+			       (let* (($   (request-vars source: 'both))
+				      (dat ($ 'dat))
+				      (res #f))
+				 (cond
+				  ((equal? (uri-path (request-uri (current-request)))
+					   '(/ "api"))
+				   (send-response body:    (api:process-request *dbstruct-dbs* $) ;; the $ is the request vars proc
+						  headers: '((content-type text/plain)))
+				   (mutex-lock! *heartbeat-mutex*)
+				   (set! *db-last-access* (current-seconds))
+				   (mutex-unlock! *heartbeat-mutex*))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ ""))
+				   (send-response body: (http-transport:main-page)))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "json_api"))
+				   (send-response body: (http-transport:main-page)))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "runs"))
+				   (send-response body: (http-transport:main-page)))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ any))
+				   (send-response body: "hey there!\n"
+						  headers: '((content-type text/plain))))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "hey"))
+				   (send-response body: "hey there!\n" 
+						  headers: '((content-type text/plain))))
+                                  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "jquery3.1.0.js"))
+				   (send-response body: (http-transport:show-jquery) 
+						  headers: '((content-type application/javascript))))
+                                  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "test_log"))
+				   (send-response body: (http-transport:html-test-log $) 
+						  headers: '((content-type text/HTML))))    
+                                  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "dashboard"))
+				   (send-response body: (http-transport:html-dboard $) 
+						  headers: '((content-type text/HTML)))) 
+				  (else (continue))))))))
+    (handle-exceptions
+	exn
+      (debug:print 0 *default-log-port* "Failed to create file " start-file ", exn=" exn)
+      (with-output-to-file start-file (lambda ()(print (current-process-id)))))
+    (http-transport:try-start-server ipaddrstr start-port)))
+
+;; This is recursively run by http-transport:run until sucessful
+;;
+(define (http-transport:try-start-server ipaddrstr portnum)
+  (let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
+	(config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes")))
+    (if (not config-use-proxy)
+	(determine-proxy (constantly #f)))
+    (debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " ipaddrsstr=" ipaddrstr " portnum=" portnum " config-hostname=" config-hostname)
+    (handle-exceptions
+	exn
+	(begin
+	  ;; (print-error-message exn)
+	  (if (< portnum 64000)
+	      (begin 
+		(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
+		(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+		(debug:print 5 *default-log-port* "exn=" (condition->list exn))
+		(portlogger:open-run-close portlogger:set-failed portnum)
+		(debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
+		(thread-sleep! 0.1)
+		
+		;; get_next_port goes here
+		(http-transport:try-start-server ipaddrstr
+						 (portlogger:open-run-close portlogger:find-port)))
+	      (begin
+		(debug:print 0 *default-log-port* "ERROR: Tried and tried but could not start the server"))))
+      ;; any error in following steps will result in a retry
+      (set! *server-info* (list ipaddrstr portnum))
+      (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
+      ;; This starts the spiffy server
+      ;; NEED WAY TO SET IP TO #f TO BIND ALL
+      ;; (start-server bind-address: ipaddrstr port: portnum)
+      (if config-hostname ;; this is a hint to bind directly
+	  (start-server port: portnum) ;; bind-address: (if (equal? config-hostname "-")
+					;;		ipaddrstr
+					;;		config-hostname))
+	  (start-server port: portnum))
+      (portlogger:open-run-close portlogger:set-port portnum "released")
+      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))
+
+;;======================================================================
+;; S E R V E R   U T I L I T I E S 
+;;======================================================================
+
+;;======================================================================
+;; C L I E N T S
+;;======================================================================
+
+(define *http-mutex* (make-mutex))
+
+;; NOTE: Large block of code from 32436b426188080f72fceb6894af541fbad9921e removed here
+;;       I'm pretty sure it is defunct.
+
+;; This next block all imported en-mass from the api branch
+(define *http-requests-in-progress* 0)
+(define *http-connections-next-cleanup* (current-seconds))
+
+(define (http-transport:get-time-to-cleanup)
+  (let ((res #f))
+    (mutex-lock! *http-mutex*)
+    (set! res (> (current-seconds) *http-connections-next-cleanup*))
+    (mutex-unlock! *http-mutex*)
+    res))
+
+(define (http-transport:inc-requests-count)
+  (mutex-lock! *http-mutex*)
+  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*))
+  ;; Use this opportunity to slow things down iff there are too many requests in flight
+  (if (> *http-requests-in-progress* 5)
+      (begin
+	(debug:print-info 0 *default-log-port* "Whoa there buddy, ease up...")
+	(thread-sleep! 1)))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:dec-requests-count proc) 
+  (mutex-lock! *http-mutex*)
+  (proc)
+  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:dec-requests-count-and-close-all-connections)
+  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
+  (let loop ((etime (+ (current-seconds) 5))) ;; give up in five seconds
+    (if (> *http-requests-in-progress* 0)
+	(if (> etime (current-seconds))
+	    (begin
+	      (thread-sleep! 0.05)
+	      (loop etime))
+	    (debug:print-error 0 *default-log-port* "requests still in progress after 5 seconds of waiting. I'm going to pass on cleaning up http connections"))
+	(close-all-connections!)))
+  (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:inc-requests-and-prep-to-close-all-connections)
+  (mutex-lock! *http-mutex*)
+  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))
+
+;; Send "cmd" with json payload "params" to serverdat and receive result
+;;
+(define (http-transport:client-api-send-receive run-id runremote cmd params #!key (numretries 3))
+  (assert (remote? runremote) "FATAL: http-transport:client-api-send-receive called with serverdat="serverdat)
+  (let* ((fullurl    (remote-api-req runremote))
+	 (res        (vector #f "uninitialized"))
+	 (success    #t)
+	 (sparams    (db:obj->string params transport: 'http))
+         (server-id  (remote-server-id runremote)))
+       (debug:print-info 11 *default-log-port* "cmd=" cmd " fullurl=" fullurl " server-id=" server-id " current time:" (current-seconds)) 
+
+       ;; set up the http-client here
+       (max-retry-attempts 1)
+       ;; consider all requests indempotent
+       (retry-request? (lambda (request)
+			 #f))
+       ;; send the data and get the response
+       ;; extract the needed info from the http data and 
+       ;; process and return it.
+       (let* ((send-recieve (lambda ()
+			      (mutex-lock! *http-mutex*)
+			      ;; (condition-case (with-input-from-request "http://localhost"; #f read-lines)
+			      ;;					       ((exn http client-error) e (print e)))
+			      (set! res (vector                ;;; DON'T FORGET - THIS IS THE CLIENT SIDE! NOTE: consider moving this to client.scm since we are only supporting http transport at this time.
+					 success
+					 (db:string->obj 
+					  (handle-exceptions
+					      exn
+					      (let ((call-chain (get-call-chain))
+						    (msg        ((condition-property-accessor 'exn 'message) exn)))
+						(set! success #f)
+                                                (if (debug:debug-mode 1)
+                                                    (debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
+                                                    (begin
+                                                      (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
+                                                      (debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
+                                                      (debug:print 0 *default-log-port* " cmd: " cmd " params: " params " key:" (or server-id "thekey"))
+                                                      (debug:print 0 *default-log-port* " call-chain: " call-chain)))
+						;; what if another thread is communicating ok? Can't happen due to mutex
+						(http-transport:close-connections runremote)
+						(mutex-unlock! *http-mutex*)
+						;; (close-connection! fullurl)
+						(db:obj->string #f))
+					      (with-input-from-request ;; was dat
+					       fullurl 
+					       (list (cons 'key (or server-id   "thekey"))
+						     (cons 'cmd cmd)
+						     (cons 'params sparams))
+					       read-string))
+					  transport: 'http)
+					 0)) ;; added this speculatively
+			      ;; Shouldn't this be a call to the managed call-all-connections stuff above?
+			      ;; (close-all-connections!) ;; BUG? WHY IS THIS HERE? Are we failing to reuse connections?
+			      (mutex-unlock! *http-mutex*)
+			      ))
+	      (time-out     (lambda ()
+			      (thread-sleep! 45)
+			      (debug:print 0 *default-log-port* "WARNING: send-receive took more than 45 seconds!!")
+			      #f))
+	      (th1 (make-thread send-recieve "with-input-from-request"))
+	      (th2 (make-thread time-out     "time out")))
+	 (thread-start! th1)
+	 (thread-start! th2)
+	 (thread-join! th1)
+          (vector-set! res 0 success)
+	 (thread-terminate! th2)
+	 (if (vector? res)
+	     (if (vector-ref res 0) ;; this is the first flag or the second flag? 
+                 (let* ((res-dat (vector-ref res 1)))
+                    (if (and (string? res-dat) (string-contains res-dat "server-id mismatch"))
+                     (signal (make-composite-condition
+		          (make-property-condition 
+		       'servermismatch
+		       'message  (vector-ref res 1))))       
+		      res)) ;; this is the *inner* vector? seriously? why?
+                 (if (debug:debug-mode 11)
+                     (let ((call-chain (get-call-chain))) ;; note: this code also called in nmsg-transport - consider consolidating it
+                       (print-call-chain (current-error-port))
+                       (debug:print-error 11 *default-log-port* "error above occured at server, res=" res) ;; " message: " ((condition-property-accessor 'exn 'message) exn))
+                       (debug:print 11 *default-log-port* " server call chain:")
+                       (pp (vector-ref res 1) (current-error-port))
+                       (signal (vector-ref res 0)))
+                     res))
+	     (signal (make-composite-condition
+		      (make-property-condition 
+		       'timeout
+		       'message "nmsg-transport:client-api-send-receive-raw timed out talking to server")))))))
+
+;; careful closing of connections stored in *runremote*
+;;
+(define (http-transport:close-connections runremote)
+  (if (remote? runremote)
+      (let ((api-dat (remote-api-uri runremote)))
+	(handle-exceptions
+	    exn
+	  (begin
+	    (print-call-chain *default-log-port*)
+	    (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
+	  (if (args:any-defined? "-server" "-execute" "-run")
+	      (debug:print-info 0 *default-log-port* "Closing connections to "api-dat))
+	  (if api-dat (close-connection! api-dat))
+
+	  ;; Would it be better to set *runremote* to #f? I don't think so. But we may
+	  ;; need to clear more of the runremote fields
+	  (remote-api-url-set! runremote #f) ;; used as a flag for connection up and running
+	  
+	  #t))
+      #f))
+
+;; run http-transport:keep-running in a parallel thread to monitor that the db is being 
+;; used and to shutdown after sometime if it is not.
+;;
+(define (http-transport:keep-running) 
+  ;; if none running or if > 20 seconds since 
+  ;; server last used then start shutdown
+  ;; This thread waits for the server to come alive
+  (debug:print-info 0 *default-log-port* "Starting the sync-back, keep alive thread in server")
+  (let* ((servinfofile      #f)
+	 (sdat              #f)
+	 (no-sync-db        (db:open-no-sync-db))
+	 (tmp-area          (common:get-db-tmp-area))
+	 (started-file      (conc tmp-area "/.server-started"))
+	 (server-start-time (current-seconds))
+	 (server-info (let loop ((start-time (current-seconds))
+				 (changed    #t)
+				 (last-sdat  "not this"))
+                        (begin ;; let ((sdat #f))
+			  (thread-sleep! 0.01)
+			  (debug:print-info 0 *default-log-port* "Waiting for server alive signature")
+                          (mutex-lock! *heartbeat-mutex*)
+                          (set! sdat *server-info*)
+                          (mutex-unlock! *heartbeat-mutex*)
+                          (if (and sdat
+				   (not changed)
+				   (> (- (current-seconds) start-time) 2))
+			      (let* ((servinfodir (server:get-servinfo-dir *toppath*)) ;; (conc *toppath*"/.servinfo"))
+				     (ipaddr      (car sdat))
+				     (port        (cadr sdat))
+				     (servinf     (conc servinfodir"/"ipaddr":"port)))
+				(set! servinfofile servinf)
+				(if (not (file-exists? servinfodir))
+				    (create-directory servinfodir #t))
+				(with-output-to-file servinf
+				  (lambda ()
+				    (let* ((serv-id (server:mk-signature)))
+				      (set! *server-id* serv-id)
+				      (print "SERVER STARTED: "ipaddr":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))
+				      (print "started: "(seconds->year-week/day-time (current-seconds))))))
+				(set! *on-exit-procs* (cons
+						       (lambda ()
+							 (delete-file* servinf))
+						       *on-exit-procs*))
+				;; put data about this server into a simple flat file host.port
+				(debug:print-info 0 *default-log-port* "Received server alive signature")
+				sdat)
+                              (begin
+				(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
+                                (sleep 4)
+				(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
+                                    (if sdat 
+				      (let* ((ipaddr  (car sdat))
+					   (port    (cadr sdat))
+					   (servinf (conc (server:get-servinfo-dir *toppath*)"/"ipaddr":"port)))
+				        (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
+				      (exit))
+                                      (exit)
+                                    )
+				    (loop start-time
+					  (equal? sdat last-sdat)
+					  sdat)))))))
+	 (iface       (car server-info))
+         (port        (cadr server-info))
+         (last-access 0)
+	 (server-timeout (server:expiration-timeout))
+	 (server-going  #f)
+	 (server-log-file (args:get-arg "-log"))) ;; always set when we are a server
+
+    (handle-exceptions
+	exn
+      (debug:print 0 *default-log-port* "Failed to create " started-file ", exn=" exn)
+      (with-output-to-file started-file (lambda ()(print (current-process-id)))))
+
+    (let loop ((count         0)
+	       (server-state 'available)
+	       (bad-sync-count 0)
+	       (start-time     (current-milliseconds)))
+
+      ;; Use this opportunity to sync the tmp db to megatest.db
+      (if (not server-going) ;; *dbstruct-dbs* 
+	  (begin
+	    (debug:print 0 *default-log-port* "SERVER: dbprep")
+	    (set! *dbstruct-dbs*  (db:setup #t)) ;;  run-id)) FIXME!!!
+	    (set! server-going #t)
+	    (debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version))) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
+	  (if (and no-sync-db
+		   (common:low-noise-print 10 "sync-all")) ;; cheesy way to reduce frequency of running sync :)
+              (begin
+		(if (common:low-noise-print 120 "sync-all-print")
+                    (debug:print 0 *default-log-port* "keep-running calling db:all-db-sync at " (time->string (seconds->local-time) "%H:%M:%S")))
+		(db:all-db-sync *dbstruct-dbs*)
+		)))
+      
+      ;; when things go wrong we don't want to be doing the various queries too often
+      ;; so we strive to run this stuff only every four seconds or so.
+      (let* ((sync-time (- (current-milliseconds) start-time))
+	    (rem-time  (quotient (- 4000 sync-time) 1000)))
+	(if (and (<= rem-time 4)
+		 (>  rem-time 0))
+	    (thread-sleep! rem-time)))
+      
+      (if (< count 1) ;; 3x3 = 9 secs aprox
+	  (loop (+ count 1) 'running bad-sync-count (current-milliseconds)))
+      
+      ;; Check that iface and port have not changed (can happen if server port collides)
+      (mutex-lock! *heartbeat-mutex*)
+      (set! sdat *server-info*)
+      (mutex-unlock! *heartbeat-mutex*)
+      
+      (if (not (equal? sdat (list iface port)))
+	  (let ((new-iface (car sdat))
+		(new-port  (cadr sdat)))
+	    (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
+	    (set! iface new-iface)
+	    (set! port  new-port)
+             (if (not *server-id*)
+		 (set! *server-id* (server:mk-signature)))
+	    (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
+	    (flush-output *default-log-port*)))
+      
+      ;; Transfer *db-last-access* to last-access to use in checking that we are still alive
+      (mutex-lock! *heartbeat-mutex*)
+      (set! last-access *db-last-access*)
+      (mutex-unlock! *heartbeat-mutex*)
+      
+      (if (common:low-noise-print 120 (conc "server running on " iface ":" port))
+	  (begin
+             (if (not *server-id*)
+		 (set! *server-id* (server:mk-signature)))
+             (debug:print 0 *default-log-port* (current-seconds) (current-directory) (current-process-id) (argv))   
+	     (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
+	     (flush-output *default-log-port*)))
+      (if (common:low-noise-print 60 "dbstats")
+	  (begin
+	    (debug:print 0 *default-log-port* "Server stats:")
+	    (db:print-current-query-stats)))
+      (let* ((hrs-since-start  (/ (- (current-seconds) server-start-time) 3600)))
+	(cond
+         ((and *server-run*
+	       (> (+ last-access server-timeout)
+		  (current-seconds)))
+          (if (common:low-noise-print 120 "server continuing")
+              (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
+	      (let ((curr-time (current-seconds)))
+		(handle-exceptions
+		    exn
+		    (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on info file " servinfofile ". Are you out of space on that disk? exn=" exn)
+		    (if (and ;; (< (- (current-seconds) server-start-time) 600) ;; run for ten minutes for experiment, 3600 thereafter
+			     (not *server-overloaded*)
+			     (file-exists? servinfofile))
+			(change-file-times servinfofile curr-time curr-time)))
+		(if (and (common:low-noise-print 120 "start new server")
+			(> *api-process-request-count* 50)) ;; if this server is kind of busy start up another
+		    (begin
+		      (debug:print-info 0 *default-log-port* "Server is busy, api-count "*api-process-request-count*", start another if possible...")
+		      (server:kind-run *toppath*)
+		      (if (> *api-process-request-count* 100)
+			  (begin
+			    (debug:print-info 0 *default-log-port* "Server is overloaded at api-count=" *api-process-request-count*", removing "servinfofile) 
+			    (delete-file* servinfofile)))))))
+          (loop 0 server-state bad-sync-count (current-milliseconds)))
+         (else
+          (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
+          (http-transport:server-shutdown port)))))))
+
+(define (http-transport:server-shutdown port)
+  (begin
+    ;;(BB> "http-transport:server-shutdown called")
+    (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
+    ;;
+    ;; start_shutdown
+    ;;
+    (set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
+    (portlogger:open-run-close portlogger:set-port port "released")
+    (thread-sleep! 1)
+
+    ;; (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
+    ;; (debug:print-info 0 *default-log-port* "Number of cached writes   " *number-of-writes*)
+    ;; (debug:print-info 0 *default-log-port* "Average cached write time "
+    ;; 		      (if (eq? *number-of-writes* 0)
+    ;; 			  "n/a (no writes)"
+    ;; 			  (/ *writes-total-delay*
+    ;; 			     *number-of-writes*))
+    ;; 		      " ms")
+    ;; (debug:print-info 0 *default-log-port* "Number non-cached queries "  *number-non-write-queries*)
+    ;; (debug:print-info 0 *default-log-port* "Average non-cached time   "
+    ;; 		      (if (eq? *number-non-write-queries* 0)
+    ;; 			  "n/a (no queries)"
+    ;; 			  (/ *total-non-write-delay* 
+    ;; 			     *number-non-write-queries*))
+    ;; 		      " ms")
+    
+    (db:print-current-query-stats)
+    #;(common:save-pkt `((action . exit)
+                       (T      . server)
+                       (pid    . ,(current-process-id)))
+    *configdat* #t)
+
+    ;; remove .servinfo file(s) here
+    
+    (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
+    (exit)))
+
+;; all routes though here end in exit ...
+;;
+;; start_server? 
+;;
+(define (http-transport:launch)
+  ;; check the .servinfo directory, are there other servers running on this
+  ;; or another host?
+  (let* ((server-start-is-ok  (server:minimal-check *toppath*)))
+    (if (not server-start-is-ok)
+	(begin
+	  (debug:print 0 *default-log-port* "ERROR: server start not ok, exiting now.")
+	  (exit 1))))
+    
+  ;; check that a server start is in progress, pause or exit if so
+  (let* ((th2 (make-thread (lambda ()
+                             (debug:print-info 0 *default-log-port* "Server run thread started")
+                             (http-transport:run 
+                              (if (args:get-arg "-server")
+                                  (args:get-arg "-server")
+                                  "-")
+                              )) "Server run"))
+         (th3 (make-thread (lambda ()
+                             (debug:print-info 0 *default-log-port* "Server monitor thread started")
+                             (http-transport:keep-running)
+                             "Keep running"))))
+    (thread-start! th2)
+    (thread-sleep! 0.25) ;; give the server time to settle before starting the keep-running monitor.
+    (thread-start! th3)
+    (set! *didsomething* #t)
+    (thread-join! th2)
+    (exit)))
+
+;; (define (http-transport:server-signal-handler signum)
+;;   (signal-mask! signum)
+;;   (handle-exceptions
+;;    exn
+;;    (debug:print 0 *default-log-port* " ... exiting ...")
+;;    (let ((th1 (make-thread (lambda ()
+;; 			     (thread-sleep! 1))
+;; 			   "eat response"))
+;; 	 (th2 (make-thread (lambda ()
+;; 			     (debug:print-error 0 *default-log-port* "Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
+;; 			     (thread-sleep! 3) ;; give the flush three seconds to do it's stuff
+;; 			     (debug:print 0 *default-log-port* "       Done.")
+;; 			     (exit 4))
+;; 			   "exit on ^C timer")))
+;;      (thread-start! th2)
+;;      (thread-start! th1)
+;;      (thread-join! th2))))
+
+;;===============================================
+;; Java script
+;;===============================================
+(define (http-transport:show-jquery)
+  (let* ((data  (tests:readlines *java-script-lib*)))
+(string-join data "\n")))
+
+
+
+;;======================================================================
+;; web pages
+;;======================================================================
+
+(define (http-transport:html-test-log $)
+   (let* ((run-id ($ 'runid))
+         (test-item ($ 'testname))
+         (parts (string-split test-item ":"))
+         (test-name (car parts))
+             
+         (item-name (if (equal? (length parts) 1)
+             ""
+             (cadr parts))))
+  ;(print $) 
+(tests:get-test-log run-id test-name item-name)))
+
+
+(define (http-transport:html-dboard $)
+  (let* ((page ($ 'page))
+         (oup       (open-output-string)) 
+         (bdy "--------------------------")
+
+         (ret  (tests:dynamic-dboard page)))
+    (s:output-new  oup  ret)
+   (close-output-port oup)
+
+  (set! bdy   (get-output-string oup))
+     (conc "<h1>Dashboard</h1>" bdy "<br/> <br/> "  )))
+
+(define (http-transport:main-page)
+  (let ((linkpath (root-path)))
+    (conc "<head><h1>" (pathname-strip-directory *toppath*) "</h1></head>"
+	  "<body>"
+	  "Run area: " *toppath*
+	  "<h2>Server Stats</h2>"
+	  (http-transport:stats-table) 
+	  "<hr>"
+	  (http-transport:runs linkpath)
+	  "<hr>"
+	  ;; (http-transport:run-stats)
+	  "</body>"
+	  )))
+
+(define (http-transport:stats-table)
+  (mutex-lock! *heartbeat-mutex*)
+  (let ((res 
+	 (conc "<table>"
+	       ;; "<tr><td>Max cached queries</td>        <td>" *max-cache-size* "</td></tr>"
+	       "<tr><td>Number of cached writes</td>   <td>" *number-of-writes* "</td></tr>"
+	       "<tr><td>Average cached write time</td> <td>" (if (eq? *number-of-writes* 0)
+								 "n/a (no writes)"
+								 (/ *writes-total-delay*
+								    *number-of-writes*))
+	       " ms</td></tr>"
+	       "<tr><td>Number non-cached queries</td> <td>"  *number-non-write-queries* "</td></tr>"
+	       ;; "<tr><td>Average non-cached time</td>   <td>" (if (eq? *number-non-write-queries* 0)
+	       ;; 							 "n/a (no queries)"
+	       ;; 							 (/ *total-non-write-delay* 
+	       ;; 							    *number-non-write-queries*))
+	       " ms</td></tr>"
+	       "<tr><td>Last access</td><td>"              (seconds->time-string *db-last-access*) "</td></tr>"
+	       "</table>")))
+    (mutex-unlock! *heartbeat-mutex*)
+    res))
+
+(define (http-transport:runs linkpath)
+  (conc "<h3>Runs</h3>"
+	(string-intersperse
+	 (let ((files (map pathname-strip-directory (glob (conc linkpath "/*")))))
+	   (map (lambda (p)
+		  (conc "<a href=\"" p "\">" p "</a><br>"))
+		files))
+	 " ")))
+
+#;(define (http-transport:run-stats)
+  (let ((stats (open-run-close db:get-running-stats #f)))
+    (conc "<table>"
+	  (string-intersperse
+	   (map (lambda (stat)
+		  (conc "<tr><td>" (car stat) "</td><td>" (cadr stat) "</td></tr>"))
+		stats)
+	   " ")
+	  "</table>")))
+)

ADDED   attic/index-tree.scm
Index: attic/index-tree.scm
==================================================================
--- /dev/null
+++ attic/index-tree.scm
@@ -0,0 +1,61 @@
+;;======================================================================
+;; Copyright 2006-2013, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;======================================================================
+
+;;======================================================================
+;; Tests
+;;======================================================================
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
+(import (prefix sqlite3 sqlite3:))
+
+(declare (unit tests))
+(declare (uses lock-queue))
+(declare (uses db))
+(declare (uses common))
+(declare (uses items))
+(declare (uses runconfig))
+(declare (uses commonmod))
+(import commonmod)
+
+(include "common_records.scm")
+(include "key_records.scm")
+(include "db_records.scm")
+(include "run_records.scm")
+(include "test_records.scm")
+
+;; Populate the links tree with index.html files
+;;
+;;   - start from most recent tests and work towards oldest -OR-
+;;     start from deepest hierarchy and work way up
+;;   - look up tests in megatest.db
+;;   - cross-reference the tests to stats.db
+;;   - if newer than event_time in stats.db or not registered in stats.db regenerate
+;;   - run du and store in stats.db
+;;   - when all tests at that level done generate next level up index.html
+;; 
+;;     include in rollup html index.html:
+;;          sum of du
+;;          counts of PASS, FAIL, RUNNING, REMOTEHOSTSTART, LAUNCHED, CHECK etc.
+;;          overall status
+;;
+;;     include in test specific index.html:
+;;          host, uname, cpu graph, disk avail graph, steps, data
+;;          meta data, state, status, du
+;;          

ADDED   attic/lock-queue.scm
Index: attic/lock-queue.scm
==================================================================
--- /dev/null
+++ attic/lock-queue.scm
@@ -0,0 +1,258 @@
+;; Copyright 2006-2013, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+
+(use (prefix sqlite3 sqlite3:) srfi-18)
+
+(declare (unit lock-queue))
+(declare (uses common))
+(declare (uses debugprint))
+(declare (uses tasks))
+(declare (uses commonmod))
+
+(import commonmod
+	debugprint)
+
+;;======================================================================
+;; attempt to prevent overlapping updates of rollup files by queueing
+;; update requests in an sqlite db
+;;======================================================================
+
+;;======================================================================
+;; db record, <vector db path-to-db>
+;;======================================================================
+
+(define (make-lock-queue:db-dat)(make-vector 3))
+(define-inline (lock-queue:db-dat-get-db        vec)    (vector-ref  vec 0))
+(define-inline (lock-queue:db-dat-get-path      vec)    (vector-ref  vec 1))
+(define-inline (lock-queue:db-dat-set-db!       vec val)(vector-set! vec 0 val))
+(define-inline (lock-queue:db-dat-set-path!     vec val)(vector-set! vec 1 val))
+
+(define (lock-queue:delete-lock-db dbdat)
+  (let ((fname (lock-queue:db-dat-get-path dbdat)))
+    (system (conc "rm -f " fname "*"))))
+
+(define (lock-queue:open-db fname #!key (count 10))
+  (let* ((actualfname (conc fname ".lockdb"))
+	 (dbexists (common:file-exists? actualfname))
+	 (db       (sqlite3:open-database actualfname))
+	 (handler  (make-busy-timeout 136000)))
+    (if dbexists
+	(vector db actualfname)
+	(begin
+	  (handle-exceptions
+	   exn
+	   (begin
+	     (thread-sleep! 10)
+	     (if (> count 0)
+		 (lock-queue:open-db fname count: (- count 1))
+		 (vector db actualfname)))
+	   (sqlite3:with-transaction
+	    db
+	    (lambda ()
+	      (sqlite3:execute 
+	       db
+	       "CREATE TABLE IF NOT EXISTS queue (
+     	         id         INTEGER PRIMARY KEY,
+                 test_id    INTEGER,
+                 start_time INTEGER,
+                 state      TEXT,
+                 CONSTRAINT queue_constraint UNIQUE (test_id));")
+	      (sqlite3:execute
+	       db
+	       "CREATE TABLE IF NOT EXISTS runlocks (
+                 id         INTEGER PRIMARY KEY,
+                 test_id    INTEGER,
+                 run_lock   TEXT,
+                 CONSTRAINT runlock_constraint UNIQUE (run_lock));"))))))
+    (sqlite3:set-busy-handler! db handler)
+    (vector db actualfname)))
+
+(define (lock-queue:set-state dbdat test-id newstate #!key (remtries 10))
+  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200)
+  (handle-exceptions
+   exn
+   (if (> remtries 0)
+       (begin
+	 (debug:print 0 *default-log-port* "WARNING: exception on lock-queue:set-state. Trying again in 30 seconds.")
+	 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	 (thread-sleep! 30)
+	 (lock-queue:set-state dbdat test-id newstate remtries: (- remtries 1)))
+       (begin
+	 (debug:print-error 0 *default-log-port* " Failed to set lock state for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
+	 #f))
+   (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "UPDATE queue SET state=? WHERE test_id=?;"
+		    newstate
+		    test-id)))
+
+(define (lock-queue:any-younger? dbdat mystart test-id #!key (remtries 10))
+  ;; no need to wait on journal on read only queries
+  ;; (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200)
+  (handle-exceptions
+   exn
+   (if (> remtries 0)
+       (begin
+	 (debug:print 0 *default-log-port* "WARNING: exception on lock-queue:any-younger. Removing lockdb and trying again in 5 seconds.")
+	 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	 (thread-sleep! 5)
+         (lock-queue:delete-lock-db dbdat)
+	 (lock-queue:any-younger? dbdat mystart test-id remtries: (- remtries 1)))
+       (begin
+	 (debug:print-error 0 *default-log-port* " Failed to find younger locks for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
+	 #f))
+   (let ((res #f))
+     (sqlite3:for-each-row
+      (lambda (tid)
+	;; Actually this should not be needed as mystart cannot be simultaneously less than and test-id same as 
+	(if (not (equal? tid test-id)) 
+	    (set! res tid)))
+      (lock-queue:db-dat-get-db dbdat)
+      "SELECT test_id FROM queue WHERE start_time > ?;" mystart)
+     res)))
+
+(define (lock-queue:get-lock dbdat test-id #!key (count 10)(waiting-msg #f))
+  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 remove: #t waiting-msg: "lock-queue:get-lock, waiting on journal")
+  (let* ((res       #f)
+	 (db        (lock-queue:db-dat-get-db dbdat))
+	 (lckqry    (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';"))
+	 (mklckqry  (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');")))
+    (let ((result 
+	   (handle-exceptions
+	    exn
+	    (begin
+	      (debug:print 0 *default-log-port* "WARNING: failed to get queue lock. Removing lock db and returning fail") ;; Will try again in a few seconds")
+	      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	      (thread-sleep! 10)
+	      ;; (if (> count 0)	
+	      ;;  #f ;; (lock-queue:get-lock dbdat test-id count: (- count 1)) - give up on retries 
+	      ;; (begin ;; never recovered, remote the lock file and return #f, no lock obtained
+	      (lock-queue:delete-lock-db dbdat)
+	      #f)
+	    (sqlite3:with-transaction
+	     db
+	     (lambda ()
+	       (sqlite3:for-each-row (lambda (tid lockstate)
+				       (set! res (list tid lockstate)))
+				     lckqry)
+	       (if res
+		   (if (equal? (car res) test-id)
+		       #t ;; already have the lock
+		       #f)
+		   (begin
+		     (sqlite3:execute mklckqry test-id)
+		     ;; if no error handled then return #t for got the lock
+		     #t)))))))
+      (sqlite3:finalize! lckqry)
+      (sqlite3:finalize! mklckqry)
+      result)))
+
+(define (lock-queue:release-lock fname test-id #!key (count 10))
+  (let* ((dbdat (lock-queue:open-db fname)))
+    (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 "lock-queue:release-lock; waiting on journal")
+    (handle-exceptions
+     exn
+     (begin
+       (debug:print 0 *default-log-port* "WARNING: Failed to release queue lock. Will try again in few seconds")
+       (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+       (thread-sleep! (/ count 10))
+       (if (> count 0)
+	   (begin
+	     (sqlite3:finalize! (lock-queue:db-dat-get-db dbdat))
+	     (lock-queue:release-lock fname test-id count: (- count 1)))
+	   (let ((journal (conc fname "-journal")))
+	     ;; If we've tried ten times and failed there is a serious problem
+	     ;; try to remove the lock db and allow it to be recreated
+	     (handle-exceptions
+	      exn
+	      #f
+	      (if (common:file-exists? journal)(delete-file journal))
+	      (if (common:file-exists? fname)  (delete-file fname))
+	      #f))))
+     (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE test_id=?;" test-id)
+     (sqlite3:finalize! (lock-queue:db-dat-get-db dbdat)))))
+
+(define (lock-queue:steal-lock dbdat test-id #!key (count 10))
+  (debug:print-info 0 *default-log-port* "Attempting to steal lock at " (lock-queue:db-dat-get-path dbdat))
+  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 "lock-queue:steal-lock; waiting on journal")
+  (handle-exceptions
+   exn
+   (begin
+     (debug:print 0 *default-log-port* "WARNING: Failed to steal queue lock. Will try again in few seconds")
+     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+     (thread-sleep! 10)
+     (if (> count 0)
+	 (lock-queue:steal-lock dbdat test-id count: (- count 1))
+	 #f))
+   (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE run_lock='locked';"))
+  (lock-queue:get-lock dbdat test-it))
+
+;; returns #f if ok to skip the task
+;; returns #t if ok to proceed with task
+;; otherwise waits
+;;
+(define (lock-queue:wait-turn fname test-id #!key (count 10)(waiting-msg #f))
+  (let* ((dbdat   (lock-queue:open-db fname))
+	 (mystart (current-seconds))
+	 (db      (lock-queue:db-dat-get-db dbdat)))
+    ;; (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 waiting-msg: "lock-queue:wait-turn; waiting on journal file")
+    (handle-exceptions
+     exn
+     (begin
+       (debug:print 0 *default-log-port* "WARNING: Failed to find out if it is ok to skip the wait queue. Will try again in few seconds")
+       (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+       (print-call-chain (current-error-port))
+       (thread-sleep! 10)
+       (if (> count 0)
+	   (begin
+	     (sqlite3:finalize! db)
+	     (lock-queue:wait-turn fname test-id count: (- count 1)))
+	   (begin
+	     (debug:print 0 *default-log-port* "Giving up calls to lock-queue:wait-turn for test-id " test-id " at path " fname ", printing call chain")
+	     (print-call-chain (current-error-port))
+	     #f)))
+     ;; wait 10 seconds and then check to see if someone is already updating the html
+     (thread-sleep! 10)
+     (if (not (lock-queue:any-younger? dbdat mystart test-id)) ;; no processing in flight, must try to start processing
+	 (begin
+	   (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 waiting-msg: "lock-queue:wait-turn; waiting on journal file")
+	   (sqlite3:execute
+	    db
+	    "INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
+	    test-id mystart)
+	   ;; (thread-sleep! 1) ;; give other tests a chance to register
+	   (let ((result 
+		  (let loop ((younger-waiting (lock-queue:any-younger? dbdat mystart test-id)))
+		    (if younger-waiting
+			(begin
+			  ;; no need for us to wait. mark in the lock queue db as skipping
+			  ;; no point in marking anything in the queue - simply never register this
+			  ;; test as it is *covered* by a previously started update to the html file
+			  ;; (lock-queue:set-state dbdat test-id "skipping")
+			  #f) ;; let the calling process know that nothing needs to be done
+			(if (lock-queue:get-lock dbdat test-id)
+			    #t
+			    (if (> (- (current-seconds) mystart) 36000) ;; waited too long, steal the lock
+				(lock-queue:steal-lock dbdat test-id)
+				(begin
+				  (thread-sleep! 1)
+				  (loop (lock-queue:any-younger? dbdat mystart test-id)))))))))
+	     (sqlite3:finalize! db)
+	     result))))))
+	  
+            
+;; (use trace)
+;; (trace lock-queue:get-lock lock-queue:release-lock lock-queue:wait-turn lock-queue:any-younger? lock-queue:set-state)

DELETED client.scm
Index: client.scm
==================================================================
--- client.scm
+++ /dev/null
@@ -1,166 +0,0 @@
-
-;; Copyright 2006-2012, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-
-;;======================================================================
-;; C L I E N T S
-;;======================================================================
-
-(declare (unit client))
-
-(declare (uses common))
-(declare (uses db))
-(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
-(declare (uses commonmod))
-
-(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
-     message-digest matchable spiffy uri-common intarweb http-client
-     spiffy-request-vars uri-common intarweb directory-utils)
-
-(import commonmod
-	debugprint)
-
-(module client
-*
-
-)
-
-(import client)
-
-(include "common_records.scm")
-(include "db_records.scm")
-
-;; client:get-signature
-(define (client:get-signature)
-  (if *my-client-signature* *my-client-signature*
-      (let ((sig (conc (get-host-name) " " (current-process-id))))
-	(set! *my-client-signature* sig)
-	*my-client-signature*)))
-
-;; Not currently used! But, I think it *should* be used!!!
-#;(define (client:logout serverdat)
-  (let ((ok (and (socket? serverdat)
-		 (cdb:logout serverdat *toppath* (client:get-signature)))))
-    ok))
-
-;; Do all the connection work, look up the transport type and set up the
-;; connection if required.
-;;
-;; There are two scenarios. 
-;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
-;;   2. We are a run tests, list runs or other interactive process and we must figure out
-;;      *transport-type* and *runremote* from the monitor.db
-;;
-;; client:setup
-;;
-;; lookup_server, need to remove *runremote* stuff
-;;
- 
-;;(define (http-transport:server-dat-make-url runremote)
-(define (client:get-url runremote)
-  (if (and (remote-iface runremote)
-	   (remote-port  runremote))
-      (conc "http://" 
-	    (remote-iface runremote)
-	    ":"
-	    (remote-port  runremote))
-      #f))
-
-(define (client:setup areapath runremote #!key (remaining-tries 100) (failed-connects 0)(area-dat #f))
-  (mutex-lock! *rmt-mutex*)
-  (let ((res (client:setup-http areapath runremote remaining-tries: remaining-tries failed-connects: failed-connects area-dat: area-dat)))
-    (mutex-unlock! *rmt-mutex*)
-    res))
-
-(define (client:setup-http areapath runremote #!key (remaining-tries 100) (failed-connects 0))
-  (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries)
-  (server:start-and-wait areapath)
-  (if (<= remaining-tries 0)
-      (begin
-	(debug:print-error 0 *default-log-port* "failed to start or connect to server")
-	(exit 1))
-      ;;
-      ;; Alternatively here, we can get the list of candidate servers and work our way
-      ;; through them searching for a good one.
-      ;;
-      (let* ((server-dat (server:choose-server areapath 'best))) ;; list host port start-time server-id pid
-;;	     (runremote  (or area-dat *runremote*)))
-	(if (not server-dat) ;; no server found
-	    (begin
-	      (if (< remaining-tries 99)(thread-sleep! 1)) ;; obviously it needs time
-	      (client:setup-http areapath runremote remaining-tries: (- remaining-tries 1)))
-	    (match server-dat
-	      ((host port start-time server-id pid)
-	       (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
-	       (if (not runremote)
-                   (begin
-		     ;; Here we are creating a runremote where there was none or it was clobbered with #f
-		     ;;
-		     (set! runremote (make-and-init-remote))
-                     (let* ((server-info (server:check-if-running areapath)))
-		       (remote-server-info-set! runremote server-info)
-                       (if server-info
-                           (begin
-                             (remote-server-url-set! runremote (server:record->url server-info))
-                             (remote-server-id-set! runremote (server:record->id server-info)))))))
-	       ;; at this point we have a runremote
-	       (if (and host port server-id)
-		   (let* ((nada     (client:connect host port server-id runremote))
-			  (ping-res (rmt:login-no-auto-client-setup runremote)))
-		     (if ping-res
-			 (if runremote
-			     (begin
-			       (debug:print-info 2 *default-log-port* "connected to " (client:get-url runremote))
-			       runremote)
-			     (client:setup-http areapath runremote remaining-tries: (- remaining-tries 1)))
-			 (begin    ;; login failed but have a server record, clean out the record and try again
-			   (debug:print-info 0 *default-log-port* "client:setup, login unsuccessful, will attempt to start server ... ping-res=" ping-res ", server-dat=" server-dat) ;; had runid.  Fixes part of Randy;s ticket 1405717332
-			   (http-transport:close-connections runremote)
-			   (thread-sleep! 1)
-			   (client:setup-http areapath runremote remaining-tries: (- remaining-tries 1))
-			   )))
-		   (begin    ;; no server registered
-		     ;; (server:kind-run areapath)
-		     (server:start-and-wait areapath)
-		     (debug:print-info 0 *default-log-port* "client:setup, no server registered, remaining-tries=" remaining-tries)
-		     (thread-sleep! 1) ;; (+ 5 (random (- 20 remaining-tries))))  ;; give server a little time to start up, randomize a little to avoid start storms.
-		     (client:setup-http areapath runremote remaining-tries: (- remaining-tries 1)))))
-	      (else
-	       (debug:print 0 *default-log-port* "ERROR: malformed server-dat="server-dat)))))))
-
-;;
-;; connect - stored in remote-condat
-;;
-;; (define (http-transport:client-connect iface port server-id runremote)
-(define (client:connect iface port server-id runremote-in)
-  (let* ((runremote (or runremote-in
-			(make-runremote))))
-    (debug:print-info 2 *default-log-port* "Connecting to server at "iface":"port", id "server-id)
-    (let* ((api-url      (conc "http://" iface ":" port "/api"))
-	   (api-uri      (uri-reference (conc "http://" iface ":" port "/api")))
-	   (api-req      (make-request method: 'POST uri: api-uri)))
-      ;;	 (server-dat   (vector iface port api-uri api-url api-req (current-seconds) server-id)))
-      (remote-iface-set!   runremote iface)
-      (remote-port-set!    runremote port)
-      (remote-server-id-set! runremote server-id)
-      (remote-connect-time-set! runremote (current-seconds))
-      (remote-last-access-set! runremote (current-seconds))
-      (remote-api-url-set! runremote api-url)
-      (remote-api-uri-set! runremote api-uri)
-      (remote-api-req-set! runremote api-req)
-      runremote)))
-

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -18,10 +18,11 @@
 
 ;;======================================================================
 
 (declare (unit common))
 (declare (uses commonmod))
+(declare (uses rmtmod))
 (declare (uses debugprint))
 (declare (uses mtargs))
 
 (use srfi-1 data-structures posix regex-case (prefix base64 base64:)
      format dot-locking csv-xml z3 udp ;; sql-de-lite
@@ -34,10 +35,11 @@
 (use posix-extras pathname-expand files)
 
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 (include "common_records.scm")
 
 
@@ -174,11 +176,10 @@
 (define *db-cache-path*       #f)
 ;; (define *db-with-db-mutex*    (make-mutex))
 (define *db-api-call-time*    (make-hash-table)) ;; hash of command => (list of times)
 
 ;; SERVER
-(define *my-client-signature* #f)
 (define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
 (define *runremote*         #f)                ;; if set up for server communication this will hold <host port>
 ;; (define *max-cache-size*    0)
 (define *logged-in-clients* (make-hash-table))
 (define *server-id*         #f)

Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -93,10 +93,16 @@
 ;;======================================================================
 
 (include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 
+;; http - use the old http + in /tmp db
+;; tcp  - use tcp transport with inmem db
+;; nfs  - use direct to disk access (read-only)
+;;
+(define rmt:transport-mode (make-parameter 'tcp))
+
 (define (get-full-version)
   (conc megatest-version "-" megatest-fossil-hash))
 
 (define (version-signature)
   (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
@@ -111,10 +117,22 @@
 	(begin
 	  (hash-table-set! *common:denoise* key currtime)
 	  #t)
 	#f)))
 
+;; KEEP THIS ONE
+;;
+;; client:get-signature
+
+(define *my-client-signature* #f)
+
+(define (client:get-signature)
+  (if *my-client-signature* *my-client-signature*
+      (let ((sig (conc (get-host-name) " " (current-process-id))))
+	(set! *my-client-signature* sig)
+	*my-client-signature*)))
+
 ;;======================================================================
 ;; config file utils
 ;;======================================================================
 
 (define (lookup cfgdat section var)

Index: dashboard-context-menu.scm
==================================================================
--- dashboard-context-menu.scm
+++ dashboard-context-menu.scm
@@ -27,10 +27,11 @@
 (declare (uses common))
 (declare (uses commonmod))
 (declare (uses db))
 (declare (uses gutils))
 (declare (uses rmt))
+(declare (uses rmtmod))
 (declare (uses ezsteps))
 ;; (declare (uses sdb))
 ;; (declare (uses filedb))
 (declare (uses subrun))
 
@@ -46,10 +47,11 @@
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 
 (import commonmod
+	rmtmod
 	debugprint)
 
 (define (dboard:launch-testpanel run-id test-id)
   (let* ((dboardexe (common:find-local-megatest "dashboard"))
          (cmd (conc dboardexe

Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -27,14 +27,13 @@
 (declare (uses commonmod))
 (declare (uses db))
 (declare (uses gutils))
 (declare (uses rmt))
 (declare (uses ezsteps))
-;; (declare (uses sdb))
-;; (declare (uses filedb))
 (declare (uses subrun))
 (declare (uses debugprint))
+(declare (uses rmtmod))
 
 (use format fmt)
 (require-library iup)
 (import (prefix iup iup:))
 
@@ -42,10 +41,11 @@
 
 (use srfi-1 posix regex regex-case srfi-69)
 (use (prefix sqlite3 sqlite3:))
 
 (import commonmod
+	rmtmod
 	debugprint)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -35,11 +35,11 @@
 (declare (uses dashboard-context-menu))
 (declare (uses vg))
 (declare (uses subrun))
 (declare (uses mt))
 (declare (uses dbmod))
-;; (declare (uses dbmemmod))
+(declare (uses rmtmod))
 (declare (uses dbfile))
 (declare (uses commonmod))
 (declare (uses commonmod.import))
 
 (use format)
@@ -56,10 +56,11 @@
 
 (import commonmod
 	(prefix mtargs args:)
 	dbmod
 	dbfile
+	rmtmod
 	debugprint)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -29,14 +29,14 @@
 (declare (uses debugprint))
 (declare (uses dbmod))
 (declare (uses dbfile))
 (declare (uses keys))
 (declare (uses ods))
-(declare (uses client))
 (declare (uses mt))
 (declare (uses commonmod))
 (declare (uses mtargs))
+(declare (uses rmtmod))
 
 (import commonmod
 	(prefix mtargs args:))
 
 (use (srfi 18)
@@ -70,10 +70,11 @@
 (define *number-non-write-queries* 0)
 
 (import debugprint)
 (import dbmod)
 (import dbfile)
+(import rmtmod)
 
 ;; record for keeping state,status and count for doing roll-ups in
 ;; iterated tests
 ;;
 (defstruct dbr:counts

Index: dbfile.scm
==================================================================
--- dbfile.scm
+++ dbfile.scm
@@ -15,10 +15,12 @@
 ;; 
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;======================================================================
+
+(use srfi-18)
 
 (declare (unit dbfile))
 (declare (uses debugprint))
 (declare (uses commonmod))
 
@@ -27,22 +29,25 @@
 	
   (import scheme
 	  chicken
 	  data-structures
 	  extras
-	  matchable)
-  
-(import (prefix sqlite3 sqlite3:)
-	posix typed-records srfi-18 srfi-1
-	srfi-69
-	stack
-	files
-	ports
-
-	commonmod
-	debugprint
-	)
+	  matchable
+  
+	  (prefix sqlite3 sqlite3:)
+	  posix typed-records
+
+	  srfi-18
+	  srfi-1
+	  srfi-69
+	  stack
+	  files
+	  ports
+	  
+	  commonmod
+	  debugprint
+	  )
 
 ;; parameters
 ;;
 (define dbfile:testsuite-name (make-parameter #f))
 
@@ -1076,14 +1081,10 @@
 ;; call with dbinit=db:initialize-main-db
 ;;
 (define (db:open-db dbstruct run-id dbinit)
   ;; (mutex-lock! *db-open-mutex*)
   (let* ((dbdat (dbfile:open-db dbstruct run-id dbinit)))
-              #;(case (rmt:transport-mode)
-		  ((http) (dbfile:open-db dbstruct run-id dbinit))
-		  ((tcp)  (dbmod:open-db  dbstruct run-id dbinit))
-		  (else (assert #f "FATAL: rmt:transport-node not correct value"(rmt:transport-mode))))
     (set! *db-write-access* (not (dbr:dbdat-read-only dbdat)))
     ;; (mutex-unlock! *db-open-mutex*)
     dbdat))
 
 (define dbfile:db-init-proc (make-parameter #f))

Index: dcommon.scm
==================================================================
--- dcommon.scm
+++ dcommon.scm
@@ -21,19 +21,21 @@
 (declare (unit dcommon))
 
 (declare (uses gutils))
 (declare (uses db))
 (declare (uses commonmod))
+(declare (uses rmtmod))
 
 (use format)
 (require-library iup)
 (import (prefix iup iup:))
 (use canvas-draw)
 (import canvas-draw-iup)
 (use regex typed-records matchable)
 
 (import commonmod
+	rmtmod
 	debugprint)
 ;; (declare (uses synchash))
 
 (include "megatest-version.scm")
 (include "common_records.scm")

Index: diff-report.scm
==================================================================
--- diff-report.scm
+++ diff-report.scm
@@ -18,12 +18,14 @@
 
 (declare (unit diff-report))
 (declare (uses common))
 (declare (uses debugprint))
 (declare (uses rmt))
+(declare (uses rmtmod))
 (declare (uses commonmod))
 (import commonmod
+	rmtmod
 	debugprint)
          
 (include "common_records.scm")
 (use matchable)
 (use fmt)

Index: ezsteps.scm
==================================================================
--- ezsteps.scm
+++ ezsteps.scm
@@ -23,20 +23,20 @@
 (declare (uses db))
 (declare (uses common))
 (declare (uses debugprint))
 (declare (uses items))
 (declare (uses runconfig))
-;; (declare (uses sdb))
-;; (declare (uses filedb))
 (declare (uses commonmod))
+(declare (uses rmtmod))
 (declare (uses mtargs))
 
 (use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
      z3 csv typed-records pathname-expand matchable)
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")

Index: genexample.scm
==================================================================
--- genexample.scm
+++ genexample.scm
@@ -19,13 +19,15 @@
 ;;======================================================================
 
 (declare (unit genexample))
 (declare (uses mtargs))
 (declare (uses debugprint))
+(declare (uses rmtmod))
 
 (use posix regex matchable)
 (import (prefix mtargs args:)
+	rmtmod
 	debugprint)
 
 (include "db_records.scm")
 
 (define genexample:example-logpro

DELETED http-transport.scm
Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ /dev/null
@@ -1,701 +0,0 @@
-
-;; Copyright 2006-2012, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-
-(declare (unit http-transport))
-
-(declare (uses common))
-(declare (uses debugprint))
-(declare (uses db))
-(declare (uses tests))
-(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
-(declare (uses server))
-;; (declare (uses daemon))
-(declare (uses portlogger))
-(declare (uses rmt))
-(declare (uses dbfile))
-(declare (uses commonmod))
-(declare (uses mtargs))
-
-(require-extension (srfi 18) extras tcp s11n)
-
-(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
-
-(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
-
-(import (prefix mtargs args:)
-	debugprint)
-
-;; Configurations for server
-(tcp-buffer-size 2048)
-(max-connections 2048) 
-
-(include "common_records.scm")
-(include "db_records.scm")
-(include "js-path.scm")
-
-(import dbfile commonmod)
-
-(require-library stml)
-(define (http-transport:make-server-url hostport)
-  (if (not hostport)
-      #f
-      (conc "http://" (car hostport) ":" (cadr hostport))))
-
-(define *server-loop-heart-beat* (current-seconds))
-
-;;======================================================================
-;; S E R V E R
-;; ======================================================================
-
-;; Call this to start the actual server
-;;
-
-(define *db:process-queue-mutex* (make-mutex))
-
-(define (http-transport:run hostn)
-  ;; Configurations for server
-  (tcp-buffer-size 2048)
-  (max-connections 2048) 
-  (debug:print 2 *default-log-port* "Attempting to start the server ...")
-  (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
-	 (hostname        (get-host-name))
-	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
-					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
-					   (server:get-best-guess-address hostname)
-					   #f)))
-			    (if ipstr ipstr hostn))) ;; hostname))) 
-	 (start-port      (portlogger:open-run-close portlogger:find-port))
-	 (link-tree-path  (common:get-linktree))
-	 (tmp-area        (common:get-db-tmp-area))
-	 (start-file      (conc tmp-area "/.server-start")))
-    (debug:print-info 0 *default-log-port* "portlogger recommended port: " start-port)
-    ;; set some parameters for the server
-    (root-path     (if link-tree-path 
-		       link-tree-path
-		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
-    (handle-directory spiffy-directory-listing)
-    (handle-exception (lambda (exn chain)
-			(signal (make-composite-condition
-				 (make-property-condition 
-				  'server
-				  'message "server error")))))
-
-    ;; http-transport:handle-directory) ;; simple-directory-handler)
-    ;; Setup the web server and a /ctrl interface
-    ;;
-    (vhost-map `(((* any) . ,(lambda (continue)
-			       ;; open the db on the first call 
-				 ;; This is were we set up the database connections
-			       (let* (($   (request-vars source: 'both))
-				      (dat ($ 'dat))
-				      (res #f))
-				 (cond
-				  ((equal? (uri-path (request-uri (current-request)))
-					   '(/ "api"))
-				   (send-response body:    (api:process-request *dbstruct-dbs* $) ;; the $ is the request vars proc
-						  headers: '((content-type text/plain)))
-				   (mutex-lock! *heartbeat-mutex*)
-				   (set! *db-last-access* (current-seconds))
-				   (mutex-unlock! *heartbeat-mutex*))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ ""))
-				   (send-response body: (http-transport:main-page)))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "json_api"))
-				   (send-response body: (http-transport:main-page)))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "runs"))
-				   (send-response body: (http-transport:main-page)))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ any))
-				   (send-response body: "hey there!\n"
-						  headers: '((content-type text/plain))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "hey"))
-				   (send-response body: "hey there!\n" 
-						  headers: '((content-type text/plain))))
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "jquery3.1.0.js"))
-				   (send-response body: (http-transport:show-jquery) 
-						  headers: '((content-type application/javascript))))
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "test_log"))
-				   (send-response body: (http-transport:html-test-log $) 
-						  headers: '((content-type text/HTML))))    
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "dashboard"))
-				   (send-response body: (http-transport:html-dboard $) 
-						  headers: '((content-type text/HTML)))) 
-				  (else (continue))))))))
-    (handle-exceptions
-	exn
-      (debug:print 0 *default-log-port* "Failed to create file " start-file ", exn=" exn)
-      (with-output-to-file start-file (lambda ()(print (current-process-id)))))
-    (http-transport:try-start-server ipaddrstr start-port)))
-
-;; This is recursively run by http-transport:run until sucessful
-;;
-(define (http-transport:try-start-server ipaddrstr portnum)
-  (let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
-	(config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes")))
-    (if (not config-use-proxy)
-	(determine-proxy (constantly #f)))
-    (debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " ipaddrsstr=" ipaddrstr " portnum=" portnum " config-hostname=" config-hostname)
-    (handle-exceptions
-	exn
-	(begin
-	  ;; (print-error-message exn)
-	  (if (< portnum 64000)
-	      (begin 
-		(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
-		(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-		(debug:print 5 *default-log-port* "exn=" (condition->list exn))
-		(portlogger:open-run-close portlogger:set-failed portnum)
-		(debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
-		(thread-sleep! 0.1)
-		
-		;; get_next_port goes here
-		(http-transport:try-start-server ipaddrstr
-						 (portlogger:open-run-close portlogger:find-port)))
-	      (begin
-		(debug:print 0 *default-log-port* "ERROR: Tried and tried but could not start the server"))))
-      ;; any error in following steps will result in a retry
-      (set! *server-info* (list ipaddrstr portnum))
-      (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
-      ;; This starts the spiffy server
-      ;; NEED WAY TO SET IP TO #f TO BIND ALL
-      ;; (start-server bind-address: ipaddrstr port: portnum)
-      (if config-hostname ;; this is a hint to bind directly
-	  (start-server port: portnum) ;; bind-address: (if (equal? config-hostname "-")
-					;;		ipaddrstr
-					;;		config-hostname))
-	  (start-server port: portnum))
-      (portlogger:open-run-close portlogger:set-port portnum "released")
-      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))
-
-;;======================================================================
-;; S E R V E R   U T I L I T I E S 
-;;======================================================================
-
-;;======================================================================
-;; C L I E N T S
-;;======================================================================
-
-(define *http-mutex* (make-mutex))
-
-;; NOTE: Large block of code from 32436b426188080f72fceb6894af541fbad9921e removed here
-;;       I'm pretty sure it is defunct.
-
-;; This next block all imported en-mass from the api branch
-(define *http-requests-in-progress* 0)
-(define *http-connections-next-cleanup* (current-seconds))
-
-(define (http-transport:get-time-to-cleanup)
-  (let ((res #f))
-    (mutex-lock! *http-mutex*)
-    (set! res (> (current-seconds) *http-connections-next-cleanup*))
-    (mutex-unlock! *http-mutex*)
-    res))
-
-(define (http-transport:inc-requests-count)
-  (mutex-lock! *http-mutex*)
-  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*))
-  ;; Use this opportunity to slow things down iff there are too many requests in flight
-  (if (> *http-requests-in-progress* 5)
-      (begin
-	(debug:print-info 0 *default-log-port* "Whoa there buddy, ease up...")
-	(thread-sleep! 1)))
-  (mutex-unlock! *http-mutex*))
-
-(define (http-transport:dec-requests-count proc) 
-  (mutex-lock! *http-mutex*)
-  (proc)
-  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
-  (mutex-unlock! *http-mutex*))
-
-(define (http-transport:dec-requests-count-and-close-all-connections)
-  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
-  (let loop ((etime (+ (current-seconds) 5))) ;; give up in five seconds
-    (if (> *http-requests-in-progress* 0)
-	(if (> etime (current-seconds))
-	    (begin
-	      (thread-sleep! 0.05)
-	      (loop etime))
-	    (debug:print-error 0 *default-log-port* "requests still in progress after 5 seconds of waiting. I'm going to pass on cleaning up http connections"))
-	(close-all-connections!)))
-  (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
-  (mutex-unlock! *http-mutex*))
-
-(define (http-transport:inc-requests-and-prep-to-close-all-connections)
-  (mutex-lock! *http-mutex*)
-  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))
-
-;; Send "cmd" with json payload "params" to serverdat and receive result
-;;
-(define (http-transport:client-api-send-receive run-id runremote cmd params #!key (numretries 3))
-  (assert (remote? runremote) "FATAL: http-transport:client-api-send-receive called with serverdat="serverdat)
-  (let* ((fullurl    (remote-api-req runremote))
-	 (res        (vector #f "uninitialized"))
-	 (success    #t)
-	 (sparams    (db:obj->string params transport: 'http))
-         (server-id  (remote-server-id runremote)))
-       (debug:print-info 11 *default-log-port* "cmd=" cmd " fullurl=" fullurl " server-id=" server-id " current time:" (current-seconds)) 
-
-       ;; set up the http-client here
-       (max-retry-attempts 1)
-       ;; consider all requests indempotent
-       (retry-request? (lambda (request)
-			 #f))
-       ;; send the data and get the response
-       ;; extract the needed info from the http data and 
-       ;; process and return it.
-       (let* ((send-recieve (lambda ()
-			      (mutex-lock! *http-mutex*)
-			      ;; (condition-case (with-input-from-request "http://localhost"; #f read-lines)
-			      ;;					       ((exn http client-error) e (print e)))
-			      (set! res (vector                ;;; DON'T FORGET - THIS IS THE CLIENT SIDE! NOTE: consider moving this to client.scm since we are only supporting http transport at this time.
-					 success
-					 (db:string->obj 
-					  (handle-exceptions
-					      exn
-					      (let ((call-chain (get-call-chain))
-						    (msg        ((condition-property-accessor 'exn 'message) exn)))
-						(set! success #f)
-                                                (if (debug:debug-mode 1)
-                                                    (debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
-                                                    (begin
-                                                      (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
-                                                      (debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
-                                                      (debug:print 0 *default-log-port* " cmd: " cmd " params: " params " key:" (or server-id "thekey"))
-                                                      (debug:print 0 *default-log-port* " call-chain: " call-chain)))
-						;; what if another thread is communicating ok? Can't happen due to mutex
-						(http-transport:close-connections runremote)
-						(mutex-unlock! *http-mutex*)
-						;; (close-connection! fullurl)
-						(db:obj->string #f))
-					      (with-input-from-request ;; was dat
-					       fullurl 
-					       (list (cons 'key (or server-id   "thekey"))
-						     (cons 'cmd cmd)
-						     (cons 'params sparams))
-					       read-string))
-					  transport: 'http)
-					 0)) ;; added this speculatively
-			      ;; Shouldn't this be a call to the managed call-all-connections stuff above?
-			      ;; (close-all-connections!) ;; BUG? WHY IS THIS HERE? Are we failing to reuse connections?
-			      (mutex-unlock! *http-mutex*)
-			      ))
-	      (time-out     (lambda ()
-			      (thread-sleep! 45)
-			      (debug:print 0 *default-log-port* "WARNING: send-receive took more than 45 seconds!!")
-			      #f))
-	      (th1 (make-thread send-recieve "with-input-from-request"))
-	      (th2 (make-thread time-out     "time out")))
-	 (thread-start! th1)
-	 (thread-start! th2)
-	 (thread-join! th1)
-          (vector-set! res 0 success)
-	 (thread-terminate! th2)
-	 (if (vector? res)
-	     (if (vector-ref res 0) ;; this is the first flag or the second flag? 
-                 (let* ((res-dat (vector-ref res 1)))
-                    (if (and (string? res-dat) (string-contains res-dat "server-id mismatch"))
-                     (signal (make-composite-condition
-		          (make-property-condition 
-		       'servermismatch
-		       'message  (vector-ref res 1))))       
-		      res)) ;; this is the *inner* vector? seriously? why?
-                 (if (debug:debug-mode 11)
-                     (let ((call-chain (get-call-chain))) ;; note: this code also called in nmsg-transport - consider consolidating it
-                       (print-call-chain (current-error-port))
-                       (debug:print-error 11 *default-log-port* "error above occured at server, res=" res) ;; " message: " ((condition-property-accessor 'exn 'message) exn))
-                       (debug:print 11 *default-log-port* " server call chain:")
-                       (pp (vector-ref res 1) (current-error-port))
-                       (signal (vector-ref res 0)))
-                     res))
-	     (signal (make-composite-condition
-		      (make-property-condition 
-		       'timeout
-		       'message "nmsg-transport:client-api-send-receive-raw timed out talking to server")))))))
-
-;; careful closing of connections stored in *runremote*
-;;
-(define (http-transport:close-connections runremote)
-  (if (remote? runremote)
-      (let ((api-dat (remote-api-uri runremote)))
-	(handle-exceptions
-	    exn
-	  (begin
-	    (print-call-chain *default-log-port*)
-	    (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
-	  (if (args:any-defined? "-server" "-execute" "-run")
-	      (debug:print-info 0 *default-log-port* "Closing connections to "api-dat))
-	  (if api-dat (close-connection! api-dat))
-
-	  ;; Would it be better to set *runremote* to #f? I don't think so. But we may
-	  ;; need to clear more of the runremote fields
-	  (remote-api-url-set! runremote #f) ;; used as a flag for connection up and running
-	  
-	  #t))
-      #f))
-
-;; run http-transport:keep-running in a parallel thread to monitor that the db is being 
-;; used and to shutdown after sometime if it is not.
-;;
-(define (http-transport:keep-running) 
-  ;; if none running or if > 20 seconds since 
-  ;; server last used then start shutdown
-  ;; This thread waits for the server to come alive
-  (debug:print-info 0 *default-log-port* "Starting the sync-back, keep alive thread in server")
-  (let* ((servinfofile      #f)
-	 (sdat              #f)
-	 (no-sync-db        (db:open-no-sync-db))
-	 (tmp-area          (common:get-db-tmp-area))
-	 (started-file      (conc tmp-area "/.server-started"))
-	 (server-start-time (current-seconds))
-	 (server-info (let loop ((start-time (current-seconds))
-				 (changed    #t)
-				 (last-sdat  "not this"))
-                        (begin ;; let ((sdat #f))
-			  (thread-sleep! 0.01)
-			  (debug:print-info 0 *default-log-port* "Waiting for server alive signature")
-                          (mutex-lock! *heartbeat-mutex*)
-                          (set! sdat *server-info*)
-                          (mutex-unlock! *heartbeat-mutex*)
-                          (if (and sdat
-				   (not changed)
-				   (> (- (current-seconds) start-time) 2))
-			      (let* ((servinfodir (server:get-servinfo-dir *toppath*)) ;; (conc *toppath*"/.servinfo"))
-				     (ipaddr      (car sdat))
-				     (port        (cadr sdat))
-				     (servinf     (conc servinfodir"/"ipaddr":"port)))
-				(set! servinfofile servinf)
-				(if (not (file-exists? servinfodir))
-				    (create-directory servinfodir #t))
-				(with-output-to-file servinf
-				  (lambda ()
-				    (let* ((serv-id (server:mk-signature)))
-				      (set! *server-id* serv-id)
-				      (print "SERVER STARTED: "ipaddr":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))
-				      (print "started: "(seconds->year-week/day-time (current-seconds))))))
-				(set! *on-exit-procs* (cons
-						       (lambda ()
-							 (delete-file* servinf))
-						       *on-exit-procs*))
-				;; put data about this server into a simple flat file host.port
-				(debug:print-info 0 *default-log-port* "Received server alive signature")
-				sdat)
-                              (begin
-				(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
-                                (sleep 4)
-				(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
-                                    (if sdat 
-				      (let* ((ipaddr  (car sdat))
-					   (port    (cadr sdat))
-					   (servinf (conc (server:get-servinfo-dir *toppath*)"/"ipaddr":"port)))
-				        (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
-				      (exit))
-                                      (exit)
-                                    )
-				    (loop start-time
-					  (equal? sdat last-sdat)
-					  sdat)))))))
-	 (iface       (car server-info))
-         (port        (cadr server-info))
-         (last-access 0)
-	 (server-timeout (server:expiration-timeout))
-	 (server-going  #f)
-	 (server-log-file (args:get-arg "-log"))) ;; always set when we are a server
-
-    (handle-exceptions
-	exn
-      (debug:print 0 *default-log-port* "Failed to create " started-file ", exn=" exn)
-      (with-output-to-file started-file (lambda ()(print (current-process-id)))))
-
-    (let loop ((count         0)
-	       (server-state 'available)
-	       (bad-sync-count 0)
-	       (start-time     (current-milliseconds)))
-
-      ;; Use this opportunity to sync the tmp db to megatest.db
-      (if (not server-going) ;; *dbstruct-dbs* 
-	  (begin
-	    (debug:print 0 *default-log-port* "SERVER: dbprep")
-	    (set! *dbstruct-dbs*  (db:setup #t)) ;;  run-id)) FIXME!!!
-	    (set! server-going #t)
-	    (debug:print 0 *default-log-port* "SERVER: running, megatest version: " (common:get-full-version))) ;; NOTE: the server is NOT yet marked as running in the log. We do that in the keep-running routine.
-	  (if (and no-sync-db
-		   (common:low-noise-print 10 "sync-all")) ;; cheesy way to reduce frequency of running sync :)
-              (begin
-		(if (common:low-noise-print 120 "sync-all-print")
-                    (debug:print 0 *default-log-port* "keep-running calling db:all-db-sync at " (time->string (seconds->local-time) "%H:%M:%S")))
-		(db:all-db-sync *dbstruct-dbs*)
-		)))
-      
-      ;; when things go wrong we don't want to be doing the various queries too often
-      ;; so we strive to run this stuff only every four seconds or so.
-      (let* ((sync-time (- (current-milliseconds) start-time))
-	    (rem-time  (quotient (- 4000 sync-time) 1000)))
-	(if (and (<= rem-time 4)
-		 (>  rem-time 0))
-	    (thread-sleep! rem-time)))
-      
-      (if (< count 1) ;; 3x3 = 9 secs aprox
-	  (loop (+ count 1) 'running bad-sync-count (current-milliseconds)))
-      
-      ;; Check that iface and port have not changed (can happen if server port collides)
-      (mutex-lock! *heartbeat-mutex*)
-      (set! sdat *server-info*)
-      (mutex-unlock! *heartbeat-mutex*)
-      
-      (if (not (equal? sdat (list iface port)))
-	  (let ((new-iface (car sdat))
-		(new-port  (cadr sdat)))
-	    (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
-	    (set! iface new-iface)
-	    (set! port  new-port)
-             (if (not *server-id*)
-		 (set! *server-id* (server:mk-signature)))
-	    (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
-	    (flush-output *default-log-port*)))
-      
-      ;; Transfer *db-last-access* to last-access to use in checking that we are still alive
-      (mutex-lock! *heartbeat-mutex*)
-      (set! last-access *db-last-access*)
-      (mutex-unlock! *heartbeat-mutex*)
-      
-      (if (common:low-noise-print 120 (conc "server running on " iface ":" port))
-	  (begin
-             (if (not *server-id*)
-		 (set! *server-id* (server:mk-signature)))
-             (debug:print 0 *default-log-port* (current-seconds) (current-directory) (current-process-id) (argv))   
-	     (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*)
-	     (flush-output *default-log-port*)))
-      (if (common:low-noise-print 60 "dbstats")
-	  (begin
-	    (debug:print 0 *default-log-port* "Server stats:")
-	    (db:print-current-query-stats)))
-      (let* ((hrs-since-start  (/ (- (current-seconds) server-start-time) 3600)))
-	(cond
-         ((and *server-run*
-	       (> (+ last-access server-timeout)
-		  (current-seconds)))
-          (if (common:low-noise-print 120 "server continuing")
-              (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
-	      (let ((curr-time (current-seconds)))
-		(handle-exceptions
-		    exn
-		    (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on info file " servinfofile ". Are you out of space on that disk? exn=" exn)
-		    (if (and ;; (< (- (current-seconds) server-start-time) 600) ;; run for ten minutes for experiment, 3600 thereafter
-			     (not *server-overloaded*)
-			     (file-exists? servinfofile))
-			(change-file-times servinfofile curr-time curr-time)))
-		(if (and (common:low-noise-print 120 "start new server")
-			(> *api-process-request-count* 50)) ;; if this server is kind of busy start up another
-		    (begin
-		      (debug:print-info 0 *default-log-port* "Server is busy, api-count "*api-process-request-count*", start another if possible...")
-		      (server:kind-run *toppath*)
-		      (if (> *api-process-request-count* 100)
-			  (begin
-			    (debug:print-info 0 *default-log-port* "Server is overloaded at api-count=" *api-process-request-count*", removing "servinfofile) 
-			    (delete-file* servinfofile)))))))
-          (loop 0 server-state bad-sync-count (current-milliseconds)))
-         (else
-          (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
-          (http-transport:server-shutdown port)))))))
-
-(define (http-transport:server-shutdown port)
-  (begin
-    ;;(BB> "http-transport:server-shutdown called")
-    (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
-    ;;
-    ;; start_shutdown
-    ;;
-    (set! *time-to-exit* #t) ;; tell on-exit to be fast as we've already cleaned up
-    (portlogger:open-run-close portlogger:set-port port "released")
-    (thread-sleep! 1)
-
-    ;; (debug:print-info 0 *default-log-port* "Max cached queries was    " *max-cache-size*)
-    ;; (debug:print-info 0 *default-log-port* "Number of cached writes   " *number-of-writes*)
-    ;; (debug:print-info 0 *default-log-port* "Average cached write time "
-    ;; 		      (if (eq? *number-of-writes* 0)
-    ;; 			  "n/a (no writes)"
-    ;; 			  (/ *writes-total-delay*
-    ;; 			     *number-of-writes*))
-    ;; 		      " ms")
-    ;; (debug:print-info 0 *default-log-port* "Number non-cached queries "  *number-non-write-queries*)
-    ;; (debug:print-info 0 *default-log-port* "Average non-cached time   "
-    ;; 		      (if (eq? *number-non-write-queries* 0)
-    ;; 			  "n/a (no queries)"
-    ;; 			  (/ *total-non-write-delay* 
-    ;; 			     *number-non-write-queries*))
-    ;; 		      " ms")
-    
-    (db:print-current-query-stats)
-    #;(common:save-pkt `((action . exit)
-                       (T      . server)
-                       (pid    . ,(current-process-id)))
-    *configdat* #t)
-
-    ;; remove .servinfo file(s) here
-    
-    (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
-    (exit)))
-
-;; all routes though here end in exit ...
-;;
-;; start_server? 
-;;
-(define (http-transport:launch)
-  ;; check the .servinfo directory, are there other servers running on this
-  ;; or another host?
-  (let* ((server-start-is-ok  (server:minimal-check *toppath*)))
-    (if (not server-start-is-ok)
-	(begin
-	  (debug:print 0 *default-log-port* "ERROR: server start not ok, exiting now.")
-	  (exit 1))))
-    
-  ;; check that a server start is in progress, pause or exit if so
-  (let* ((th2 (make-thread (lambda ()
-                             (debug:print-info 0 *default-log-port* "Server run thread started")
-                             (http-transport:run 
-                              (if (args:get-arg "-server")
-                                  (args:get-arg "-server")
-                                  "-")
-                              )) "Server run"))
-         (th3 (make-thread (lambda ()
-                             (debug:print-info 0 *default-log-port* "Server monitor thread started")
-                             (http-transport:keep-running)
-                             "Keep running"))))
-    (thread-start! th2)
-    (thread-sleep! 0.25) ;; give the server time to settle before starting the keep-running monitor.
-    (thread-start! th3)
-    (set! *didsomething* #t)
-    (thread-join! th2)
-    (exit)))
-
-;; (define (http-transport:server-signal-handler signum)
-;;   (signal-mask! signum)
-;;   (handle-exceptions
-;;    exn
-;;    (debug:print 0 *default-log-port* " ... exiting ...")
-;;    (let ((th1 (make-thread (lambda ()
-;; 			     (thread-sleep! 1))
-;; 			   "eat response"))
-;; 	 (th2 (make-thread (lambda ()
-;; 			     (debug:print-error 0 *default-log-port* "Received ^C, attempting clean exit. Please be patient and wait a few seconds before hitting ^C again.")
-;; 			     (thread-sleep! 3) ;; give the flush three seconds to do it's stuff
-;; 			     (debug:print 0 *default-log-port* "       Done.")
-;; 			     (exit 4))
-;; 			   "exit on ^C timer")))
-;;      (thread-start! th2)
-;;      (thread-start! th1)
-;;      (thread-join! th2))))
-
-;;===============================================
-;; Java script
-;;===============================================
-(define (http-transport:show-jquery)
-  (let* ((data  (tests:readlines *java-script-lib*)))
-(string-join data "\n")))
-
-
-
-;;======================================================================
-;; web pages
-;;======================================================================
-
-(define (http-transport:html-test-log $)
-   (let* ((run-id ($ 'runid))
-         (test-item ($ 'testname))
-         (parts (string-split test-item ":"))
-         (test-name (car parts))
-             
-         (item-name (if (equal? (length parts) 1)
-             ""
-             (cadr parts))))
-  ;(print $) 
-(tests:get-test-log run-id test-name item-name)))
-
-
-(define (http-transport:html-dboard $)
-  (let* ((page ($ 'page))
-         (oup       (open-output-string)) 
-         (bdy "--------------------------")
-
-         (ret  (tests:dynamic-dboard page)))
-    (s:output-new  oup  ret)
-   (close-output-port oup)
-
-  (set! bdy   (get-output-string oup))
-     (conc "<h1>Dashboard</h1>" bdy "<br/> <br/> "  )))
-
-(define (http-transport:main-page)
-  (let ((linkpath (root-path)))
-    (conc "<head><h1>" (pathname-strip-directory *toppath*) "</h1></head>"
-	  "<body>"
-	  "Run area: " *toppath*
-	  "<h2>Server Stats</h2>"
-	  (http-transport:stats-table) 
-	  "<hr>"
-	  (http-transport:runs linkpath)
-	  "<hr>"
-	  ;; (http-transport:run-stats)
-	  "</body>"
-	  )))
-
-(define (http-transport:stats-table)
-  (mutex-lock! *heartbeat-mutex*)
-  (let ((res 
-	 (conc "<table>"
-	       ;; "<tr><td>Max cached queries</td>        <td>" *max-cache-size* "</td></tr>"
-	       "<tr><td>Number of cached writes</td>   <td>" *number-of-writes* "</td></tr>"
-	       "<tr><td>Average cached write time</td> <td>" (if (eq? *number-of-writes* 0)
-								 "n/a (no writes)"
-								 (/ *writes-total-delay*
-								    *number-of-writes*))
-	       " ms</td></tr>"
-	       "<tr><td>Number non-cached queries</td> <td>"  *number-non-write-queries* "</td></tr>"
-	       ;; "<tr><td>Average non-cached time</td>   <td>" (if (eq? *number-non-write-queries* 0)
-	       ;; 							 "n/a (no queries)"
-	       ;; 							 (/ *total-non-write-delay* 
-	       ;; 							    *number-non-write-queries*))
-	       " ms</td></tr>"
-	       "<tr><td>Last access</td><td>"              (seconds->time-string *db-last-access*) "</td></tr>"
-	       "</table>")))
-    (mutex-unlock! *heartbeat-mutex*)
-    res))
-
-(define (http-transport:runs linkpath)
-  (conc "<h3>Runs</h3>"
-	(string-intersperse
-	 (let ((files (map pathname-strip-directory (glob (conc linkpath "/*")))))
-	   (map (lambda (p)
-		  (conc "<a href=\"" p "\">" p "</a><br>"))
-		files))
-	 " ")))
-
-#;(define (http-transport:run-stats)
-  (let ((stats (open-run-close db:get-running-stats #f)))
-    (conc "<table>"
-	  (string-intersperse
-	   (map (lambda (stat)
-		  (conc "<tr><td>" (car stat) "</td><td>" (cadr stat) "</td></tr>"))
-		stats)
-	   " ")
-	  "</table>")))

DELETED index-tree.scm
Index: index-tree.scm
==================================================================
--- index-tree.scm
+++ /dev/null
@@ -1,61 +0,0 @@
-;;======================================================================
-;; Copyright 2006-2013, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-;;
-;;======================================================================
-
-;;======================================================================
-;; Tests
-;;======================================================================
-
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
-(import (prefix sqlite3 sqlite3:))
-
-(declare (unit tests))
-(declare (uses lock-queue))
-(declare (uses db))
-(declare (uses common))
-(declare (uses items))
-(declare (uses runconfig))
-(declare (uses commonmod))
-(import commonmod)
-
-(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
-(include "run_records.scm")
-(include "test_records.scm")
-
-;; Populate the links tree with index.html files
-;;
-;;   - start from most recent tests and work towards oldest -OR-
-;;     start from deepest hierarchy and work way up
-;;   - look up tests in megatest.db
-;;   - cross-reference the tests to stats.db
-;;   - if newer than event_time in stats.db or not registered in stats.db regenerate
-;;   - run du and store in stats.db
-;;   - when all tests at that level done generate next level up index.html
-;; 
-;;     include in rollup html index.html:
-;;          sum of du
-;;          counts of PASS, FAIL, RUNNING, REMOTEHOSTSTART, LAUNCHED, CHECK etc.
-;;          overall status
-;;
-;;     include in test specific index.html:
-;;          host, uname, cpu graph, disk avail graph, steps, data
-;;          meta data, state, status, du
-;;          

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -26,10 +26,11 @@
 (declare (uses common))
 (declare (uses debugprint))
 (declare (uses commonmod))
 (declare (uses configf))
 (declare (uses db))
+(declare (uses rmtmod))
 (declare (uses ezsteps))
 (declare (uses dbfile))
 (declare (uses mtargs))
 
 (use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
@@ -37,10 +38,11 @@
 (use typed-records pathname-expand matchable)
 
 (import (prefix base64 base64:)
 	(prefix sqlite3 sqlite3:)
 	(prefix mtargs args:)
+	rmtmod
 	debugprint)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")

DELETED lock-queue.scm
Index: lock-queue.scm
==================================================================
--- lock-queue.scm
+++ /dev/null
@@ -1,258 +0,0 @@
-;; Copyright 2006-2013, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-;;
-
-(use (prefix sqlite3 sqlite3:) srfi-18)
-
-(declare (unit lock-queue))
-(declare (uses common))
-(declare (uses debugprint))
-(declare (uses tasks))
-(declare (uses commonmod))
-
-(import commonmod
-	debugprint)
-
-;;======================================================================
-;; attempt to prevent overlapping updates of rollup files by queueing
-;; update requests in an sqlite db
-;;======================================================================
-
-;;======================================================================
-;; db record, <vector db path-to-db>
-;;======================================================================
-
-(define (make-lock-queue:db-dat)(make-vector 3))
-(define-inline (lock-queue:db-dat-get-db        vec)    (vector-ref  vec 0))
-(define-inline (lock-queue:db-dat-get-path      vec)    (vector-ref  vec 1))
-(define-inline (lock-queue:db-dat-set-db!       vec val)(vector-set! vec 0 val))
-(define-inline (lock-queue:db-dat-set-path!     vec val)(vector-set! vec 1 val))
-
-(define (lock-queue:delete-lock-db dbdat)
-  (let ((fname (lock-queue:db-dat-get-path dbdat)))
-    (system (conc "rm -f " fname "*"))))
-
-(define (lock-queue:open-db fname #!key (count 10))
-  (let* ((actualfname (conc fname ".lockdb"))
-	 (dbexists (common:file-exists? actualfname))
-	 (db       (sqlite3:open-database actualfname))
-	 (handler  (make-busy-timeout 136000)))
-    (if dbexists
-	(vector db actualfname)
-	(begin
-	  (handle-exceptions
-	   exn
-	   (begin
-	     (thread-sleep! 10)
-	     (if (> count 0)
-		 (lock-queue:open-db fname count: (- count 1))
-		 (vector db actualfname)))
-	   (sqlite3:with-transaction
-	    db
-	    (lambda ()
-	      (sqlite3:execute 
-	       db
-	       "CREATE TABLE IF NOT EXISTS queue (
-     	         id         INTEGER PRIMARY KEY,
-                 test_id    INTEGER,
-                 start_time INTEGER,
-                 state      TEXT,
-                 CONSTRAINT queue_constraint UNIQUE (test_id));")
-	      (sqlite3:execute
-	       db
-	       "CREATE TABLE IF NOT EXISTS runlocks (
-                 id         INTEGER PRIMARY KEY,
-                 test_id    INTEGER,
-                 run_lock   TEXT,
-                 CONSTRAINT runlock_constraint UNIQUE (run_lock));"))))))
-    (sqlite3:set-busy-handler! db handler)
-    (vector db actualfname)))
-
-(define (lock-queue:set-state dbdat test-id newstate #!key (remtries 10))
-  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200)
-  (handle-exceptions
-   exn
-   (if (> remtries 0)
-       (begin
-	 (debug:print 0 *default-log-port* "WARNING: exception on lock-queue:set-state. Trying again in 30 seconds.")
-	 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-	 (thread-sleep! 30)
-	 (lock-queue:set-state dbdat test-id newstate remtries: (- remtries 1)))
-       (begin
-	 (debug:print-error 0 *default-log-port* " Failed to set lock state for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
-	 #f))
-   (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "UPDATE queue SET state=? WHERE test_id=?;"
-		    newstate
-		    test-id)))
-
-(define (lock-queue:any-younger? dbdat mystart test-id #!key (remtries 10))
-  ;; no need to wait on journal on read only queries
-  ;; (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200)
-  (handle-exceptions
-   exn
-   (if (> remtries 0)
-       (begin
-	 (debug:print 0 *default-log-port* "WARNING: exception on lock-queue:any-younger. Removing lockdb and trying again in 5 seconds.")
-	 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-	 (thread-sleep! 5)
-         (lock-queue:delete-lock-db dbdat)
-	 (lock-queue:any-younger? dbdat mystart test-id remtries: (- remtries 1)))
-       (begin
-	 (debug:print-error 0 *default-log-port* " Failed to find younger locks for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
-	 #f))
-   (let ((res #f))
-     (sqlite3:for-each-row
-      (lambda (tid)
-	;; Actually this should not be needed as mystart cannot be simultaneously less than and test-id same as 
-	(if (not (equal? tid test-id)) 
-	    (set! res tid)))
-      (lock-queue:db-dat-get-db dbdat)
-      "SELECT test_id FROM queue WHERE start_time > ?;" mystart)
-     res)))
-
-(define (lock-queue:get-lock dbdat test-id #!key (count 10)(waiting-msg #f))
-  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 remove: #t waiting-msg: "lock-queue:get-lock, waiting on journal")
-  (let* ((res       #f)
-	 (db        (lock-queue:db-dat-get-db dbdat))
-	 (lckqry    (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';"))
-	 (mklckqry  (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');")))
-    (let ((result 
-	   (handle-exceptions
-	    exn
-	    (begin
-	      (debug:print 0 *default-log-port* "WARNING: failed to get queue lock. Removing lock db and returning fail") ;; Will try again in a few seconds")
-	      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-	      (thread-sleep! 10)
-	      ;; (if (> count 0)	
-	      ;;  #f ;; (lock-queue:get-lock dbdat test-id count: (- count 1)) - give up on retries 
-	      ;; (begin ;; never recovered, remote the lock file and return #f, no lock obtained
-	      (lock-queue:delete-lock-db dbdat)
-	      #f)
-	    (sqlite3:with-transaction
-	     db
-	     (lambda ()
-	       (sqlite3:for-each-row (lambda (tid lockstate)
-				       (set! res (list tid lockstate)))
-				     lckqry)
-	       (if res
-		   (if (equal? (car res) test-id)
-		       #t ;; already have the lock
-		       #f)
-		   (begin
-		     (sqlite3:execute mklckqry test-id)
-		     ;; if no error handled then return #t for got the lock
-		     #t)))))))
-      (sqlite3:finalize! lckqry)
-      (sqlite3:finalize! mklckqry)
-      result)))
-
-(define (lock-queue:release-lock fname test-id #!key (count 10))
-  (let* ((dbdat (lock-queue:open-db fname)))
-    (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 "lock-queue:release-lock; waiting on journal")
-    (handle-exceptions
-     exn
-     (begin
-       (debug:print 0 *default-log-port* "WARNING: Failed to release queue lock. Will try again in few seconds")
-       (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-       (thread-sleep! (/ count 10))
-       (if (> count 0)
-	   (begin
-	     (sqlite3:finalize! (lock-queue:db-dat-get-db dbdat))
-	     (lock-queue:release-lock fname test-id count: (- count 1)))
-	   (let ((journal (conc fname "-journal")))
-	     ;; If we've tried ten times and failed there is a serious problem
-	     ;; try to remove the lock db and allow it to be recreated
-	     (handle-exceptions
-	      exn
-	      #f
-	      (if (common:file-exists? journal)(delete-file journal))
-	      (if (common:file-exists? fname)  (delete-file fname))
-	      #f))))
-     (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE test_id=?;" test-id)
-     (sqlite3:finalize! (lock-queue:db-dat-get-db dbdat)))))
-
-(define (lock-queue:steal-lock dbdat test-id #!key (count 10))
-  (debug:print-info 0 *default-log-port* "Attempting to steal lock at " (lock-queue:db-dat-get-path dbdat))
-  (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 "lock-queue:steal-lock; waiting on journal")
-  (handle-exceptions
-   exn
-   (begin
-     (debug:print 0 *default-log-port* "WARNING: Failed to steal queue lock. Will try again in few seconds")
-     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-     (thread-sleep! 10)
-     (if (> count 0)
-	 (lock-queue:steal-lock dbdat test-id count: (- count 1))
-	 #f))
-   (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE run_lock='locked';"))
-  (lock-queue:get-lock dbdat test-it))
-
-;; returns #f if ok to skip the task
-;; returns #t if ok to proceed with task
-;; otherwise waits
-;;
-(define (lock-queue:wait-turn fname test-id #!key (count 10)(waiting-msg #f))
-  (let* ((dbdat   (lock-queue:open-db fname))
-	 (mystart (current-seconds))
-	 (db      (lock-queue:db-dat-get-db dbdat)))
-    ;; (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 waiting-msg: "lock-queue:wait-turn; waiting on journal file")
-    (handle-exceptions
-     exn
-     (begin
-       (debug:print 0 *default-log-port* "WARNING: Failed to find out if it is ok to skip the wait queue. Will try again in few seconds")
-       (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-       (print-call-chain (current-error-port))
-       (thread-sleep! 10)
-       (if (> count 0)
-	   (begin
-	     (sqlite3:finalize! db)
-	     (lock-queue:wait-turn fname test-id count: (- count 1)))
-	   (begin
-	     (debug:print 0 *default-log-port* "Giving up calls to lock-queue:wait-turn for test-id " test-id " at path " fname ", printing call chain")
-	     (print-call-chain (current-error-port))
-	     #f)))
-     ;; wait 10 seconds and then check to see if someone is already updating the html
-     (thread-sleep! 10)
-     (if (not (lock-queue:any-younger? dbdat mystart test-id)) ;; no processing in flight, must try to start processing
-	 (begin
-	   (tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 waiting-msg: "lock-queue:wait-turn; waiting on journal file")
-	   (sqlite3:execute
-	    db
-	    "INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
-	    test-id mystart)
-	   ;; (thread-sleep! 1) ;; give other tests a chance to register
-	   (let ((result 
-		  (let loop ((younger-waiting (lock-queue:any-younger? dbdat mystart test-id)))
-		    (if younger-waiting
-			(begin
-			  ;; no need for us to wait. mark in the lock queue db as skipping
-			  ;; no point in marking anything in the queue - simply never register this
-			  ;; test as it is *covered* by a previously started update to the html file
-			  ;; (lock-queue:set-state dbdat test-id "skipping")
-			  #f) ;; let the calling process know that nothing needs to be done
-			(if (lock-queue:get-lock dbdat test-id)
-			    #t
-			    (if (> (- (current-seconds) mystart) 36000) ;; waited too long, steal the lock
-				(lock-queue:steal-lock dbdat test-id)
-				(begin
-				  (thread-sleep! 1)
-				  (loop (lock-queue:any-younger? dbdat mystart test-id)))))))))
-	     (sqlite3:finalize! db)
-	     result))))))
-	  
-            
-;; (use trace)
-;; (trace lock-queue:get-lock lock-queue:release-lock lock-queue:wait-turn lock-queue:any-younger? lock-queue:set-state)

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -34,11 +34,10 @@
 (declare (uses debugprint))
 (declare (uses debugprint.import))
 (declare (uses runs))
 (declare (uses launch))
 (declare (uses server))
-(declare (uses client))
 (declare (uses tests))
 (declare (uses genexample))
 ;; (declare (uses daemon))
 
 (declare (uses db))
@@ -897,11 +896,13 @@
       ))
 
 (if (args:get-arg "-ping")
     (let* ((server-id     (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
 	   (host:port     (args:get-arg "-ping")))
-      (server:ping (or server-id host:port) #f do-exit: #t)))
+      (debug:print 0 *default-log-port* "NOT YET REIMPLEMENTED FOR TCP/INMEM") ;; bug
+      (exit)))
+      ;; (server:ping (or server-id host:port) #f do-exit: #t)))
 
 ;;======================================================================
 ;; Capture, save and manipulate environments
 ;;======================================================================
 
@@ -953,11 +954,10 @@
     (let* (;; (run-id     (args:get-arg "-run-id"))
 	   (dbfname    (args:get-arg "-db"))
 	   (tl         (launch:setup))
 	   (keys       (keys:config-get-fields *configdat*)))
       (case (rmt:transport-mode)
-	((http)(http-transport:launch))
 	((tcp)
 	 (let* ((timeout    (server:expiration-timeout)))
 	   (debug:print 0 *default-log-port* "INFO: Running using tcp method with server timeout of "timeout)
 	   (tt-server-timeout-param timeout)
 	   (if dbfname
@@ -977,10 +977,12 @@
       (set! *didsomething* #t)))
 
 (if (or (args:get-arg "-list-servers")
         (args:get-arg "-kill-servers"))
     (let ((tl (launch:setup)))
+      (debug:print 0 *default-log-port* "NOT YET REIMPLEMENTED FOR TCP/INMEM") ;; BUG
+      (exit)
       (if tl ;; all roads from here exit
 	  (let* ((servers (server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath*))
 		 (fmtstr  "~33a~22a~20a~20a~8a\n"))
             (if (not servers)
               (begin
@@ -2216,11 +2218,10 @@
 		(exit 1)))
 
 	  (if (args:get-arg "-runstep")(debug:print-info 1 *default-log-port* "Running -runstep, first change to directory " work-area))
 	  (change-directory work-area)
 	  ;; can setup as client for server mode now
-	  ;; (client:setup)
 
 	  (if (args:get-arg "-load-test-data")
 	      ;; has sub commands that are rdb:
 	      ;; DO NOT put this one into either rmt: or open-run-close
 	      (tdb:load-test-data run-id test-id))
@@ -2532,15 +2533,10 @@
     (begin
       (launch:setup)
       (rmt:import-sexpr (args:get-arg "-import-sexpr"))
       (set! *didsomething* #t)))
 
-(when (args:get-arg "-sync-brute-force")
-  (launch:setup)
-  ((server:get-bruteforce-syncer (db:setup #t) persist-until-sync: #t))
-  (set! *didsomething* #t))
-
 (if (args:get-arg "-sync-to-megatest.db")
     (let* ((duh      (launch:setup))
 	   (dbstruct (db:setup #t))
 	   (tmpdbpth (dbr:dbstruct-tmppath dbstruct))
 	   (lockfile (conc tmpdbpth ".lock"))

Index: mt.scm
==================================================================
--- mt.scm
+++ mt.scm
@@ -28,13 +28,14 @@
 (declare (uses runconfig))
 (declare (uses tests))
 (declare (uses server))
 (declare (uses runs))
 (declare (uses rmt))
-;; (declare (uses filedb))
+(declare (uses rmtmod))
 
-(import debugprint)
+(import debugprint
+	rmtmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -21,14 +21,12 @@
 (use format typed-records) ;; RADT => purpose of json format??
 
 (declare (unit rmt))
 (declare (uses debugprint))
 (declare (uses api))
-(declare (uses http-transport))
 (declare (uses commonmod))
 (declare (uses dbfile))
-;; (declare (uses dbmemmod))
 (declare (uses dbmod))
 (declare (uses tcp-transportmod))
 (include "common_records.scm")
 (declare (uses rmtmod))
 
@@ -40,15 +38,10 @@
 ;; 	dbmemmod
 	dbfile
 	dbmod
 	tcp-transportmod)
 
-;; http - use the old http + in /tmp db
-;; tcp  - use tcp transport with inmem db
-;; nfs  - use direct to disk access (read-only)
-;;
-(define rmt:transport-mode (make-parameter 'http))
 ;;
 ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
 ;;
 
 ;; generate entries for ~/.megatestrc with the following
@@ -57,24 +50,10 @@
 
 ;;======================================================================
 ;;  S U P P O R T   F U N C T I O N S
 ;;======================================================================
 
-;; if a server is either running or in the process of starting call client:setup
-;; else return #f to let the calling proc know that there is no server available
-;;
-(define (rmt:get-connection-info areapath runremote) ;; TODO: push areapath down.
-  (let* ((cinfo     (if (and (remote? runremote)
-			     (remote-api-url runremote)) ;; we have a connection
-			runremote
-			#f)))
-    (if cinfo
-	cinfo
-	(if (server:check-if-running areapath)
-	    (client:setup areapath runremote)
-	    #f))))
-
 (define (rmt:on-homehost? runremote)
   (let* ((hh-dat (remote-hh-dat runremote)))
     (if (pair? hh-dat)
 	(cdr hh-dat)
 	(begin
@@ -149,178 +128,11 @@
 	(set! *runremote* newremote)
 	(set! runremote newremote)))
   (let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id)))
     (tt:handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))
 	
-(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
-    ;; do all the prep locked under the rmt-mutex
-  (mutex-lock! *rmt-mutex*)
-  
-  ;; ensure we have a record for our connection for given area
-  (if (not runremote)                   ;; can remove this one. should never get here.         
-      (begin
-	(set! *runremote* (make-and-init-remote areapath))
-        (let* ((server-info (remote-server-info *runremote*))) 
-          (if server-info
-	      (begin
-		(remote-server-url-set! *runremote* (server:record->url server-info))
-		(remote-server-id-set! *runremote* (server:record->id server-info)))))  
-	(set! runremote   *runremote*))) ;; new runremote will come from this on next iteration
-
-  ;; ensure we have a homehost record
-  (if (or (not (pair? (remote-hh-dat runremote)))  ;; not on homehost
-	  (not (cdr (remote-hh-dat runremote))))   ;; not on homehost
-      (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
-      (let ((hh-data (server:choose-server areapath 'homehost)))
-	(remote-hh-dat-set! runremote (or hh-data (cons #f #f)))))
-  
-  (cond
-   ;; give up if more than 150 attempts
-   ((> attemptnum 150)
-    (debug:print 0 *default-log-port* "ERROR: 150 tries to start/connect to server. Giving up.")
-    (exit 1))
-
-   ;; readonly mode, read request-  handle it - case 2
-   ((and readonly-mode
-         (member cmd api:read-only-queries)) 
-    (mutex-unlock! *rmt-mutex*)
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case 2")
-    (rmt:open-qry-close-locally cmd 0 params)
-    )
-
-   ;; readonly mode, write request.  Do nothing, return #f
-   (readonly-mode (extras-readonly-mode *rmt-mutex* *default-log-port* cmd params))
-
-   ;; This block was for pre-emptively resetting the connection if there had been no communication for some time.
-   ;; I don't think it adds any value. If the server is not there, just fail and start a new connection.
-   ;; also, the expire-time calculation might not be correct. We want, time-since-last-server-access > (server:get-timeout)
-   ;;
-   ;; reset the connection if it has been unused too long
-   ((and runremote
-         (remote-api-url runremote)
-	 (> (current-seconds) ;; if it has been more than server-timeout seconds since last contact, close this connection and start a new on
-	    (+ (remote-last-access runremote)
-	       (remote-server-timeout runremote))))
-    (debug:print-info 0 *default-log-port* "Connection to " (remote-server-url runremote) " expired due to no accesses in " (remote-server-timeout runremote) " seconds, forcing new connection.")
-    (http-transport:close-connections runremote)
-    ;; moving this setting of runremote conndat to #f to inside the http-transport:close-connections
-    ;; (remote-conndat-set! runremote #f) ;; invalidate the connection, thus forcing a new connection.
-    (mutex-unlock! *rmt-mutex*)
-    (rmt:send-receive cmd rid params attemptnum: attemptnum))
-   
-   ;; on homehost and this is a read
-   ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
-	 (rmt:on-homehost? runremote)
-         (member cmd api:read-only-queries))   ;; this is a read
-    (mutex-unlock! *rmt-mutex*)
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case  5")
-    (rmt:open-qry-close-locally cmd 0 params))
-
-   ;; on homehost and this is a write, we already have a server
-   ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
-	 (cdr (remote-hh-dat runremote))           ;; on homehost
-         (not (member cmd api:read-only-queries))  ;; this is a write
-         (remote-server-url runremote))            ;; have a server (needed to sync written data back)
-    (mutex-unlock! *rmt-mutex*)
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case  4.1")
-    (rmt:open-qry-close-locally cmd 0 params))
-
-   ;;  on homehost, no server contact made and this is a write, passively start a server 
-   ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
-	 (cdr (remote-hh-dat runremote))           ;; have homehost
-         (not (remote-server-url runremote))       ;; no connection yet
-	 (not (member cmd api:read-only-queries))) ;; not a read-only query
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case  8")
-    (let ((server-info  (server:check-if-running *toppath*))) ;; (server:read-dotserver->url *toppath*))) ;; (server:check-if-running *toppath*))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call
-      (if server-info
-	  (begin
-            (remote-server-url-set! runremote (server:record->url server-info)) ;; the string can be consumed by the client setup if needed
-            (remote-server-id-set! runremote (server:record->id server-info)))  
-	  (if (common:force-server?)
-	      (server:start-and-wait *toppath*)
-	      (server:kind-run *toppath*)))
-      (remote-force-server-set! runremote (common:force-server?))
-      (mutex-unlock! *rmt-mutex*)
-      (debug:print-info 12 *default-log-port* "rmt:send-receive, case  8.1")
-      (rmt:open-qry-close-locally cmd 0 params)))
-
-   ;;DOT CASE9 [label="force server\nnot on homehost"];
-   ;;DOT MUTEXLOCK -> CASE9 [label="no connection\nand either require server\nor not on homehost"]; {rank=same "case 9" CASE9};
-   ;;DOT CASE9 -> "start\nserver" -> "rmt:send-receive";
-   ((or (and (remote-force-server runremote)              ;; we are forcing a server and don't yet have a connection to one
-	     (not (remote-api-url runremote)))
-	(and (not (cdr (remote-hh-dat runremote)))        ;; not on a homehost 
-	     (not (remote-api-url runremote))))           ;; and no connection
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " runremote: " (remote->alist runremote))
-    (mutex-unlock! *rmt-mutex*)
-    (if (not (server:check-if-running *toppath*)) ;; who knows, maybe one has started up?
-	(server:start-and-wait *toppath*))
-    ;; was: (remote-conndat-set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http
-    (set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http
-    (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; TODO: add back-off timeout as
-
-   ;;DOT CASE10 [label="on homehost"];
-   ;;DOT MUTEXLOCK -> CASE10 [label="server not required,\non homehost"]; {rank=same "case 10" CASE10};
-   ;;DOT CASE10 -> "rmt:open-qry-close-locally";
-   ;; all set up if get this far, dispatch the query
-   ((and (not (remote-force-server runremote))
-	 (cdr (remote-hh-dat runremote))) ;; we are on homehost
-    (mutex-unlock! *rmt-mutex*)
-    (debug:print-info 12 *default-log-port* "rmt:send-receive, case 10")
-    (rmt:open-qry-close-locally cmd (if rid rid 0) params))
-
-   ;;DOT CASE11 [label="send_receive"];
-   ;;DOT MUTEXLOCK -> CASE11 [label="else"]; {rank=same "case 11" CASE11};
-   ;;DOT CASE11 -> "rmt:send-receive" [label="call failed"];
-   ;;DOT CASE11 -> "RESULT" [label="call succeeded"];
-   ;; not on homehost, do server query
-   (else (extras-case-11 *default-log-port* runremote cmd params attemptnum rid))))
-
-;; bunch of small functions factored out of send-receive to make debug easier
-;;
-
-(define (extras-case-11 *default-log-port* runremote cmd params attemptnum rid)
-  ;; (mutex-unlock! *rmt-mutex*)
-  (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9")
-  ;; (mutex-lock! *rmt-mutex*)
-  (let* (;; (conninfo (remote-conndat runremote))
-	 (dat-in  (condition-case ;; handling here has
-			     ;; caused a lot of
-			     ;; problems. However it
-			     ;; is needed to deal with
-			     ;; attemtped
-			     ;; communication to
-			     ;; servers that have gone
-			     ;; away
-			     (http-transport:client-api-send-receive 0 runremote cmd params)
-			     ;; (http-transport:client-api-send-receive 0 conninfo cmd params runremote)
-			     ((servermismatch)  (vector #f "Server id mismatch" ))
-			     ((commfail)(vector #f "communications fail"))
-			     ((exn)(vector #f "other fail" (print-call-chain)))))
-	 (dat      (if (and (vector? dat-in) ;; ... check it is a correct size
-			    (> (vector-length dat-in) 1))
-		       dat-in
-		       (vector #f (conc "communications fail (type 2), dat-in=" dat-in))))
-	 (success  (if (vector? dat) (vector-ref dat 0) #f))
-	 (res      (if (vector? dat) (vector-ref dat 1) #f)))
-    (if (and (remote? runremote)
-	     (remote-api-url runremote)) ;; (and (vector? conninfo) (< 5 (vector-length conninfo)))
-	(remote-last-access-set! runremote (current-seconds)) ;; refresh access time
-	(begin
-	  (debug:print 0 *default-log-port* "INFO: Should not get here! runremote="(remote->alist runremote))
-	  ;; (set! conninfo #f)
-	  (http-transport:close-connections runremote)))
-    (debug:print-info 13 *default-log-port* "rmt:send-receive, case  9. runremote=" (remote->alist runremote) " dat=" dat " runremote = " runremote)
-    (mutex-unlock! *rmt-mutex*)
-    (if success ;; success only tells us that the transport was
-	;; successful, have to examine the data to see if
-	;; there was a detected issue at the other end
-	(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
-	(begin
-           (debug:print-error 0 *default-log-port* " dat=" dat) 
-           (extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params))
-	)))
+
 
 (define (rmt:print-db-stats)
   (let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
     (debug:print 18 *default-log-port* "DB Stats\n========")
     (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
@@ -398,17 +210,10 @@
 		(mutex-lock! *db-multi-sync-mutex*)
 /		(set! *db-last-access* start-time)  ;; THIS IS PROBABLY USELESS? (we are on a client)
                 (mutex-unlock! *db-multi-sync-mutex*)))))
     res))
 
-(define (rmt:send-receive-no-auto-client-setup runremote cmd run-id params)
-  (let* ((run-id   (if run-id run-id 0))
-	 (res  	   (http-transport:client-api-send-receive run-id runremote cmd params)))
-    (if (and res (vector-ref res 0))
-	(vector-ref res 1) ;;; YES!! THIS IS CORRECT!! CHANGE IT HERE, THEN CHANGE rmt:send-receive ALSO!!!
-	#f)))
-
 ;;======================================================================
 ;;
 ;; A C T U A L   A P I   C A L L S  
 ;;
 ;;======================================================================
@@ -431,18 +236,12 @@
   (rmt:send-receive 'login run-id (list *toppath* megatest-version (client:get-signature))))
 
 ;; This login does no retries under the hood - it acts a bit like a ping.
 ;; Deprecated for nmsg-transport.
 ;;
-(define (rmt:login-no-auto-client-setup runremote)
-  (rmt:send-receive-no-auto-client-setup runremote 'login 0 (list *toppath* megatest-version (client:get-signature))))
-
-;; hand off a call to one of the db:queries statements
-;; added run-id to make looking up the correct db possible 
-;;
-(define (rmt:general-call stmtname run-id . params)
-  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))
+;; (define (rmt:login-no-auto-client-setup runremote)
+;;   (rmt:send-receive-no-auto-client-setup runremote 'login 0 (list *toppath* megatest-version (client:get-signature))))
 
 
 ;; given a hostname, return a pair of cpu load and update time representing latest intelligence from tests running on that host
 (define (rmt:get-latest-host-load hostname)
   (rmt:send-receive 'get-latest-host-load 0 (list hostname)))
@@ -1034,54 +833,5 @@
 		 (tt-ro-mode-set! runremote ro-mode)
 		 (tt-ro-mode-checked-set! runremote #t)
 		 ro-mode)
 	       ro-mode))))))
 
-(define (extras-readonly-mode rmt-mutex log-port cmd params)
-  (mutex-unlock! rmt-mutex)
-  (debug:print-info 12 log-port "rmt:send-receive, case 3")
-  (debug:print 0 log-port "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
-  #f)
-
-(define (extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params)
-  (debug:print 0 *default-log-port* "WARNING: communication failed. Trying again, try num: " attemptnum)
-  (mutex-lock! *rmt-mutex*)
-  (http-transport:close-connections runremote)
-  ;; (remote-server-url-set! runremote #f)
-  (mutex-unlock! *rmt-mutex*)
-  (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9.1")
-  (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
-  
-(define (extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
-  (if (and (vector? res)
-	   (eq? (vector-length res) 2)
-	   (eq? (vector-ref res 1) 'overloaded)) ;; since we are
-						 ;; looking at the
-						 ;; data to carry the
-						 ;; error we'll use a
-						 ;; fairly obtuse
-						 ;; combo to minimise
-						 ;; the chances of
-						 ;; some sort of
-						 ;; collision.  this
-						 ;; is the case where
-						 ;; the returned data
-						 ;; is bad or the
-						 ;; server is
-						 ;; overloaded and we
-						 ;; want to ease off
-						 ;; the queries
-      (let ((wait-delay (+ attemptnum (* attemptnum 10))))
-	(debug:print 0 *default-log-port* "WARNING: server is overloaded. Delaying " wait-delay " seconds and trying call again.")
-	(mutex-lock! *rmt-mutex*)
-	(http-transport:close-connections runremote)
-	(set! *runremote* #f) ;; force starting over
-	(mutex-unlock! *rmt-mutex*)
-	(thread-sleep! wait-delay)
-	(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
-      res)) ;; All good, return res
-
-#;(set-functions rmt:send-receive                       remote-server-url-set!
-	       http-transport:close-connections	      remote-conndat-set!
-	       debug:print                            debug:print-info
-	       remote-ro-mode                         remote-ro-mode-set!
-	       remote-ro-mode-checked-set!            remote-ro-mode-checked)

Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -43,10 +43,22 @@
   (ulexdat  #f)
   )
 
 ;; hold the send-receive proc in this parameter
 (define rmtmod:send-receive #f) ;; (make-parameter #f))
+
+;;======================================================================
+;; M I S C
+;;======================================================================
+
+;; hand off a call to one of the db:queries statements
+;; added run-id to make looking up the correct db possible 
+;;
+(define (rmt:general-call stmtname run-id . params)
+  (rmtmod:send-receive 'general-call run-id (append (list stmtname run-id) params)))
+
+
 
 ;;======================================================================
 ;; import an sexpr file into the db
 ;;======================================================================
 
@@ -97,48 +109,8 @@
   (let* ((testname  (alist-ref "testname" test-rec equal?))
 	 (item-path (alist-ref "item_path" test-rec equal?)))
     (debug:print 0 *default-log-port* "   Insert test in run "run-id": "testname"/"item-path)
     (rmtmod:send-receive 'insert-test run-id test-rec)))
 
-;;======================================================================
-;; return the handle struct for sending queries to a specific database
-;;  - initializes the connection object if this is the first access
-;;    - finds the "captain" and asks who to talk to for the given dbfname
-;;    - establishes the connection to the current dbowner
-;;
-#;(define (rmt:connect alldat dbfname dbtype)
-  (let* ((ulexdat    (or (alldat-ulexdat alldat)
-			 (rmt:setup-ulex alldat))))
-    (ulex:connect ulexdat dbfname dbtype)))
-
-;; setup the remote calls
-#;(define (rmt:setup-ulex alldat)
-  (let* ((udata (ulex:setup))) ;; establish connection to ulex
-    (alldat-ulexdat-set! alldat udata)
-    ;; register all needed procs
-    (ulex:register-handler udata 'ping cmod:get-full-version)  ;; override ping with get-full-version
-    (ulex:register-handler udata 'login cmod:get-full-version) ;; force setup of the connection
-    (ulex:register-handler udata 'execute api:execute-requests)
-    udata))
-
-;; set up a connection to the current owner of the dbfile associated with rid
-;; then send the query to that dbfile owner and wait for a response.
-;;
-#;(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
-  (let* (;; (alldat   *alldat*)
-	 (areapath (alldat-areapath alldat))
-	 (dbtype   (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db"
-		       "main" "runs"))
-	 (dbfname  (if (equal? dbtype "main")
-		       "main.db"
-		       (conc rid ".db")))
-	 (dbfile   (conc areapath "/.db/" dbfname))
-	 (ulexconn (rmt:connect alldat dbfname dbtype))  ;; ulexconn is our new *runremote*, it is a dbowner struct < pdat lastrefresh >
-	 (udata    (alldat-ulexdat alldat)))
-    	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid params)))
-    ;; need to call this on the other side 
-    ;; (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
-    
-    #;(with-input-from-string
-	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid (with-output-to-string (lambda ()(serialize params))))
-       (lambda ()(deserialize)))
+
+
 )

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -27,10 +27,11 @@
 (declare (uses tests))
 (declare (uses server))
 (declare (uses mt))
 (declare (uses archive))
 (declare (uses mtargs))
+(declare (uses rmtmod))
 
 (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
      posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
      sxml-modifications matchable)
 
@@ -44,10 +45,11 @@
 
 ;; (include "debugger.scm")
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 ;; use this struct to facilitate refactoring
 ;;
 

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -22,11 +22,10 @@
 (declare (uses debugprint))
 (declare (uses common))
 (declare (uses db))
 (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
 ;; (declare (uses synchash))
-(declare (uses http-transport))
 ;;(declare (uses rpc-transport))
 (declare (uses launch))
 ;; (declare (uses daemon))
 (declare (uses mtargs))
 
@@ -665,73 +664,73 @@
     #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)))
+;; ;; 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 60 seconds.
 ;;

Index: synchash.scm
==================================================================
--- synchash.scm
+++ synchash.scm
@@ -27,11 +27,15 @@
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit synchash))
 (declare (uses db))
 (declare (uses server))
+(declare (uses rmtmod))
+
 (include "db_records.scm")
+
+(import rmtmod)
 
 (define (synchash:make)
    (make-hash-table))
 
 ;; given an alist of objects '((id obj) ...) 

Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -21,10 +21,11 @@
 (declare (unit tasks))
 (declare (uses debugprint))
 (declare (uses dbfile))
 (declare (uses db))
 (declare (uses rmt))
+(declare (uses rmtmod))
 (declare (uses common))
 (declare (uses pgdb))
 (declare (uses commonmod))
 (declare (uses mtargs))
 
@@ -31,10 +32,11 @@
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
 (import (prefix sqlite3 sqlite3:))
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 (import dbfile)
 ;; (import pgdb) ;; pgdb is a module
 

Index: tcmt.scm
==================================================================
--- tcmt.scm
+++ tcmt.scm
@@ -23,10 +23,11 @@
 ;;  2. Every five seconds check for state/status changes and print the info
 ;;
 
 (declare (uses mtargs))
 (declare (uses rmt))
+(declare (uses rmtmod))
 (declare (uses common))
 ;; (declare (uses megatest-version))
 (declare (uses commonmod))
 
 (use srfi-1 posix srfi-69 srfi-18 regex defstruct)
@@ -33,10 +34,11 @@
 
 (use trace)
 ;; (trace-call-sites #t)
 
 (import commonmod
+	rmtmod
 	(prefix mtargs args:))
 
 (include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 (include "db_records.scm")

Index: tdb.scm
==================================================================
--- tdb.scm
+++ tdb.scm
@@ -25,23 +25,24 @@
 (declare (unit tdb))
 (declare (uses debugprint))
 (declare (uses common))
 (declare (uses keys))
 (declare (uses ods))
-(declare (uses client))
 (declare (uses mt))
 (declare (uses db))
 (declare (uses commonmod))
 (declare (uses mtargs))
+(declare (uses rmtmod))
 
 (require-extension (srfi 18) extras tcp)
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
 (import (prefix sqlite3 sqlite3:))
 (import (prefix base64 base64:))
 
 (import commonmod
 	debugprint
+	rmtmod
 	(prefix mtargs args:))
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")

Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -21,29 +21,27 @@
 ;;======================================================================
 ;; Tests
 ;;======================================================================
 
 (declare (unit tests))
-(declare (uses lock-queue))
 (declare (uses db))
 (declare (uses tdb))
 (declare (uses debugprint))
 (declare (uses common))
 (declare (uses commonmod))
-;; (declare (uses dcommon)) ;; needed for the steps processing
 (declare (uses items))
 (declare (uses runconfig))
-;; (declare (uses sdb))
 (declare (uses server))
-;;(declare (uses stml2))
 (declare (uses mtargs))
+(declare (uses rmtmod))
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
 (import (prefix sqlite3 sqlite3:))
 (import commonmod
 	(prefix mtargs args:)
-	debugprint)
+	debugprint
+	rmtmod)
 (require-library stml)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")

DELETED ulex.scm
Index: ulex.scm
==================================================================
--- ulex.scm
+++ /dev/null
@@ -1,24 +0,0 @@
-;;======================================================================
-;; Copyright 2019, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-
-;;======================================================================
-
-(declare (unit ulex))
-(declare (uses pkts))
-
-(include "ulex/ulex.scm")

ADDED   utils/plot-uses.scm
Index: utils/plot-uses.scm
==================================================================
--- /dev/null
+++ utils/plot-uses.scm
@@ -0,0 +1,143 @@
+#!/mfs/pkgs/chicken/4.8.0.5/bin/csi -nbq
+
+;;  Copyright 2006-2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+
+;; Coming soon (right?) Usage: plot-code file1.scm,file2.scm "fun1,fun2,x*" *.scm > plot.dot
+;; Usage: plot-code file1.scm,file2.scm *.scm > plot.dot
+;;        dot -Tpdf plot.dot > plot.pdf
+;; first param is comma separated list of files to include in the map, use - to do all
+;; second param is list of regexs for functions to include in the map
+;; third param is list of files to scan
+
+(module plot-uses
+	*
+
+(import scheme chicken)
+
+(use regex srfi-69 srfi-13)
+(use matchable data-structures ports extras)
+
+(define unituses-rx (regexp "^\\(declare \\((unit|uses) ([^\\(\\)]+)\\).*"))
+
+(define (print-err . data)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (apply print data))))
+
+(define (process-file fname)
+  (with-input-from-file fname
+    (lambda ()
+      (let loop ((modname "DUMMYMOD"))
+	(let* ((inl (read-line)))
+	  (if (eof-object? inl)
+	      #t
+	      (match (string-search unituses-rx inl)
+ 	         ((_ dtype unitname)
+		  (if (equal? dtype "unit")
+		      (loop unitname)
+		      (begin
+			(if (equal? dtype "uses")
+			    (if (not (member modname '("DUMMYMOD")))
+				(print "  \""unitname"\" -> \""modname"\";"))
+			    (print-err "ERROR: bad declare line \""inl"\""))
+			(loop modname))))
+		 (else
+		  (loop modname)))))))))
+
+(define (main)
+  (match (command-line-arguments)
+    (("todot" . files)
+     (print-err "Making graph for files: " (string-intersperse files ", "))
+     (print "digraph uses_unit {")
+     (for-each
+      (lambda (fname)
+	(print "// Filename: "fname)
+	(process-file fname))
+      files)
+     (print "}"))
+    (else
+     (print-err "Usage: plot-uses file1.scm ..."))))
+
+(main)
+
+)
+;; 
+;; ;; Gather the usages
+;; (print "digraph G {")
+;; (define curr-cluster-num 0)
+;; (define function-calls '())
+;; 
+;; (for-each
+;;  (lambda (fname)
+;;    (let ((last-func #f))
+;;      (print-err "Processing file " fname)
+;;      (print "subgraph cluster_" curr-cluster-num " {")
+;;      (set! curr-cluster-num (+ curr-cluster-num 1))
+;;      (with-input-from-file fname
+;;        (lambda ()
+;; 	 (with-output-to-port (current-error-port)
+;; 	   (lambda ()
+;; 	     (print "Analyzing file " fname)))
+;; 	 (print "label=\"" fname "\";")
+;; 	 (let loop ((inl    (read-line))
+;; 		    (fnname "toplevel")
+;; 		    (allcalls '()))
+;; 	   (if (eof-object? inl)
+;; 	       (begin
+;; 		 (set! function-calls (cons (list fnname allcalls) function-calls))
+;; 		 (for-each 
+;; 		  (lambda (call-name)
+;; 		    (hash-table-set! breadcrumbs call-name #t))
+;; 		  allcalls)
+;; 		 (print-err "function: " fnname " allcalls: " allcalls))
+;; 	       (let ((match (string-match defn-rx inl)))
+;; 		 (if match
+;; 		     (let ((func-name (cadr match)))
+;; 		       (if last-func
+;; 			   (print "\"" func-name "\" -> \"" last-func "\";")
+;; 			   (print "\"" func-name "\";"))
+;; 		       (set! last-func func-name)
+;; 		       (hash-table-set! breadcrumbs func-name #t)
+;; 		       (loop (read-line)
+;; 			     func-name
+;; 			     allcalls))
+;; 		     (let ((calls (look-for-all-calls inl fnname)))
+;; 		       (loop (read-line) fnname (append allcalls calls)))))))))
+;;      (print "}")))
+;;  targs)
+;; 
+;; (print-err "breadcrumbs: " (hash-table-keys breadcrumbs))
+;; (print-err "function-calls: " function-calls)
+;; 
+;; (for-each 
+;;  (lambda (function-call)
+;;    (print-err "function-call: " function-call)
+;;    (let ((fnname (car function-call))
+;; 	 (calls  (cadr function-call)))
+;;      (for-each
+;;       (lambda (callname)
+;; 	(print (if (hash-table-ref/default breadcrumbs callname #f) "" "// ")
+;; 	       "\"" fnname "\" -> \"" callname "\";"))
+;;       calls)))
+;;  function-calls)
+;; 
+;; (print "}")
+;; 
+;; (exit)
+;;