Index: tcp-transportmod.scm
==================================================================
--- tcp-transportmod.scm
+++ tcp-transportmod.scm
@@ -66,10 +66,12 @@
 ;; client
 ;;======================================================================
 
 ;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
 
+;; Used ONLY for client
+;;
 (defstruct tt-conn
   host
   port
   host-port
   dbfname
@@ -76,10 +78,11 @@
   server-id
   server-start
   pid
 )
 
+;; Used for BOTH clients and servers
 (defstruct tt
   ;; client related
   (conns (make-hash-table)) ;; dbfname -> conn
 
   ;; server related
@@ -91,10 +94,11 @@
   (handler      #f) ;; receives data and responds
   (socket       #f)
   (thread       #f)
   (host-port    #f)
   (cmd-thread   #f)
+  (last-access  (current-seconds))
   )
 
 (define (tt:make-remote areapath)
   (make-tt area: areapath))
 
@@ -195,27 +199,68 @@
 ;; start the listener and start responding to requests
 ;;
 ;; NOTE: organise by dbfname, not run-id so we don't need
 ;;       to pull in more modules
 ;;
+;; This is the routine called in megatest.scm to start a server
+;;
 (define (tt:start-server areapath run-id dbfname handler)
   ;; is there already a server for this dbfile? Then exit.
-  (let* ((ttdat  (make-tt areapath: areapath))
+  (let* ((ttdat   (make-tt areapath: areapath))
 	 (servers (tt:find-server ttdat dbfname)))
     (tt-handler-set! ttdat handler)
     (if (null? servers)
-	(let* ((dbstruct (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-proc))))
-	  (tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
-	  (tt:keep-running ttdat dbfname handler))
+	(let* ((dbstruct   (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-proc)))
+	       (tcp-thread (make-thread
+			    (lambda ()
+			      (tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data
+			    "tcp-server-thread"))
+	       (run-thread (make-thread
+			    (lambda ()
+			      (tt:keep-running ttdat dbfname)))))
+	  (thread-start! tcp-thread)
+	  (thread-start! run-thread)
+	  (thread-join! run-thread) ;; run thread will exit on timeout or other conditions
+	  ;;
+	  ;; set a flag here to tell tcp-thread to stop running
+	  ;;
+	  ;; (thread-join! tcp-thread) ;; can't wait 
+	  ;;
+	  ;; remove the servinfo file
+	  ;;
+	  ;; close the database, remove lock in on-disk db
+	  ;;
+	  ;; close the listener ports
+	  ;;
+	  (exit))
 	(begin
 	  (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
 	  (exit)))))
 
-(define (tt:keep-running ttdat dbfile)
+(define (tt:keep-running ttdat dbfname)
   ;; verfiy conn for ready
   ;; listener socket has been started by this stage
-  (debug:print 0 *default-log-port* "INFO: Got here!!!!"))
+  (thread-sleep! 1)
+  (let loop ((count 0))
+    (if (> count 60)
+	(begin
+	  (debug:print 0 *default-log-port* "FATAL: Could not start a tcp server, giving up.")
+	  (exit 1))
+	(if (not (tt-port ttdat)) ;; no connection yet
+	    (begin
+	      (thread-sleep! 1)
+	      (loop (+ count 1))))))
+  
+  (tt:create-server-registration-file ttdat dbfname)
+  ;; now start watching the last-access, if it hasn't been touched
+  ;; in over ten seconds we exit
+  (let loop ()
+    (if (< (- (current-seconds) (tt-last-access ttdat)) 10)
+	(begin
+	  (thread-sleep! 2)
+	  (loop))))
+  (debug:print 0 *default-log-port* "INFO: Server timed out, exiting."))
 
 ;; ;; given an already set up uconn start the cmd-loop
 ;; ;;
 ;; (define (tt:cmd-loop ttdat)
 ;;   (let* ((serv-listener (-socket uconn))
@@ -263,23 +308,22 @@
 ;; side-effects:
 ;;   ttdat-cleanup-proc is populated with function to remove the serverinfo file
 (define (tt:create-server-registration-file ttdat dbfname)
   (let* ((areapath (tt-areapath ttdat))
 	 (servdir  (tt:get-servinfo-dir areapath))
-	 (conn     (hash-table-ref/default (tt-conns ttdat) dbfname #f)))
-    (assert conn "FATAL: tt:create-server-registration-file called with no conn, dbfname="dbfname)
-    (let* ((host    (tt-conn-host conn))
-	   (port    (tt-conn-port conn))
-	   (servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
-	   (serv-id (tt:mk-signature areapath))
-	   (clean-proc (lambda ()
-			 (delete-file* servinf))))
-      (tt-cleanup-proc-set! ttdat clean-proc)
-      (with-output-to-file servinf
-	(lambda ()
-	  (print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id)" dbfname: "dbfname)))
-      serv-id)))
+	 (host     (tt-host ttdat))
+	 (port     (tt-port ttdat))
+	 (servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
+	 (serv-id (tt:mk-signature areapath))
+	 (clean-proc (lambda ()
+		       (delete-file* servinf))))
+    (assert (and host port) "FATAL: tt:create-server-registration-file called with no conn, dbfname="dbfname)
+    (tt-cleanup-proc-set! ttdat clean-proc)
+    (with-output-to-file servinf
+      (lambda ()
+	(print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id)" dbfname: "dbfname)))
+      serv-id))
 
 ;; find valid server
 ;; get servers listed, last part of name must match :<dbfname>
 ;; if more than one, wait one second and look again
 ;; future: ping oldest, if alive remove other :<dbfname> files
@@ -362,10 +406,22 @@
     (pop-directory)))
 
 ;;======================================================================
 ;; tcp connection stuff
 ;;======================================================================
+
+;; find a port and start tcp-server. This only starts the tcp portion of
+;; the server, look at (tt:start-server ...) above for the entry point
+;; for the entire server system
+;;
+(define (tt:start-tcp-server ttdat)
+  (setup-listener ttdat)
+  (let* ((socket   (tt-socket  ttdat))
+	 (handler  (tt-handler ttdat)))
+    ((make-tcp-server socket handler)
+     #t ;; yes, send error messages to std-err
+     )))
 
 ;; create a tcp listener and return a populated udat struct with
 ;; my port, address, hostname, pid etc.
 ;; return #f if fail to find a port to allocate.
 ;;
@@ -379,26 +435,17 @@
    (if (< port 65535)
        (setup-listener uconn (+ port 1))
        #f)
    (connect-listener uconn port)))
 
-;; find a port and start tcp-server
-;;
-(define (tt:start-tcp-server ttdat)
-  (setup-listener ttdat)
-  (let* ((socket   (tt-socket ttdat))
-	 (handler  (tt-handler    ttdat)))
-    ((make-tcp-server socket handler)
-     #t ;; yes, send error messages to std-err
-     )))
-
 (define (connect-listener uconn port)
   ;; (tcp-listener-socket LISTENER)(socket-name so)
   ;; sockaddr-address, sockaddr-port, sockaddr->string
   (let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
 	 (addr  (tt:get-best-guess-address (get-host-name)))) ;; (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
     (tt-port-set!      uconn port)
+    (tt-host-set!      uconn addr)
     (tt-host-port-set! uconn (conc addr":"port))
     (tt-socket-set!    uconn tlsn)
     uconn))