Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1901,20 +1901,21 @@
 ;; either:
 ;;    fails    returns  (#f . lock-creation-time)
 ;;    succeeds (returns (#t . lock-creation-time)
 ;; use (db:no-sync-del! db keyname) to release the lock
 ;;
-(define (db:no-sync-get-lock db keyname)
-  (sqlite3:with-transaction
-   (db:no-sync-db db)
-   (lambda ()
-     (handle-exceptions
-	 exn
-	 (let ((lock-time (current-seconds)))
-	   (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
-	   `(#t . ,lock-time))
-       `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname))))))
+(define (db:no-sync-get-lock db-in keyname)
+  (let ((db (db:no-sync-db db-in)))
+    (sqlite3:with-transaction
+     db
+     (lambda ()
+       (handle-exceptions
+	   exn
+	   (let ((lock-time (current-seconds)))
+	     (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
+	     `(#t . ,lock-time))
+	 `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname)))))))
 
 
 
 ;; use a global for some primitive caching, it is just silly to
 ;; re-read the db over and over again for the keys since they never

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -57,12 +57,15 @@
 					   ;; (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))) ;; (configf:lookup *configdat* "setup" "linktree")))
+	 (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)
@@ -104,10 +107,11 @@
 				  ((equal? (uri-path (request-uri (current-request))) 
 					   '(/ "hey"))
 				   (send-response body: "hey there!\n"
 						  headers: '((content-type text/plain))))
 				  (else (continue))))))))
+    (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)
@@ -348,11 +352,13 @@
 (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* ((server-start-time (current-seconds))
+  (let* ((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"))
                         (let ((sdat #f))
 			  (thread-sleep! 0.01)
@@ -380,10 +386,13 @@
          (port        (cadr server-info))
          (last-access 0)
 	 (server-timeout (server:get-timeout))
 	 (server-going  #f)
 	 (server-log-file (args:get-arg "-log"))) ;; always set when we are a server
+
+    (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
@@ -492,10 +501,23 @@
 ;; all routes though here end in exit ...
 ;;
 ;; start_server? 
 ;;
 (define (http-transport:launch)
+  ;; check that a server start is in progress, pause or exit if so
+  (let* ((tmp-area            (common:get-db-tmp-area))
+	 (server-start        (conc tmp-area "/.server-start"))
+	 (server-started      (conc tmp-area "/.server-started"))
+	 (start-time          (common:lazy-modification-time server-start))
+	 (started-time        (common:lazy-modification-time server-started))
+	 (server-starting     (< start-time started-time)) ;; if start-time is less than started-time then a server is still starting
+	 (start-time-old      (> (- (current-seconds) start-time) 5)))
+    (if (and (not start-time-old) ;; last server start try was less than five seconds ago
+	     (not server-starting))
+	(begin
+	  (debug:print-info 0 *default-log-port* "NOT starting server, there is either a recently started server or a server in process of starting")
+	  (exit))))
   ;; lets not even bother to start if there are already three or more server files ready to go
   (let* ((num-alive   (server:get-num-alive (server:get-list *toppath*))))
     (if (> num-alive 3)
 	(begin
 	  (debug:print 0 *default-log-port* "ERROR: Aborting server start because there are already " num-alive " possible servers either running or starting up")
@@ -516,27 +538,27 @@
     (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))))
+;; (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))))
 
 ;;======================================================================
 ;; web pages
 ;;======================================================================
 

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -465,12 +465,15 @@
     (set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
     (debug:print-info 2 *default-log-port* "Periodic sync thread started.")
     (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is " legacy-sync" pid="(current-process-id)" this-wd-num="this-wd-num)
     (if (and legacy-sync (not *time-to-exit*))
 	(let* (;;(dbstruct (db:setup))
-	       (mtdb     (dbr:dbstruct-mtdb dbstruct))
-	       (mtpath   (db:dbdat-get-path mtdb)))
+	       (mtdb       (dbr:dbstruct-mtdb dbstruct))
+	       (mtpath     (db:dbdat-get-path mtdb))
+	       (tmp-area   (common:get-db-tmp-area))
+	       (start-file (conc tmp-area "/.start-sync"))
+	       (end-file   (conc tmp-area "/.end-sync")))
 	  (debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
 	  (let loop ()
 	    ;; sync for filesystem local db writes
 	    ;;
 	    (mutex-lock! *db-multi-sync-mutex*)
@@ -478,21 +481,36 @@
 		   (sync-in-progress *db-sync-in-progress*)
 		   (should-sync      (and (not *time-to-exit*)
                                           (> (- (current-seconds) *db-last-sync*) 5))) ;; sync every five seconds minimum
 		   (start-time       (current-seconds))
 		   (mt-mod-time      (file-modification-time mtpath))
-		   (recently-synced  (< (- start-time mt-mod-time) 4))
+		   (last-sync-start  (if (common:file-exists? start-file)
+					 (file-modification-time start-file)
+					 0))
+		   (last-sync-end    (if (common:file-exists? end-file)
+					 (file-modification-time end-file)
+					 10))
+		   (recently-synced  (and (< (- start-time mt-mod-time) 4) ;; not useful if sync didn't modify megatest.db!
+					  (< mt-mod-time last-sync-start)))
+		   (sync-done        (<= last-sync-start last-sync-end))
 		   (will-sync        (and (or need-sync should-sync)
+					  sync-done
 					  (not sync-in-progress)
 					  (not recently-synced))))
-              (debug:print-info 13 *default-log-port* "WD writable-watchdog top of loop.  need-sync="need-sync" sync-in-progress="sync-in-progress" should-sync="should-sync" start-time="start-time" mt-mod-time="mt-mod-time" recently-synced="recently-synced" will-sync="will-sync)
+              (debug:print-info 13 *default-log-port* "WD writable-watchdog top of loop.  need-sync="need-sync" sync-in-progress=" sync-in-progress
+				" should-sync="should-sync" start-time="start-time" mt-mod-time="mt-mod-time" recently-synced="recently-synced" will-sync="will-sync
+				" sync-done=" sync-done)
 	      ;; (if recently-synced (debug:print-info 0 *default-log-port* "Skipping sync due to recently-synced flag=" recently-synced))
 	      ;; (debug:print-info 0 *default-log-port* "need-sync: " need-sync " sync-in-progress: " sync-in-progress " should-sync: " should-sync " will-sync: " will-sync)
 	      (if will-sync (set! *db-sync-in-progress* #t))
 	      (mutex-unlock! *db-multi-sync-mutex*)
 	      (if will-sync
                   (let ((sync-start (current-milliseconds)))
+		    (with-output-to-file start-file (lambda ()(print (current-process-id))))
+
+		    ;; put lock here
+		    
                     (if (< sync-duration 300)
                         (let ((res        (db:sync-to-megatest.db dbstruct no-sync-db: no-sync-db))) ;; did we sync any data? If so need to set the db touched flag to keep the server alive
                           (set! sync-duration (- (current-milliseconds) sync-start))
                           (if (> res 0) ;; some records were transferred, keep the db alive
                               (begin
@@ -501,11 +519,11 @@
                                 (mutex-unlock! *heartbeat-mutex*)
                                 (debug:print-info 0 *default-log-port* "sync called, " res " records transferred."))
                               (debug:print-info 2 *default-log-port* "sync called but zero records transferred")))
                         ;; TODO: factor this next routine out into a function
                         (with-input-from-pipe ;; this should not block other threads but need to verify this
-                         "megatest -sync-to-megatest.db"
+                         (conc "megatest -sync-to-megatest.db -m testsuite:" (common:get-area-name) ":" *toppath*)
                          (lambda ()
                            (let loop ((inl (read-line))
                                       (res #f))
                              (if (eof-object? inl)
                                  (begin
@@ -526,10 +544,14 @@
 	      (if will-sync
 		  (begin
 		    (mutex-lock! *db-multi-sync-mutex*)
 		    (set! *db-sync-in-progress* #f)
 		    (set! *db-last-sync* start-time)
+		    (with-output-to-file end-file (lambda ()(print (current-process-id))))
+
+		    ;; release lock here
+
 		    (mutex-unlock! *db-multi-sync-mutex*)))
 	      (if (and debug-mode
 		       (> (- start-time last-time) 60))
 		  (begin
 		    (set! last-time start-time)