Index: apimod.scm
==================================================================
--- apimod.scm
+++ apimod.scm
@@ -200,10 +200,11 @@
     ;; SERVERS
     ;; ((start-server)                    (apply server:kind-run params))
     ((kill-server)                       (set! *server-run* #f))
     ((get-server)                        (api:start-server dbstruct params))
     ((register-server)                   (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
+    ((deregister-server)                 (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
 
     ;; TESTS
 
     ;;((test-set-state-status-by-id)     (apply mt:test-set-state-status-by-id dbstruct params))
     ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.

Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -228,17 +228,15 @@
 (define *heartbeat-mutex*   (make-mutex))
 (define *api-process-request-count* 0)
 (define *max-api-process-requests* 0)
 (define *server-overloaded*  #f)
 (define *writes-total-delay*  0)
+(define *unclean-shutdown*  #t) ;; flag to clear on clean shutdown
 
 ;; client
 (define *rmt-mutex*         (make-mutex))     ;; remote access calls mutex 
 
-;; RPC transport
-(define *rpc:listener*      #f)
-
 ;; KEY info
 ;; (define *target*            (make-hash-table)) ;; cache the target here; target is keyval1/keyval2/.../keyvalN
 (define *keys*              (make-hash-table)) ;; cache the keys here
 (define *keyvals*           (make-hash-table))
 (define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
@@ -3649,11 +3647,11 @@
 (define (server:expiration-timeout)
   (let ((tmo (configf:lookup *configdat* "server" "timeout")))
     (if (and (string? tmo)
 	     (common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
         (* 3600 (string->number tmo))
-	600))) ;; default is ten minutes
+	60))) ;; default is one minute
 
 (define (runs:get-mt-env-alist run-id runname target testname itempath)
   ;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
   `(("MT_TEST_NAME"     . ,testname)
     

Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -252,11 +252,11 @@
 		  (db:get-iam-server-lock dbh dbfile))))
 
 (define (db:with-lock-db dbfile proc)
   (let* ((dbh (db:open-run-db dbfile db:initialize-db))
 	 (res (proc dbh dbfile)))
-    (sqlite3:finalize! dbh)
+    ;; (sqlite3:finalize! dbh)
     res))
 
 ;; called before db is open?
 ;;
 (define (db:get-iam-server-lock dbh dbfname)
@@ -421,18 +421,19 @@
 	 (db          (dbr:dbdat-db dbdat))
 	 (inmem       (dbr:dbdat-inmem dbdat))
 	 (start-t     (current-seconds))
 	 (last-update (dbr:dbdat-last-write dbdat))
 	 (last-sync   (dbr:dbdat-last-sync dbdat)))
-    (debug:print-info 4 *default-log-port* "Syncing for dbfile: " dbfile)
+    (debug:print-info 0 *default-log-port* "Syncing for dbfile: "dbfile", last-update: "last-update", last-sync: "last-sync)
     (mutex-lock! *db-multi-sync-mutex*)
-    (let* ((update_info (cons (if force-sync 0 last-update) "last_update"))
+    (let* ((update_info (cons "last_update" (if force-sync 0 last-update))) ;;  "last_update"))
     	   (need-sync   (or force-sync (>= last-update last-sync))))
        (if need-sync
-	  (db:sync-tables (db:sync-all-tables-list) update_info inmem db)
+	   (begin
+	     (db:sync-tables (db:sync-all-tables-list) update_info inmem db)
+	     (dbr:dbdat-last-sync-set! dbdat start-t))
 	  (debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))
-    (dbr:dbdat-last-sync-set! dbdat start-t)
     (mutex-unlock! *db-multi-sync-mutex*)))
 
 ;; TODO: Add final sync to this
 ;;
 (define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
@@ -649,17 +650,24 @@
   (let* ((tablename        (car tabledat))
 	 (fields           (cdr tabledat))
 	 (has-last-update  (member "last_update" fields))
 	 (use-last-update  (cond
 			    ((and has-last-update
-				  (member "last_update" fields))
+				  (number? last-update))
 			     #t) ;; if given a number, just use it for all fields
-			    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
 			    ((and (pair? last-update)
 				  (member (car last-update)    ;; last-update field name
 					  (map car fields)))
 			     #t)
+			    ((and (pair? last-update)
+				  (not (number? (cdr last-update))))
+			     (debug:print 0 *default-log-port* "ERROR: parameter last-update malformed. last-update="last-update)
+			     #f)
+			    ((and (pair? last-update)
+				  (string? (car last-update))) ;; valid format, field not recognised
+			     #f)
+			    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
 			    (last-update
 			     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update);; found in fields
 			     #f)
 			    (else
 			     #f)))
@@ -798,11 +806,11 @@
        (lambda (dat)
 	 (let ((tblname (car dat))
 	       (count   (cdr dat)))
 	   (set! tot-count (+ tot-count count))
 	   (if (> count 0)
-	       (if should-print (debug:print 0 *default-log-port* (format #f "    ~10a ~5a" tblname count))))))
+	       (if should-print (debug:print 0 *default-log-port* "   "tblname" "count))))) ;; (format #f "    ~10a ~5a" tblname count))))))
        (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
     tot-count))
 
 (define (db:patch-schema-rundb frundb)
   ;;
@@ -5536,10 +5544,30 @@
 		#f) ;; server already registered
 	      (begin
 		(sqlite3:execute db "INSERT INTO servers (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
 				 host port servkey pid ipaddr apath dbname)
 		(db:get-server-info dbstruct apath dbname)))))))))
+  
+;; run this one in a transaction where first check if host:port is taken
+(define (db:deregister-server dbstruct host port servkey pid ipaddr apath dbname)
+  (db:with-db
+   dbstruct
+   #f #f
+   (lambda (db)
+     (sqlite3:with-transaction
+      db
+      (lambda ()
+	(let* ((sinfo      (db:get-server-info dbstruct apath dbname)))
+	  (if (not sinfo)
+	      (begin
+		(debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port)
+		#f) ;; server already deregistered
+	      (begin
+		(sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
+				 ;; host port servkey pid ipaddr
+				 apath dbname)
+		#;(db:get-server-info dbstruct apath dbname)))))))))
   
 (define (db:get-server-info dbstruct apath dbname)
   (db:with-db
    dbstruct
    #f #f

Index: docs/manual/server.dot
==================================================================
--- docs/manual/server.dot
+++ docs/manual/server.dot
@@ -17,61 +17,65 @@
 digraph G {
 
     subgraph cluster_1 {
         node [style=filled,shape=box];
 
-	check_available_queue       -> remove_entries_over_10s_old;
-	remove_entries_over_10s_old -> set_available [label="num_avail < 3"];
-	remove_entries_over_10s_old -> exit [label="num_avail > 2"];
-
-	set_available               -> delay_2s;
-	delay_2s          -> check_place_in_queue;
-
-	check_place_in_queue        -> "http:transport-launch" [label="at head"];
-	check_place_in_queue        -> exit [label="not at head"];
-
-	"client:login"              -> "server:shutdown" [label="login failed"];
-	"server:shutdown"           -> exit;	
-
-	subgraph cluster_2 {
-		"http:transport-launch"       -> "http:transport-run";
-		"http:transport-launch"       -> "http:transport-keep-running";
-
-		"http:transport-keep-running" -> "tests running?";
-		"tests running?"              -> "client:login" [label=yes];
-		"tests running?"              -> "server:shutdown" [label=no];
-		"client:login"                -> delay_5s [label="login ok"];
-		delay_5s                      -> "http:transport-keep-running";
-	}
-
-	// start_server -> "server_running?";
-	// "server_running?" -> set_available [label="no"];
-	// "server_running?" -> delay_2s [label="yes"];
-	// delay_2s -> "still_running?";
-	// "still_running?" -> ping_server [label=yes];
-	// "still_running?" -> set_available [label=no];
-	// ping_server -> exit [label=alive];
-	// ping_server -> remove_server_record [label=dead];
-	// remove_server_record -> set_available;
-	// set_available -> avail_delay [label="delay 3s"];
-	// avail_delay -> "first_in_queue?";
-	// 
-	// "first_in_queue?" -> set_running [label=yes];
-	// set_running -> get_next_port -> handle_requests;
-	// "first_in_queue?" -> "dead_entry_in_queue?" [label=no];
-	// "dead_entry_in_queue?" -> "server_running?" [label=no];
-	// "dead_entry_in_queue?" -> "remove_dead_entries" [label=yes];
-	// remove_dead_entries -> "server_running?";
-	// 
-	// handle_requests -> start_shutdown [label="no traffic\nno running tests"];
-	// handle_requests -> shutdown_request;
-	// start_shutdown -> shutdown_delay;
-	// shutdown_request -> shutdown_delay;
-	// shutdown_delay -> exit;
-	
-        label = "server:launch";
-        color=brown;
+	rmt:send-receive -> "init-*remote* if needed" -> rmt:general-open-connection ->
+	  rmt:send-receive-real;
+	
+
+//	check_available_queue       -> remove_entries_over_10s_old;
+//	remove_entries_over_10s_old -> set_available [label="num_avail < 3"];
+//	remove_entries_over_10s_old -> exit [label="num_avail > 2"];
+//
+//	set_available               -> delay_2s;
+//	delay_2s          -> check_place_in_queue;
+//
+//	check_place_in_queue        -> "http:transport-launch" [label="at head"];
+//	check_place_in_queue        -> exit [label="not at head"];
+//
+//	"client:login"              -> "server:shutdown" [label="login failed"];
+//	"server:shutdown"           -> exit;	
+//
+//	subgraph cluster_2 {
+//		"http:transport-launch"       -> "http:transport-run";
+//		"http:transport-launch"       -> "http:transport-keep-running";
+//
+//		"http:transport-keep-running" -> "tests running?";
+//		"tests running?"              -> "client:login" [label=yes];
+//		"tests running?"              -> "server:shutdown" [label=no];
+//		"client:login"                -> delay_5s [label="login ok"];
+//		delay_5s                      -> "http:transport-keep-running";
+//	}
+//
+//	// start_server -> "server_running?";
+//	// "server_running?" -> set_available [label="no"];
+//	// "server_running?" -> delay_2s [label="yes"];
+//	// delay_2s -> "still_running?";
+//	// "still_running?" -> ping_server [label=yes];
+//	// "still_running?" -> set_available [label=no];
+//	// ping_server -> exit [label=alive];
+//	// ping_server -> remove_server_record [label=dead];
+//	// remove_server_record -> set_available;
+//	// set_available -> avail_delay [label="delay 3s"];
+//	// avail_delay -> "first_in_queue?";
+//	// 
+//	// "first_in_queue?" -> set_running [label=yes];
+//	// set_running -> get_next_port -> handle_requests;
+//	// "first_in_queue?" -> "dead_entry_in_queue?" [label=no];
+//	// "dead_entry_in_queue?" -> "server_running?" [label=no];
+//	// "dead_entry_in_queue?" -> "remove_dead_entries" [label=yes];
+//	// remove_dead_entries -> "server_running?";
+//	// 
+//	// handle_requests -> start_shutdown [label="no traffic\nno running tests"];
+//	// handle_requests -> shutdown_request;
+//	// start_shutdown -> shutdown_delay;
+//	// shutdown_request -> shutdown_delay;
+//	// shutdown_delay -> exit;
+//	
+//        label = "server:launch";
+//        color=brown;
     }
 
 //     client_start_server -> start_server;
 //     handle_requests -> read_write;
 //     read_write -> handle_requests;

Index: launchmod.scm
==================================================================
--- launchmod.scm
+++ launchmod.scm
@@ -2289,13 +2289,16 @@
 	 (dbfile     (args:get-arg "-db"))
 	 (apath      *toppath*))
     (let loop ()
       (thread-sleep! 5) ;; add control / setting for this
       (if am-server
-	  (if (not  *dbstruct-db*)
+	  (if (not  *dbstruct-db*) ;; skip syncing until db is setup
 	      (loop)
-	      (db:sync-inmem->disk *dbstruct-db* *toppath* dbfile))))))
+	      (begin
+		;; (debug:print-info 0 *default-log-port* "syncing "apath" "dbfile" at "(current-seconds))
+		;; (db:sync-inmem->disk *dbstruct-db* apath dbfile)
+		(loop)))))))
   
 ;; 
 ;; (let ((dbstruct 
 ;; 	    (debug:print-info 13 *default-log-port* "after db:setup with dbstruct=" dbstruct)
 ;; 	    (cond

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -786,11 +786,11 @@
      (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
        (if targ (setenv "MT_TARGET" targ)))
      
      ;; The watchdog is to keep an eye on things like db sync etc.
      ;;
-(init-watchdog)
+;; (init-watchdog)
   
 ;;      (define (debug:debug-mode n)
 ;;        (cond
 ;;         ((and (number? *verbosity*)   ;; number number
 ;;      	 (number? n))

Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -62,10 +62,11 @@
 	;; http-client
 	;; intarweb
 	matchable
 	md5
 	message-digest
+	nanomsg
 	(prefix base64 base64:)
 	(prefix sqlite3 sqlite3:)
 	regex
 	s11n
 	;; spiffy
@@ -75,11 +76,11 @@
 	srfi-13
 	srfi-18
 	srfi-69
 	stack
 	system-information
-	tcp6
+	;; tcp6
 	typed-records
 	uri-common
 	z3
        
 	apimod
@@ -119,10 +120,11 @@
 ;;
 (defstruct servdat
   (host #f)
   (port #f)
   (uuid #f)
+  (rep  #f)
   (dbfile #f)
   (api-url #f)
   (api-uri #f)
   (api-req #f)
   (status 'starting)
@@ -243,15 +245,16 @@
 	(start-main-srv))))
 
 ;; NB// remote is a rmt:remote struct
 ;;
 (define (rmt:general-open-connection remote apath dbname #!key (num-tries 5))
-  (let ((mdbname (db:run-id->dbname #f)))
+  (let* ((mdbname (db:run-id->dbname #f))
+	 (mconn   (rmt:get-conn remote apath mdbname)))
     (cond
-     ((not (rmt:get-conn remote apath mdbname)) ;; no channel open to main? 
+     ((or (not mconn) ;; no channel open to main?
+	  (< (rmt:conn-expires mconn)(+ (current-seconds) 2))) ;; restablish connection if less than 2 seconds on the lease
       (rmt:open-main-connection remote apath)
-      (thread-sleep! 2)
       (rmt:general-open-connection remote apath mdbname))
      ((not (rmt:get-conn remote apath dbname))                 ;; no channel open to dbname?     
       (let* ((res (rmt:send-receive-real remote apath mdbname 'get-server `(,apath ,dbname))))
 	(case res
 	  ((server-started)
@@ -262,14 +265,39 @@
 	       (begin
 		 (debug:print-error 0 *default-log-port* "Failed to start servers needed or open channel to "apath", "dbname)
 		 (exit 1))))
 	  (else
 	   (if (list? res) ;; server has been registered and the info was returned. pass it on.
-	       res
+	       (begin ;;  ("192.168.0.9" 53817
+		      ;;  "5e34239f48e8973b3813221e54701a01" "24310"
+		      ;;  "192.168.0.9"
+		      ;;  "/home/matt/data/megatest/tests/simplerun"
+		 ;;  ".db/1.db")
+		 (match
+		  res
+		  ((host port servkey pid ipaddr apath dbname)
+		   (debug:print-info 0 *default-log-port* "got "res)
+		   (hash-table-set! (rmt:remote-conns remote)
+				    dbname
+				    (make-rmt:conn
+				     apath: apath
+				     dbname: dbname
+				     hostport: (conc host":"port)
+				     ipaddr: ipaddr
+				     port: port
+				     srvkey: servkey
+				     lastmsg: (current-seconds)
+				     expires: (+ (current-seconds) 60))))
+		  (else
+		   (debug:print-info 0 *default-log-port* "return data from starting server did not match host port servkey pid ipaddr apath dbname " res)))
+		 res)
 	       (begin
 		 (debug:print-info 0 *default-log-port* "Unexpected result: " res)
-		 res)))))))))
+		 res))))))
+     
+
+     )))
 
 ;;======================================================================
 
 
 ;; Defaults to current area
@@ -293,31 +321,19 @@
 ;; sometime in the future
 ;;
 (define (rmt:send-receive-real remote apath dbname cmd params)
   (let* ((conn (rmt:get-conn remote apath dbname)))
     (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
-    (pp (rmt:conn->alist conn))
-    ;; (rmt:send-receive-setup conn)
-    (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
-				     (rmt:conn-port conn))))
-      (let* ((key     #f)
-	     (payload `((cmd    . ,cmd)
-			(key    . ,(rmt:conn-srvkey conn))
-			(params . ,params)))
-	     (res      (begin
-			 (write payload o) ;; (rmt:conn-outport conn))
-			 (with-input-from-port
-			     i ;; (rmt:conn-inport conn)
-			   read))))
-	(close-input-port i)
-	(close-output-port o)
-	res))))
-;;  (if (string? res)
-;; 	  (string->sexpr res)
-;; 	  res))))
-
-
+    (let* ((key     #f)
+	   (host    (rmt:conn-ipaddr conn))
+	   (port    (rmt:conn-port   conn))
+	   (payload `((cmd    . ,cmd)
+		      (key    . ,(rmt:conn-srvkey conn))
+		      (params . ,params)))
+	   (res      (open-send-receive-nn (conc host":"port)
+					   (sexpr->string payload))))
+      (string->sexpr res))))
 
 ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
 ;; sometime in the future.
 ;;
 ;; Purpose - call the main.db server and request a server be started
@@ -332,11 +348,11 @@
 ;; 		      read-string)))
 ;;       (string->sexpr res))))
 
 (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* "DB Stats, "(seconds->year-week/day-time (current-seconds))"\n=====================")
     (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
     (for-each (lambda (cmd)
 		(let ((cmd-dat (hash-table-ref *db-stats* cmd)))
 		  (debug:print 18 *default-log-port* (format #f fmtstr cmd (vector-ref cmd-dat 0) (vector-ref cmd-dat 1) (/ (vector-ref cmd-dat 1)(vector-ref cmd-dat 0))))))
 	      (sort (hash-table-keys *db-stats*)
@@ -1443,10 +1459,57 @@
                (common:version-signature))))
 
 (define (common:api-changed?)
   (not (equal? (substring (->string megatest-version) 0 4)
                (substring (conc (common:get-last-run-version)) 0 4))))
+
+(define (rmt:server-shutdown)
+  (let ((dbfile   (servdat-dbfile *server-info*)))
+    (debug:print-info 0 *default-log-port* "dbfile is "dbfile)
+    (if dbfile
+	(let* ((am-server  (args:get-arg "-server"))
+	       (dbfile     (args:get-arg "-db"))
+	       (apath      *toppath*)
+	       (dbdat      (db:get-dbdat *dbstruct-db* apath dbfile))
+	       (db         (dbr:dbdat-db dbdat))
+	       (inmem      (dbr:dbdat-db dbdat))
+	       )
+	  ;; do a final sync here
+	  (debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds))
+	  (db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t)
+	  ;; let's finalize here
+	  (debug:print-info 0 *default-log-port* "Finalizing db and inmem")
+	  (sqlite3:finalize! db)
+	  (sqlite3:finalize! inmem)
+	  (debug:print-info 0 *default-log-port* "Finalizing db and inmem complete")
+	  (if am-server
+	      (if (string-match ".*/main.db$" dbfile)
+		  (let ((pkt-file (conc (get-pkts-dir *toppath*)
+					"/" (servdat-uuid *server-info*)
+					".pkt")))
+		    (debug:print-info 0 *default-log-port* "removing pkt "pkt-file)
+		    (delete-file* pkt-file)
+		    (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile)
+		    (db:with-lock-db (servdat-dbfile *server-info*)
+				     (lambda (dbh dbfile)
+				       (db:release-lock dbh dbfile))))
+		  (let* ((sdat *server-info*) ;; we have a run-id server
+			 (host (servdat-host sdat))
+			 (port (servdat-port sdat))
+			 (uuid (servdat-uuid sdat)))
+		    (if (not (string-match ".db/main.db" (args:get-arg "-db")))
+			(let* ((res (rmt:deregister-server *rmt:remote* ;; TODO/BUG: why is this requiring *rmt:remote*?
+							   *toppath*
+							   (servdat-host *server-info*)   ;; iface
+							   (servdat-port *server-info*)
+							   (servdat-uuid *server-info*)
+							   (current-process-id)
+							   )))
+			  (debug:print-info 0 *default-log-port* "deregistered-server, res="res)))
+		    
+		    (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid)
+		    )))))))
 
 (define (std-exit-procedure)
   ;;(common:telemetry-log-close)
   (on-exit (lambda () 0))
   ;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
@@ -1456,56 +1519,40 @@
 			 (bdat-time-to-exit-set! *bdat* #t)
 			 #t))))
     (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.")
     (if (and no-hurry (debug:debug-mode 18))
 	(rmt:print-db-stats))
-    (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
-                              (if *server-info*
-				  (let ((pkt-file (conc (get-pkts-dir *toppath*)
-							"/" (servdat-uuid *server-info*)
-							".pkt"))
-					(dbfile   (servdat-dbfile *server-info*)))
-				    (if dbfile
-					(begin
-
-					  ;; do a final sync here
-					  
-					(if (string-match ".*/main.db$" dbfile)
-					    (begin
-					      (debug:print-info 0 *default-log-port* "removing pkt "pkt-file)
-					      (delete-file* pkt-file)
-					      (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile)
-					      (db:with-lock-db (servdat-dbfile *server-info*)
-							       (lambda (dbh dbfile)
-								 (db:release-lock dbh dbfile))))
-					    (let* ((sdat *server-info*)) ;; we have a run-id server
-					      (rmt:send-receive-real *rmt:remote* *toppath*
-								     (db:run-id->dbname #f)
-								     'deregister-server
-								     `(,(servdat-uuid sdat)
-								       ,(current-process-id)
-								       ,(servdat-host sdat)   ;; iface
-								       ,(servdat-port sdat)))))))))
-			      (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated
-			      (if (bdat-task-db *bdat*)    ;; TODO: Check that this is correct for task db
-				  (let ((db (cdr (bdat-task-db *bdat*))))
-				    (if (sqlite3:database? db)
-					(begin
-					  (sqlite3:interrupt! db)
-					  (sqlite3:finalize! db #t)
-					  (bdat-task-db-set! *bdat* #f)))))
-                              #;(http-client#close-idle-connections!)
-                              (if (not (eq? *default-log-port* (current-error-port)))
-                                  (close-output-port *default-log-port*))
-			      (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))
+    (let ((th1 (make-thread
+		(lambda () ;; thread for cleaning up, give it five seconds
+		  (let* ((start-time (current-seconds)))
+		    (if (and *server-info*
+			     *unclean-shutdown*)
+			(begin
+			  (debug:print-info 0 *default-log-port* "Unclean server exit, calling server-shtudown")
+			  (rmt:server-shutdown)))
+		    (debug:print-info 0 *default-log-port* "Shutdown activities completed in "(- (current-seconds) start-time)" seconds"))
+		  ;; (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated
+		  #;(if (bdat-task-db *bdat*)    ;; TODO: Check that this is correct for task db
+		  (let ((db (cdr (bdat-task-db *bdat*))))
+		  (if (sqlite3:database? db)
+		  (begin
+		  (debug:print-info 0 *default-log-port* "Closing down task db "db)
+		  (sqlite3:interrupt! db)
+		  (sqlite3:finalize! db #t)
+		  (bdat-task-db-set! *bdat* #f)))))
+		  #;(http-client#close-idle-connections!)
+		  (if (not (eq? *default-log-port* (current-error-port)))
+		      (close-output-port *default-log-port*))
+		  (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))
 	  (th2 (make-thread (lambda ()
-			      (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...")
+			      (debug:print 4 *default-log-port* "Attempting clean exit. Mode="(if no-hurry "no-hurry" "normal")
+					   " Please be patient and wait a few seconds...")
 			      (if no-hurry
                                   (begin
                                     (thread-sleep! 5)) ;; give the clean up few seconds to do it's stuff
                                   (begin
-      				  (thread-sleep! 2)))
+				    (thread-sleep! 2)))
       			      (debug:print 4 *default-log-port* " ... done")
       			      )
 			    "clean exit")))
       (thread-start! th1)
       (thread-start! th2)
@@ -1539,38 +1586,13 @@
 
 ;;======================================================================
 ;; S E R V E R
 ;; ======================================================================
 
-;; NOTE: http-transport:launch is the entry point
-;;          -> http-transport:run
-;;             -> http-transport:try-start-server -> http-transport:try-start-server (until success)
-
 (define (http-get-function fnkey)
   (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))
 
-#;(define (rmt:launch-server hostn port)
-   (if *server-info*
-	(begin
-	  (servdat-host-set! *server-info* hostn)
-	  (servdat-port-set! *server-info* port)
-	  (servdat-status-set! *server-info* 'trying-port)
-	  (servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
-	(set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
-   (let* ((l        (tcp-listen port))
-	 (dbstruct #f))
-    (let-values (((i o) (tcp-accept l)))
-      ;; (write-line "Hello!" o)
-      (let loop ((indat (read i)))
-	(let* ((res (api:process-request dbstruct indat)))
-	  (case res
-	    ((quit)
-	     (close-input-port i)
-	     (close-output-port o))
-	    (else
-	     (write res o))))))))
-
 (define (rmt:run hostn)
   ;;  ;; Configurations for server
   ;;  (tcp-buffer-size 2048)
   ;;  (max-connections 2048) 
   (debug:print 2 *default-log-port* "Attempting to start the server ...")
@@ -1591,63 +1613,98 @@
 	  (servdat-host-set! *server-info* ipaddrstr)
 	  (servdat-port-set! *server-info* port)
 	  (servdat-status-set! *server-info* 'trying-port)
 	  (servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
 	(set! *server-info* (make-servdat host: ipaddrstr port: port)))
-    (let* ((l        (rmt:try-start-server ipaddrstr port)))
-      (let oloop ()
-	(let-values (((i o) (tcp-accept l)))
-	  ;; (write-line "Hello!" o)
-	  (let loop ((indat (read i)))
-	    (if (eof-object? indat)
-		(begin
-		  (close-input-port i)
-		  (close-output-port o)
-		  (oloop))
-		(let* ((res (api:process-request *dbstruct-db* indat)))
-		  (set! *db-last-access* (current-seconds))
-		  (write res o)
-		  (loop (read i))))))))
+    (let* ((rep (rmt:try-start-server ipaddrstr port)))
+      (let loop ((instr (nn-recv rep)))
+	(let* ((data   (string->sexpr instr))
+	       (res    (case data
+			 ((quit) 'quit)
+			 (else    (api:process-request *dbstruct-db* data))))
+	       (resdat (sexpr->string res)))
+	  (if (not (eq? res 'quit))
+	      (begin
+		(set! *db-last-access* (current-seconds))
+		(nn-send rep resdat)
+		(loop (nn-recv rep)))))))
+    ;; server exit stuff here
     (let* ((portnum (servdat-port *server-info*)))
       (portlogger:open-run-close portlogger:set-port portnum "released")
-      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))
+      (rmt:server-shutdown)
+      ;; (bdat-time-to-exit-set! *bdat* #t) ;; tell on-exit to be fast as we've already cleaned up
+      (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run
+      ;; (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)
+      (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
+      )))
 
 (define (rmt:try-start-server ipaddrstr portnum)
-  (if *server-info*
+  (if *server-info* ;; update the server info as we might be trying next port
       (begin
 	(servdat-host-set! *server-info* ipaddrstr)
 	(servdat-port-set! *server-info* portnum)
 	(servdat-status-set! *server-info* 'trying-port)
-	(servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
+	(servdat-trynum-set! *server-info*
+			     (+ (servdat-trynum *server-info*) 1)))
       (set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
   (debug:print-info 0 *default-log-port* "rmt:try-start-server time="
 		    (seconds->time-string (current-seconds))
 		    " ipaddrsstr=" ipaddrstr
 		    " portnum=" portnum)
-  (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)
-	   (rmt:try-start-server ipaddrstr
-				 (portlogger:open-run-close portlogger:find-port)))
-	 (begin
-	   (print "ERROR: Tried and tried but could not start the server"))))
-   ;; any error in following steps will result in a retry
-   (if *server-info*
-       (servdat-status-set! *server-info* 'starting)
-       (set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
-   
-   (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
-   (tcp-listen portnum)))
+  (if (is-port-in-use portnum)
+      (begin
+	(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)
+	(rmt:try-start-server ipaddrstr
+			      (portlogger:open-run-close
+			       portlogger:find-port)))
+      (begin
+	(if (not *server-info*)
+	    (set! *server-info* (make-servdat
+				 host: ipaddrstr
+				 port: portnum)))
+	(servdat-status-set! *server-info* 'starting)
+	(servdat-port-set!   *server-info* portnum)
+	(if (not (servdat-rep *server-info*))
+	    (servdat-rep-set!    *server-info*  (nn-socket 'rep)))
+	(let* ((rep (servdat-rep *server-info*)))
+	  (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
+	  (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)
+		   (rmt:try-start-server ipaddrstr
+					 (portlogger:open-run-close portlogger:find-port)))
+		 (begin
+		   (print "ERROR: Tried and tried but could not start the server, stopping at port "portnum))))
+	   (nn-bind rep (conc "tcp://*:" portnum))
+	   rep)))))
 
 ;;======================================================================
 ;; S E R V E R   U T I L I T I E S 
 ;;======================================================================
 
@@ -1796,31 +1853,33 @@
 (define (server-address srv-pkt)
   (conc (alist-ref 'host srv-pkt) ":"
 	(alist-ref 'port srv-pkt)))
 	
 (define (server-ready? host port key) ;; server-address is host:port
-  (let-values (((i o)(handle-exceptions
-		      exn
-		      (values #f #f)
-		      (tcp-connect host port))))
-    (if (and i o)
-	(begin
-	  (write `((cmd . ping)
-		   (key . ,key)
-		   (params . ())) o)
-	  (let ((res (with-input-from-port i
-		       read)))
-	    (close-output-port o)
-	    (close-input-port i)
-	    res))
+;;  (let-values (((i o)(handle-exceptions
+;;		      exn
+;;		      (values #f #f)
+;;		      (tcp-connect host port))))
+;;    (if (and i o)
+  (let* ((data (sexpr->string  `((cmd . ping)
+				 (key . ,key)
+				 (params . ()))))
+	 (res  (open-send-receive-nn (conc host ":" port) data)))
+    (string->sexpr res)))
+
+;; (let ((res (with-input-from-port i
+;; 		       read)))
+;; 	    (close-output-port o)
+;; 	    (close-input-port i)
+;; 	    res))
 ;; 	    (if (string? res)
 ;; 		(string->sexpr res)
 ;; 		res)))
-	(begin ;; connection failed
-	  (debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.")
-	  #f))))
- 	      
+;;     (begin ;; connection failed
+;; 	  (debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.")
+;; 	  #f))))
+
 ;; (define (loop-test host port data) ;; server-address is host:port
 ;;   ;; ping the server and ask it
 ;;   ;; if it ready
 ;;   ;; (let* ((sdat (servdat-init #f host port #f)))
 ;;   ;;   (http-transport:send-receive sdat "abc" 'ping '())))
@@ -1970,18 +2029,31 @@
 			(equal? sdat last-sdat)
 			sdat))))))))
 
 (define (rmt:register-server remote apath iface port server-key dbname)
   (rmt:open-main-connection remote apath) ;; we need a channel to main.db
-  (rmt:send-receive-real remote apath ;; params: host port servkey pid ipaddr dbpath
-			 (db:run-id->dbname #f) 'register-server `(,iface
-								   ,port
-								   ,server-key
-								   ,(current-process-id)
-								   ,iface
-								   ,apath
-								   ,dbname)))
+  (rmt:send-receive-real remote apath      ;; params: host port servkey pid ipaddr dbpath
+			 (db:run-id->dbname #f)
+			 'register-server `(,iface
+					    ,port
+					    ,server-key
+					    ,(current-process-id)
+					    ,iface
+					    ,apath
+					    ,dbname)))
+
+(define (rmt:deregister-server remote apath iface port server-key dbname)
+  (rmt:open-main-connection remote apath) ;; we need a channel to main.db
+  (rmt:send-receive-real remote apath      ;; params: host port servkey pid ipaddr dbpath
+			 (db:run-id->dbname #f)
+			 'deregister-server `(,iface
+					      ,port
+					      ,server-key
+					      ,(current-process-id)
+					      ,iface
+					      ,apath
+					      ,dbname)))
 
 (define (http-transport:wait-for-stable-interface #!optional (num-tries-allowed 100))
   ;; wait until *server-info* stops changing
   (let* ((stime (current-seconds)))
     (let loop ((last-host  #f)
@@ -2040,15 +2112,16 @@
 	(http-transport:wait-for-server pkts-dir dbname server-key)
 	(http-transport:wait-for-stable-interface))
     ;; this is our forever loop
     (let* ((iface             (servdat-host *server-info*))
 	   (port              (servdat-port *server-info*)))
-      (let loop ((count         0)
+      (let loop ((count          0)
 		 (bad-sync-count 0)
 		 (start-time     (current-milliseconds)))
 	
-	(if (not is-main)
+	(if (and (not is-main)
+		 (common:low-noise-print 60 "servdat-status"))
 	    (debug:print-info 0 *default-log-port* "servdat-status is " (servdat-status *server-info*)))
 
 	;; set up the database handle
 	(mutex-lock! *heartbeat-mutex*)
 	(if (not *dbstruct-db*) ;; no db opened yet, open the db and register with main if appropriate
@@ -2068,20 +2141,28 @@
 			  (exit)))))
 	      (debug:print 0 *default-log-port*
 			   "SERVER: running, db "dbname" opened, megatest version: "
 			   (common:get-full-version))
 	      ;; start the watchdog
-	      (if watchdog
+
+	      ;; is this really needed?
+	      
+	      #;(if watchdog
 		  (if (not (member (thread-state watchdog)
 				   '(ready running blocked
 					   sleeping dead)))
 		      (begin
 			(debug:print-info 0 *default-log-port* "Starting watchdog thread (in state "(thread-state watchdog)")")
 			(thread-start! watchdog))
 		      (debug:print-info 0 *default-log-port* "Not starting watchdog thread (in state "(thread-state watchdog)")"))
 		  (debug:print 0 *default-log-port* "ERROR: *watchdog* not setup, cannot start it."))
-	      #;(loop (+ count 1) bad-sync-count start-time)))
+	      #;(loop (+ count 1) bad-sync-count start-time)
+	      ))
+
+	(debug:print-info 0 *default-log-port* "syncing "*toppath*" "dbname" at "(current-seconds))
+	(db:sync-inmem->disk *dbstruct-db* *toppath* dbname)
+	
 	(mutex-unlock! *heartbeat-mutex*)
 	
 	;; 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.
@@ -2108,59 +2189,26 @@
 		    (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)))
 	    (loop 0 bad-sync-count (current-milliseconds)))
 	   (else
+	    (set! *unclean-shutdown* #f)
+	    (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
 	    (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
-    ;;
-
-    ;; deregister the server
-
-    
-    (bdat-time-to-exit-set! *bdat* #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)
-    (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
-    (exit)))
+	    (debug:print-info 0 *default-log-port* "Sending 'quit to server, received: "
+			      (open-send-receive-nn (conc iface":"port)      ;; do this here and not in server-shutdown
+						    (sexpr->string 'quit)))
+	    )))))))
 
 ;; Call this to start the actual server
 ;;
 ;; all routes though here end in exit ...
 ;;
 ;; This is the point at which servers are started
 ;;
 (define (rmt:server-launch dbname)
+  (debug:print-info 0 *default-log-port* "Entered rmt:server-launch")
   (let* ((th2 (make-thread (lambda ()
 			     (debug:print-info 0 *default-log-port* "Server run thread started")
 			     (rmt:run (if (args:get-arg "-server")
 					  (args:get-arg "-server")
 					  "-")
@@ -2172,12 +2220,13 @@
     (thread-start! th2)
     (thread-sleep! 0.252) ;; give the server time to settle before starting the keep-running monitor.
     (thread-start! th3)
     (set! *didsomething* #t)
     (thread-join! th2)
-  (exit))
-
+    (thread-join! th3)
+    ;; (exit))
+  )
   #f
   )
 	    
 ;; Generate a unique signature for this process, used at both client and
 ;; server side
@@ -2192,10 +2241,110 @@
 (define (rmt:get-signature) 
   (if *my-signature* *my-signature*
       (let ((sig (rmt:mk-signature)))
         (set! *my-signature* sig)
         *my-signature*)))
+
+;;======================================================================
+;; Nanomsg transport
+;;======================================================================
+
+(define (is-port-in-use port-num)
+  (let* ((ret #f))
+    (let-values (((inp oup pid)
+		  (process "netstat" (list  "-tulpn" ))))
+      (let loop ((inl (read-line inp)))
+        (if (not (eof-object? inl))
+            (begin 
+	      (if (string-search (regexp (conc ":" port-num)) inl)
+		  (begin
+					;(print "Output: "  inl)
+		    (set! ret  #t))
+		  (loop (read-line inp)))))))
+    ret))
+
+;;start a server, returns the connection
+;;
+(define (start-nn-server portnum )
+  (let ((rep (nn-socket 'rep)))
+    (handle-exceptions
+     exn
+     (let ((emsg ((condition-property-accessor 'exn 'message) exn)))
+       (print "ERROR: Failed to start server \"" emsg "\"")
+       (exit 1))
+      
+     (nn-bind rep (conc "tcp://*:" portnum)))
+    rep))
+
+;; open connection to server, send message, close connection
+;;
+(define (open-send-close-nn host-port msg #!key (timeout 3) ) ;; default timeout is 3 seconds
+  (let ((req  (nn-socket 'req))
+        (uri  (conc "tcp://" host-port))
+        (res  #f)
+        ;; (contacts (alist-ref 'contact attrib))
+        ;; (mode (alist-ref 'mode attrib))
+	) 
+    (handle-exceptions
+     exn
+     (let ((emsg ((condition-property-accessor 'exn 'message) exn)))
+       ;; Send notification       
+       (debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\"" )
+       #f)
+     (nn-connect req uri)
+     ;; (print "Connected to the server " )
+     (nn-send req msg)
+     ;; (print "Request Sent")  
+     (let* ((th1  (make-thread (lambda ()
+                                 (let ((resp (nn-recv req)))
+                                   (nn-close req)
+                                   (set! res (if (equal? resp "ok")
+                                                 #t
+                                                 #f))))
+                               "recv thread"))
+            (th2 (make-thread (lambda ()
+                                (thread-sleep! timeout)
+                                (thread-terminate! th1))
+			      "timer thread")))
+       (thread-start! th1)
+       (thread-start! th2)
+       (thread-join! th1)
+       res))))
+
+(define (open-send-receive-nn host-port msg #!key (timeout 3) ) ;; default timeout is 3 seconds
+  (let ((req  (nn-socket 'req))
+        (uri  (conc "tcp://" host-port))
+        (res  #f)
+	;;        (contacts (alist-ref 'contact attrib))
+        ;; (mode (alist-ref 'mode attrib))
+	) 
+    (handle-exceptions
+     exn
+     (let ((emsg ((condition-property-accessor 'exn 'message) exn)))
+       ;; Send notification      
+       (debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\"" )
+       #f)
+     (nn-connect req uri)
+     ;; (print "Connected to the server " )
+     (nn-send req msg)
+     ;; (print "Request Sent")  
+     ;; receive code here
+     ;;(print (nn-recv req))
+     (let* ((th1  (make-thread (lambda ()
+                                 (let ((resp (nn-recv req)))
+                                   (nn-close req)
+                                   (print resp)
+                                   (set! res resp)))
+                               "recv thread"))
+            (th2 (make-thread (lambda ()
+                                (thread-sleep! timeout)
+                                (thread-terminate! th1))
+                             "timer thread")))
+       (thread-start! th1)
+       (thread-start! th2)
+       (thread-join! th1)
+       res))))
 
 ;;======================================================================
 ;; S E R V E R   U T I L I T I E S 
 ;;======================================================================
 

Index: tests/unittests/server.scm
==================================================================
--- tests/unittests/server.scm
+++ tests/unittests/server.scm
@@ -34,11 +34,11 @@
  ;; sexpr->string
  ;; server-ready?
  ;; rmt:register-server
  ;; rmt:open-main-connection
  ;; rmt:general-open-connection
- ;; rmt:get-conny
+ ;; rmt:get-conn
  ;; common:watchdog
  ;; rmt:find-main-server
  ;; get-all-server-pkts
  ;; get-viable-servers
  ;; get-best-candidate
@@ -54,22 +54,28 @@
 (define dbname ".db/2.db")
 (define remote *rmt:remote*)
 (define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))
 
 (test #f #t (rmt:open-main-connection remote apath))
+(test #f #t (rmt:conn? (rmt:get-conn *rmt:remote* *toppath* ".db/main.db")))
 (test #f #t (rmt:conn? (rmt:get-conn *rmt:remote* *toppath* ".db/main.db")))
 (test #f 'server-started (rmt:send-receive-real *rmt:remote* *toppath* ".db/main.db" 'get-server `(,apath ,dbname)))
 
 (thread-sleep! 2)
 (test #f #t (list? (rmt:general-open-connection *rmt:remote* *toppath* ".db/2.db")))
 
 (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
 (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
 (print "Got here.")
-(test #t 1 (rmt:send-receive 'register-run 1 (list keyvals "run2" "new" "n/a" "justme" #f)))
+
+(test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))
+
+;; (test #f 1 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
 
-(test #f 1 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
+(thread-sleep! 5)
+(exit)
+
 
 ;; (delete-file* "logs/1.log")
 ;; (define run-id 1)
 
 ;; (test "setup for run" #t (begin (launch:setup)
@@ -327,195 +333,196 @@
 ;; 
 
 ;; (exit)
 
 
-;; all old stuff below
-
-
-
-
-(delete-file* "logs/1.log")
-(define run-id 1)
-
-(test "setup for run" #t (begin (launch:setup-for-run)
- 				(string? (getenv "MT_RUN_AREA_HOME"))))
-
-;; Insert data into db
-;;
-(define user    (current-user-name))
-(define runname "mytestrun")
-(define keys    (rmt:get-keys))
-(define runinfo #f)
-(define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
-(define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
-
-(test #f 1 (rmt:register-run keyvals runname "new" "n/a" user))
-;; (test #f #f (rmt:get-runs-by-patt keys runname))
-(test #f #t (rmt:general-call 'register-test run-id run-id "test-one" ""))
-(define test-one-id #f)
-(test #f 30001  (let ((test-id (rmt:get-test-id run-id "test-one" "")))
-	      (set! test-one-id test-id)
-	      test-id))
-(define test-one-rec #f)
-(test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id)))
-		      (set! test-one-rec test-rec)
-		      (vector-ref test-rec 2)))
-
-(use trace)
-(import trace)
-;; (trace
-;;  rmt:send-receive
-;;  rmt:open-qry-close-locally
-;; )
-
-;; Tests to assess reading/writing while servers are starting/stopping
-(define start-time (current-seconds))
-(let loop ((test-state 'start))
-  (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id))
-	 (first-dat   (if (not (null? server-dats))
-			  (car server-dats)
-			  #f))
-	 (server-state (or (and first-dat (string->symbol (vector-ref first-dat 8))) 'no-dat)))
-    (if first-dat
-	(map (lambda (dat)
-	       (apply print (intersperse (vector->list dat) ", ")))
-	     server-dats)
-	(print "No server"))
-    (test #f test-one-rec (rmt:get-test-info-by-id run-id test-one-id))
-    (thread-sleep! 1)
-    (case test-state
-      ((start)
-       (print "Trying to start server")
-       (server:kind-run run-id)
-       (loop 'server-started))
-      ((server-started)
-       (case server-state 
-	 ((running)
-	  (print "Server appears to be running. Now ask it to shutdown")
-	  (rmt:kill-server run-id)
-	  ;; (trace rmt:open-qry-close-locally rmt:send-receive)
-	  (loop 'shutdown-started))
-	 ((available)
-	  (loop test-state))
-	 ((shutting-down)
-	  (loop test-state))
-	 ((no-dat)
-	  (loop test-state))
-	 (else (print "Don't know what to do if get here"))))
-      ((shutdown-started)
-       (case server-state 
-	 ((no-dat)
-	  (print "Server appears to have shutdown, ending this test"))
-	 (else
-	  (loop test-state)))))))
-
-(exit)	 
-       
-;; (set! *transport-type* 'http)
-;; 
-;; (test "setup for run" #t (begin (setup-for-run)
-;; 				(string? (getenv "MT_RUN_AREA_HOME"))))
-;; 
-;; (test "server-register, get-best-server" #t (let ((res #f))
-;; 					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
-;; 					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
-;; 					      (number? (vector-ref res 3))))
-;; 
-;; (test "de-register server" #f (let ((res #f))
-;; 				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
-;; 				(vector? (open-run-close tasks:get-best-server tasks:open-db))))
-;; 
-;; (define server-pid #f)
-;; 
-;; ;; Not sure how the following should work, replacing it with system of megatest -server
-;; ;; (test "launch server" #t (let ((pid (process-fork (lambda ()
-;; ;; 						    ;; (daemon:ize)
-;; ;; 						    (server:launch 'http)))))
-;; ;; 			   (set! server-pid pid)
-;; ;; 			   (number? pid)))
-;; (system "../../bin/megatest -server - -debug 22 > server.log 2> server.log &")
-;; 
-;; (let loop ((n 10))
-;;   (thread-sleep! 1) ;; need to wait for server to start.
-;;   (let ((res (open-run-close tasks:get-best-server tasks:open-db)))
-;;     (print "tasks:get-best-server returned " res)
-;;     (if (and (not res)
-;; 	     (> n 0))
-;; 	(loop (- n 1)))))
-;; 
-;; (test "get-best-server" #t (begin 
-;; 			     (client:launch)
-;; 			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
-;; 			       (vector? dat))))
-;; 
-;; (define *keys*               (keys:config-get-fields *configdat*))
-;; (define *keyvals*            (keys:target->keyval *keys* "a/b/c"))
-;; 
-;; (test #f #t                       (string? (car *runremote*)))
-;; (test #f '(#t "successful login") (rmt:login)) ;;  *runremote* *toppath* *my-client-signature*)))
-;; 
-;; (test #f #f                       (rmt:get-test-info-by-id 1 99)) ;; get non-existant test
-;; 
-;; ;; RUNS
-;; (test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
-;; (test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
-;; 				    (vector-ref (vector-ref rinfo 1) 3)))
-;; (test "get runname from id" "firstrun" (rmt:get-run-name-from-id 1))
-;; 
-;; ;; TESTS
-;; (test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
-;; (test "register test"       #t    (rmt:general-call 'register-test 1 1 "test1" ""))
-;; (test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
-;; (test "get test id"            1  (rmt:get-test-id 1 "test1" ""))
-;; 
-;; (test "sync back"              #t (> (rmt:sync-inmem->db) 0))
-;; (test "get test id from main"  1  (db:get-test-id *db* 1 "test1" ""))
-;; 
-;; (test "get keys"               #t (list? (rmt:get-keys)))
-;; (test "set comment"            #t (begin (rmt:general-call 'set-test-comment 1 "this is a comment" 1) #t))
-;; (test "get comment" "this is a comment" (let ((trec (rmt:get-test-info-by-id 1 1)))
-;; 					  (db:test-get-comment trec)))
-;; 
-;; ;; MORE RUNS
-;; (test "get runs"  #t (let* ((runs   (rmt:get-runs "%" #f #f '()))
-;; 			    (header (vector-ref runs 0))
-;; 			    (data   (vector-ref runs 1)))
-;; 		       (and (list?   header)
-;; 			    (list?   data)
-;; 			    (vector? (car data)))))
-;; 
-;; (test "get local testinfo" "test1" (vector-ref (db:get-testinfo-state-status *db* 1 1) 2))
-;; (test "get testinfo"       "test1" (vector-ref (rmt:get-testinfo-state-status 1 1) 2))
-;; 
-;; ;;======================================================================
-;; ;; D B
-;; ;;======================================================================
-;; 
-;; (test "pass fail counts" #t (rmt:general-call 'pass-fail-counts 10 9 1))
-;; (test "get pass fail counts" 19 (let ((dat (rmt:get-test-info-by-id 1)))
-;; 				  (+ (db:test-get-pass_count dat)
-;; 				     (db:test-get-fail_count dat))))
-;; 
-;; (define testregistry (make-hash-table))
-;; (for-each
-;;  (lambda (tname)
-;;    (for-each
-;;     (lambda (itempath)
-;;       (let ((tkey  (conc tname "/" itempath))
-;; 	    (rpass (random 10))
-;; 	    (rfail (random 10)))
-;; 	(hash-table-set! testregistry tkey (list tname itempath))
-;; 	(rmt:general-call 'register-test 1 tname itempath)
-;; 	(let* ((tid  (rmt:get-test-id 1 tname itempath))
-;; 	       (tdat (rmt:get-test-info-by-id tid)))
-;; 	  (rmt:general-call 'pass-fail-counts rpass rfail (db:test-get-id tdat))
-;; 	  (let* ((resdat (rmt:get-test-info-by-id tid)))
-;; 	    (test "set/get pass fail counts" (list rpass rfail)
-;; 		  (list (db:test-get-pass_count resdat)
-;; 			(db:test-get-fail_count resdat)))))))
-;;     (list "" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j")))
-;;  (list "test1" "test2" "test3" "test4" "test5"))
-;; 
-;; 
-;; (test #f '(#t "exit process started") (rmt:kill-server)) ;; *toppath* *my-client-signature* #f)))
-;; 
+;; ;; ;; ;; all old stuff below
+;; ;; ;; 
+;; ;; ;; 
+;; ;; ;; 
+;; ;; ;; 
+;; ;; ;; (delete-file* "logs/1.log")
+;; ;; ;; (define run-id 1)
+;; ;; ;; 
+;; ;; ;; (test "setup for run" #t (begin (launch:setup-for-run)
+;; ;; ;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
+;; ;; ;; 
+;; ;; ;; ;; Insert data into db
+;; ;; ;; ;;
+;; ;; ;; (define user    (current-user-name))
+;; ;; ;; (define runname "mytestrun")
+;; ;; ;; (define keys    (rmt:get-keys))
+;; ;; ;; (define runinfo #f)
+;; ;; ;; (define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
+;; ;; ;; (define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
+;; ;; ;; 
+;; ;; ;; (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user))
+;; ;; ;; ;; (test #f #f (rmt:get-runs-by-patt keys runname))
+;; ;; ;; (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" ""))
+;; ;; ;; (define test-one-id #f)
+;; ;; ;; (test #f 30001  (let ((test-id (rmt:get-test-id run-id "test-one" "")))
+;; ;; ;; 	      (set! test-one-id test-id)
+;; ;; ;; 	      test-id))
+;; ;; ;; (define test-one-rec #f)
+;; ;; ;; (test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id)))
+;; ;; ;; 		      (set! test-one-rec test-rec)
+;; ;; ;; 		      (vector-ref test-rec 2)))
+;; ;; ;; 
+;; ;; ;; (use trace)
+;; ;; ;; (import trace)
+;; ;; ;; ;; (trace
+;; ;; ;; ;;  rmt:send-receive
+;; ;; ;; ;;  rmt:open-qry-close-locally
+;; ;; ;; ;; )
+;; ;; ;; 
+;; ;; ;; ;; Tests to assess reading/writing while servers are starting/stopping
+;; ;; ;; (define start-time (current-seconds))
+;; ;; ;; (let loop ((test-state 'start))
+;; ;; ;;   (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id))
+;; ;; ;; 	 (first-dat   (if (not (null? server-dats))
+;; ;; ;; 			  (car server-dats)
+;; ;; ;; 			  #f))
+;; ;; ;; 	 (server-state (or (and first-dat (string->symbol (vector-ref first-dat 8))) 'no-dat)))
+;; ;; ;;     (if first-dat
+;; ;; ;; 	(map (lambda (dat)
+;; ;; ;; 	       (apply print (intersperse (vector->list dat) ", ")))
+;; ;; ;; 	     server-dats)
+;; ;; ;; 	(print "No server"))
+;; ;; ;;     (test #f test-one-rec (rmt:get-test-info-by-id run-id test-one-id))
+;; ;; ;;     (thread-sleep! 1)
+;; ;; ;;     (case test-state
+;; ;; ;;       ((start)
+;; ;; ;;        (print "Trying to start server")
+;; ;; ;;        (server:kind-run run-id)
+;; ;; ;;        (loop 'server-started))
+;; ;; ;;       ((server-started)
+;; ;; ;;        (case server-state 
+;; ;; ;; 	 ((running)
+;; ;; ;; 	  (print "Server appears to be running. Now ask it to shutdown")
+;; ;; ;; 	  (rmt:kill-server run-id)
+;; ;; ;; 	  ;; (trace rmt:open-qry-close-locally rmt:send-receive)
+;; ;; ;; 	  (loop 'shutdown-started))
+;; ;; ;; 	 ((available)
+;; ;; ;; 	  (loop test-state))
+;; ;; ;; 	 ((shutting-down)
+;; ;; ;; 	  (loop test-state))
+;; ;; ;; 	 ((no-dat)
+;; ;; ;; 	  (loop test-state))
+;; ;; ;; 	 (else (print "Don't know what to do if get here"))))
+;; ;; ;;       ((shutdown-started)
+;; ;; ;;        (case server-state 
+;; ;; ;; 	 ((no-dat)
+;; ;; ;; 	  (print "Server appears to have shutdown, ending this test"))
+;; ;; ;; 	 (else
+;; ;; ;; 	  (loop test-state)))))))
+;; ;; ;; 
+;; ;; ;; (exit)	 
+;; ;; ;;        
+;; ;; ;; ;; (set! *transport-type* 'http)
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "setup for run" #t (begin (setup-for-run)
+;; ;; ;; ;; 				(string? (getenv "MT_RUN_AREA_HOME"))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "server-register, get-best-server" #t (let ((res #f))
+;; ;; ;; ;; 					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
+;; ;; ;; ;; 					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
+;; ;; ;; ;; 					      (number? (vector-ref res 3))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "de-register server" #f (let ((res #f))
+;; ;; ;; ;; 				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
+;; ;; ;; ;; 				(vector? (open-run-close tasks:get-best-server tasks:open-db))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (define server-pid #f)
+;; ;; ;; ;; 
+;; ;; ;; ;; ;; Not sure how the following should work, replacing it with system of megatest -server
+;; ;; ;; ;; ;; (test "launch server" #t (let ((pid (process-fork (lambda ()
+;; ;; ;; ;; ;; 						    ;; (daemon:ize)
+;; ;; ;; ;; ;; 						    (server:launch 'http)))))
+;; ;; ;; ;; ;; 			   (set! server-pid pid)
+;; ;; ;; ;; ;; 			   (number? pid)))
+;; ;; ;; ;; (system "../../bin/megatest -server - -debug 22 > server.log 2> server.log &")
+;; ;; ;; ;; 
+;; ;; ;; ;; (let loop ((n 10))
+;; ;; ;; ;;   (thread-sleep! 1) ;; need to wait for server to start.
+;; ;; ;; ;;   (let ((res (open-run-close tasks:get-best-server tasks:open-db)))
+;; ;; ;; ;;     (print "tasks:get-best-server returned " res)
+;; ;; ;; ;;     (if (and (not res)
+;; ;; ;; ;; 	     (> n 0))
+;; ;; ;; ;; 	(loop (- n 1)))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "get-best-server" #t (begin 
+;; ;; ;; ;; 			     (client:launch)
+;; ;; ;; ;; 			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
+;; ;; ;; ;; 			       (vector? dat))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (define *keys*               (keys:config-get-fields *configdat*))
+;; ;; ;; ;; (define *keyvals*            (keys:target->keyval *keys* "a/b/c"))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test #f #t                       (string? (car *runremote*)))
+;; ;; ;; ;; (test #f '(#t "successful login") (rmt:login)) ;;  *runremote* *toppath* *my-client-signature*)))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test #f #f                       (rmt:get-test-info-by-id 1 99)) ;; get non-existant test
+;; ;; ;; ;; 
+;; ;; ;; ;; ;; RUNS
+;; ;; ;; ;; (test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
+;; ;; ;; ;; (test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
+;; ;; ;; ;; 				    (vector-ref (vector-ref rinfo 1) 3)))
+;; ;; ;; ;; (test "get runname from id" "firstrun" (rmt:get-run-name-from-id 1))
+;; ;; ;; ;; 
+;; ;; ;; ;; ;; TESTS
+;; ;; ;; ;; (test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
+;; ;; ;; ;; (test "register test"       #t    (rmt:general-call 'register-test 1 1 "test1" ""))
+;; ;; ;; ;; (test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
+;; ;; ;; ;; (test "get test id"            1  (rmt:get-test-id 1 "test1" ""))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "sync back"              #t (> (rmt:sync-inmem->db) 0))
+;; ;; ;; ;; (test "get test id from main"  1  (db:get-test-id *db* 1 "test1" ""))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "get keys"               #t (list? (rmt:get-keys)))
+;; ;; ;; ;; (test "set comment"            #t (begin (rmt:general-call 'set-test-comment 1 "this is a comment" 1) #t))
+;; ;; ;; ;; (test "get comment" "this is a comment" (let ((trec (rmt:get-test-info-by-id 1 1)))
+;; ;; ;; ;; 					  (db:test-get-comment trec)))
+;; ;; ;; ;; 
+;; ;; ;; ;; ;; MORE RUNS
+;; ;; ;; ;; (test "get runs"  #t (let* ((runs   (rmt:get-runs "%" #f #f '()))
+;; ;; ;; ;; 			    (header (vector-ref runs 0))
+;; ;; ;; ;; 			    (data   (vector-ref runs 1)))
+;; ;; ;; ;; 		       (and (list?   header)
+;; ;; ;; ;; 			    (list?   data)
+;; ;; ;; ;; 			    (vector? (car data)))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "get local testinfo" "test1" (vector-ref (db:get-testinfo-state-status *db* 1 1) 2))
+;; ;; ;; ;; (test "get testinfo"       "test1" (vector-ref (rmt:get-testinfo-state-status 1 1) 2))
+;; ;; ;; ;; 
+;; ;; ;; ;; ;;======================================================================
+;; ;; ;; ;; ;; D B
+;; ;; ;; ;; ;;======================================================================
+;; ;; ;; ;; 
+;; ;; ;; ;; (test "pass fail counts" #t (rmt:general-call 'pass-fail-counts 10 9 1))
+;; ;; ;; ;; (test "get pass fail counts" 19 (let ((dat (rmt:get-test-info-by-id 1)))
+;; ;; ;; ;; 				  (+ (db:test-get-pass_count dat)
+;; ;; ;; ;; 				     (db:test-get-fail_count dat))))
+;; ;; ;; ;; 
+;; ;; ;; ;; (define testregistry (make-hash-table))
+;; ;; ;; ;; (for-each
+;; ;; ;; ;;  (lambda (tname)
+;; ;; ;; ;;    (for-each
+;; ;; ;; ;;     (lambda (itempath)
+;; ;; ;; ;;       (let ((tkey  (conc tname "/" itempath))
+;; ;; ;; ;; 	    (rpass (random 10))
+;; ;; ;; ;; 	    (rfail (random 10)))
+;; ;; ;; ;; 	(hash-table-set! testregistry tkey (list tname itempath))
+;; ;; ;; ;; 	(rmt:general-call 'register-test 1 tname itempath)
+;; ;; ;; ;; 	(let* ((tid  (rmt:get-test-id 1 tname itempath))
+;; ;; ;; ;; 	       (tdat (rmt:get-test-info-by-id tid)))
+;; ;; ;; ;; 	  (rmt:general-call 'pass-fail-counts rpass rfail (db:test-get-id tdat))
+;; ;; ;; ;; 	  (let* ((resdat (rmt:get-test-info-by-id tid)))
+;; ;; ;; ;; 	    (test "set/get pass fail counts" (list rpass rfail)
+;; ;; ;; ;; 		  (list (db:test-get-pass_count resdat)
+;; ;; ;; ;; 			(db:test-get-fail_count resdat)))))))
+;; ;; ;; ;;     (list "" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j")))
+;; ;; ;; ;;  (list "test1" "test2" "test3" "test4" "test5"))
+;; ;; ;; ;; 
+;; ;; ;; ;; 
+;; ;; ;; ;; (test #f '(#t "exit process started") (rmt:kill-server)) ;; *toppath* *my-client-signature* #f)))
+;; ;; ;; ;; 
+;; ;; ;;