Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -43,16 +43,16 @@
 (define home (getenv "HOME"))
 (define user (getenv "USER"))
 
 ;; GLOBAL GLETCHES
 
-(define *contexts* (make-hash-table))
-
-;; Common data structure for 
+;; CONTEXTS
 (defstruct cxt
   (taskdb #f)
   (cmutex (make-mutex)))
+(define *contexts* (make-hash-table))
+(define *context-mutex* (make-mutex))
 
 ;; safe method for accessing a context given a toppath
 ;;
 (define (common:with-cxt toppath proc)
   (mutex-lock! *context-mutex*)
@@ -73,52 +73,57 @@
 (define *configdat*    #f)   ;; megatest.config data
 (define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
 (define *toppath*      #f)
 (define *already-seen-runconfig-info* #f)
 
-(define *waiting-queue*     (make-hash-table))
 (define *test-meta-updated* (make-hash-table))
 (define *globalexitstatus*  0) ;; attempt to work around possible thread issues
 (define *passnum*           0) ;; when running track calls to run-tests or similar
 (define *alt-log-file* #f)  ;; used by -log
 (define *common:denoise*    (make-hash-table)) ;; for low noise printing
 (define *default-log-port*  (current-error-port))
 (define *time-zero* (current-seconds)) ;; for the watchdog
 
 ;; DATABASE
-(define *dbstruct-db*         #f) ;; used when local access is triggered in rmt.scm
-
+(define *dbstruct-db*         #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this.
+;; db stats
 (define *db-stats*            (make-hash-table)) ;; hash of vectors < count duration-total >
 (define *db-stats-mutex*      (make-mutex))
-(define *db-sync-mutex*       (make-mutex))
-(define *db-multi-sync-mutex* (make-mutex))
-(define *db-local-sync*       (make-hash-table)) ;; used to record last touch of db
-(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened 
-(define *last-db-access*      (current-seconds)) ;; update when db is accessed via server
+;; db access
+(define *db-last-access*      (current-seconds)) ;; last db access, used in server
 (define *db-write-access*     #t)
+;; db sync
+(define *db-last-write*       0)                 ;; used to record last touch of db
+(define *db-last-sync*        0)                 ;; last time the sync to megatest.db happened
+(define *db-sync-in-progress* #f)                ;; if there is a sync in progress do not try to start another
+(define *db-multi-sync-mutex* (make-mutex))      ;; protect access to *db-sync-in-progress*, *db-last-sync* and *db-last-write*
+;; task db
 (define *task-db*             #f) ;; (vector db path-to-db)
 (define *db-access-allowed*   #t) ;; flag to allow access
 (define *db-access-mutex*     (make-mutex))
 (define *db-cache-path*       #f)
 
 ;; SERVER
 (define *my-client-signature* #f)
-(define *transport-type*    'http)
 (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)
 (define *server-info*       #f)
 (define *time-to-exit*      #f)
-(define *received-response* #f)
-(define *default-numtries*  10)
 (define *server-run*        #t)
 (define *run-id*            #f)
 (define *server-kind-run*   (make-hash-table))
 (define *home-host*         #f)
+(define *total-non-write-delay* 0)
+(define *heartbeat-mutex*   (make-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
 (define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
@@ -127,11 +132,10 @@
 
 (define *run-info-cache*    (make-hash-table)) ;; run info is stable, no need to reget
 
 ;; Awful. Please FIXME
 (define *env-vars-by-run-id* (make-hash-table))
-(define *current-run-name*   #f)
 
 ;; Testconfig and runconfig caches. 
 (define *testconfigs*       (make-hash-table)) ;; test-name => testconfig
 (define *runconfigs*        (make-hash-table)) ;; target    => runconfig
 
@@ -189,13 +193,13 @@
 	       (common:version-signature))))
 
 ;; Move me elsewhere ...
 ;; RADT => Why do we meed the version check here, this is called only if version misma
 ;;
-(define (common:cleanup-db)
+(define (common:cleanup-db dbstruct)
   (db:multi-db-sync 
-   #f ;; do all run-ids
+   dbstruct
    ;; 'new2old
    'killservers
    'dejunk
    ;; 'adj-testids
    ;; 'old2new
@@ -504,86 +508,72 @@
 
 ;;======================================================================
 ;; E X I T   H A N D L I N G
 ;;======================================================================
 
-(define (common:legacy-sync-recommended)
-  (or (and (common:get-homehost)
-	   (cdr (common:get-homehost)))
-      ;;(args:get-arg "-runtests")
-      ;;(args:get-arg "-run")
-      (args:get-arg "-server")
-      ;; (args:get-arg "-set-run-status")
-      ;;(args:get-arg "-remove-runs")
-      ;; (args:get-arg "-get-run-status")
-      ;;(args:get-arg "-use-db-cache") ;; feels like a bad idea ...
-      ))
-
-(define (common:legacy-sync-required)
-  (configf:lookup *configdat* "setup" "megatest-db"))
-
-;; run-ids
+(define (common:run-sync?)
+  (and (common:on-homehost?)
+       (args:get-arg "-server")))
+
+;;;; run-ids
 ;;    if #f use *db-local-sync* : or 'local-sync-flags
 ;;    if #t use timestamps      : or 'timestamps
-(define (common:sync-to-megatest.db run-ids) 
-  (let ((start-time         (current-seconds))
-        (run-ids-to-process (if (list? run-ids)
-                                run-ids
-                                (if (or (eq? run-ids 'timestamps)(eq? run-ids #t))
-                                    (db:get-changed-run-ids (let* ((mtdb-fpath (conc *toppath* "/megatest.db"))
-                                                                   (mtdb-exists (file-exists? mtdb-fpath)))
-                                                              (if mtdb-exists
-                                                                  (file-modification-time mtdb-fpath)
-                                                                  0)))
-                                    (hash-table-keys *db-local-sync*)))))
-    (debug:print-info 4 *default-log-port* "Processing run-ids: " run-ids-to-process)
-    (for-each 
-     (lambda (run-id)
-       (mutex-lock! *db-multi-sync-mutex*)
-       (if (or run-ids ;; if we were provided with run-ids, proceed
-               (hash-table-ref/default *db-local-sync* run-id #f))
-           ;; (if (> (- start-time last-write) 5) ;; every five seconds
-           (begin ;; let ((sync-time (- (current-seconds) start-time)))
-             (db:multi-db-sync (list run-id) 'new2old)
-             (let ((sync-time (- (current-seconds) start-time)))
-               (debug:print-info 3 *default-log-port* "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")
-               (if (common:low-noise-print 30 "sync new to old")
-                   (debug:print-info 0 *default-log-port* "Sync of newdb to olddb for run-id " run-id " completed in " sync-time " seconds")))
-             (hash-table-delete! *db-local-sync* run-id)))
-       (mutex-unlock! *db-multi-sync-mutex*))
-     run-ids-to-process)))
-
+(define (common:sync-to-megatest.db dbstruct) 
+  (let ((start-time         (current-seconds)))
+    (db:multi-db-sync dbstruct 'new2old)
+    (let ((sync-time (- (current-seconds) start-time)))
+      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds")
+      (if (common:low-noise-print 30 "sync new to old")
+	  (debug:print-info 0 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds")))))
+
+;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp
+;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server)
+;;
 (define (common:watchdog)
   (thread-sleep! 0.05) ;; delay for startup
-  (let ((legacy-sync (common:legacy-sync-required))
+  (let ((legacy-sync (common:run-sync?))
 	(debug-mode  (debug:debug-mode 1))
 	(last-time   (current-seconds)))
-    (if (or (common:legacy-sync-recommended)
-	    legacy-sync)
-	(let loop ()
-	  ;; sync for filesystem local db writes
-	  ;;
-	  (let ((start-time   (current-seconds)))
-	    ;; (common:sync-to-megatest.db 'local-sync-flags)
-	    (if (and debug-mode
-		     (> (- start-time last-time) 60))
-		(begin
-		  (set! last-time start-time)
-		  (debug:print-info 4 *default-log-port* "timestamp -> " (seconds->time-string (current-seconds)) ", time since start -> " (seconds->hr-min-sec (- (current-seconds) *time-zero*))))))
-
-	  ;; keep going unless time to exit
-	  ;;
-	  (if (not *time-to-exit*)
-	      (let delay-loop ((count 0))
-		(if (and (not *time-to-exit*)
-			 (< count 4)) ;; was 11, changing to 4. 
-		    (begin
-		      (thread-sleep! 1)
-		      (delay-loop (+ count 1))))
-		(loop)))
-	  (if (common:low-noise-print 30)
-	      (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*))))))
+    (if legacy-sync
+	(let ((dbstruct (db:setup)))
+	  (let loop ()
+	    ;; sync for filesystem local db writes
+	    ;;
+	    (mutex-lock! *db-multi-sync-mutex*)
+	    (let* ((need-sync        (>= *db-last-write* *db-last-sync*)) ;; no sync since last write
+		   (sync-in-progress *db-sync-in-progress*)
+		   (should-sync      (> (- (current-seconds) *db-last-sync*) 5)) ;; sync every five seconds minimum
+		   (will-sync        (and (or need-sync should-sync)
+					  (not sync-in-progress)))
+		   (start-time       (current-seconds)))
+	      (if will-sync (set! *db-sync-in-progress* #t))
+	      (mutex-unlock! *db-multi-sync-mutex*)
+	      (if will-sync (common:sync-to-megatest.db dbstruct)) 
+	      (if will-sync
+		  (begin
+		    (mutex-lock! *db-multi-sync-mutex*)
+		    (set! db-sync-in-progress* #f)
+		    (set! *db-last-sync* start-time)
+		    (mutex-unlock! *db-multi-sync-mutex*)))
+	      (if (and debug-mode
+		       (> (- start-time last-time) 60))
+		  (begin
+		    (set! last-time start-time)
+		    (debug:print-info 4 *default-log-port* "timestamp -> " (seconds->time-string (current-seconds)) ", time since start -> " (seconds->hr-min-sec (- (current-seconds) *time-zero*))))))
+	    
+	    ;; keep going unless time to exit
+	    ;;
+	    (if (not *time-to-exit*)
+		(let delay-loop ((count 0))
+		  (if (and (not *time-to-exit*)
+			   (< count 4)) ;; was 11, changing to 4. 
+		      (begin
+			(thread-sleep! 1)
+			(delay-loop (+ count 1))))
+		  (loop)))
+	    (if (common:low-noise-print 30)
+		(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*)))))))
 
 (define (std-exit-procedure)
   (let ((no-hurry  (if *time-to-exit* ;; hurry up
 		       #f
 		       (begin
@@ -821,10 +811,18 @@
 				   #f)))))
 	   (at-home  (or (equal? homehost currhost)
 			 (equal? homehost bestadrs))))
       (set! *home-host* (cons homehost at-home))
       *home-host*))))
+
+;; am I on the homehost?
+;;
+(define (common:on-homehost?)
+  (let ((hh (common:get-homehost)))
+    (if hh
+	(cdr hh)
+	#f)))
 
 ;;======================================================================
 ;; M I S C   L I S T S
 ;;======================================================================
 

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -249,11 +249,11 @@
 ;;     (db:sync-tables db:sync-tests-only *megatest-db* db)
 ;;     db))
 
 ;; This routine creates the db if not already present. It is only called if the db is not already opened
 ;;
-(define (db:open-db dbstruct #!key (areapath #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*))) 
+(define (db:open-db dbstruct #!key (areapath #f))
   (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct
     (if tmpdb
 	tmpdb
         ;; (mutex-lock! *rundb-mutex*)
         (let* ((dbpath       (db:dbfile-path)) ;;  0))
@@ -268,24 +268,27 @@
           (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb) ;; olddb is already a (cons db path)
           (dbr:dbstruct-refndb-set! dbstruct refndb)
           ;;	    (mutex-unlock! *rundb-mutex*)
           (if (and (not dbexists)
                    *db-write-access*) ;; did not have a prior db and do have write access
-              (db:multi-db-sync #f 'old2new))  ;; migrate data from megatest.db automatically
+              (db:multi-db-sync dbstruct 'old2new))  ;; migrate data from megatest.db automatically
           tmpdb))))
 
 ;; Make the dbstruct, setup up auxillary db's and call for main db at least once
 ;;
 ;; called in http-transport and replicated in rmt.scm for *local* access. 
 ;;
-(define (db:setup #!key (areapath #f)) ;;  . junk) ;;  #!key (run-id #f) (local #f))
+(define (db:setup #!key (areapath #f))
   (or *dbstruct-db*
-      (let* (;; (dbdir    (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
-	     (dbstruct (make-dbr:dbstruct))) ;; ) ;;  path: dbdir local: local)))
-	(db:open-db dbstruct areapath: #f)
-	(set! *dbstruct-db* dbstruct)
-	dbstruct)))
+      (if (common:on-homehost?)
+	  (let* ((dbstruct (make-dbr:dbstruct)))
+	    (db:open-db dbstruct areapath: #f)
+	    (set! *dbstruct-db* dbstruct)
+	    dbstruct)
+	  (begin
+	    (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting.")
+	    (exit 1)))))
 
 ;; Open the classic megatest.db file (defaults to open in toppath)
 ;;
 ;;   NOTE: returns a dbdat not a dbstruct!
 ;;
@@ -302,78 +305,22 @@
     (cons db dbpath)))
 
 ;; sync run to disk if touched
 ;;
 (define (db:sync-touched dbstruct run-id #!key (force-sync #f))
-  (let (;; (mtime  (dbr:dbstruct-mtime dbstruct))
-	;; (stime  (dbr:dbstruct-stime dbstruct))
-	;; (rundb  (dbr:dbstruct-rundb dbstruct))
-	;; (inmem  (dbr:dbstruct-inmem dbstruct))
-	;; (maindb (dbr:dbstruct-main  dbstruct))
-	;; (refdb  (dbr:dbstruct-refdb dbstruct))
-        (tmpdb   (dbr:dbstruct-tmpdb dbstruct))
-	(mtdb    (dbr:dbstruct-mtdb dbstruct))
+  (let ((tmpdb   (dbr:dbstruct-tmpdb  dbstruct))
+	(mtdb    (dbr:dbstruct-mtdb   dbstruct))
         (refndb  (dbr:dbstruct-refndb dbstruct))
-	(start-t (current-seconds))
-	;; (runid  (dbr:dbstruct-run-id dbstruct))
-	)
+	(start-t (current-seconds)))
     (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
-    (mutex-lock! *db-sync-mutex*)
-    (db:sync-tables (db:sync-all-tables-list dbstruct) (cons *db-last-sync* "last_update") tmpdb refndb mtdb)
+    (mutex-lock! *db-multi-sync-mutex*)
+    (let ((update_info (cons (if force-sync 0 *db-last-sync*) "last_update")))
+      (mutex-unlock! *db-multi-sync-mutex*)
+      (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb refndb mtdb))
+    (mutex-lock! *db-multi-sync-mutex*)
     (set! *db-last-sync* start-t)
-    (mutex-unlock! *db-sync-mutex*)))
-;;    (if (eq? run-id 0)
-;;	;; runid equal to 0 is main.db
-;;	(if maindb
-;;	    (if (or (not (number? mtime))
-;;		    (not (number? stime))
-;;		    (> mtime stime)
-;;		    force-sync)
-;;		(begin
-;;		  (db:delay-if-busy maindb)
-;;		  (db:delay-if-busy olddb)
-;;		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
-;;		    (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
-;;		    num-synced)
-;;		  0))
-;;	    (begin
-;;	      ;; this can occur when using local access (i.e. not in a server)
-;;	      ;; need a flag to turn it off.
-;;	      ;;
-;;	      (debug:print 3 *default-log-port* "WARNING: call to sync main.db to megatest.db but main not initialized")
-;;	      0))
-;;	;; any other runid is a run
-;;	(if (or (not (number? mtime))
-;;		(not (number? stime))
-;;		(> mtime stime)
-;;		force-sync)
-;;	    (begin
-;;	      (db:delay-if-busy rundb)
-;;	      (db:delay-if-busy olddb)
-;;	      (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
-;;	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
-;;		;; (mutex-unlock! *http-mutex*)
-;;		num-synced)
-;;	      (begin
-;;		;; (mutex-unlock! *http-mutex*)
-;;		0))))))
-
-;; (define (db:close-main dbstruct)
-;;   (let ((maindb (dbr:dbstruct-main dbstruct)))
-;;     (if maindb
-;; 	(begin
-;; 	  (sqlite3:finalize! (db:dbdat-get-db maindb))
-;; 	  (dbr:dbstruct-main-set! dbstruct #f)))))
-;; 
-;; (define (db:close-run-db dbstruct run-id)
-;;   (let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
-;;     (if (and rdb
-;; 	     (sqlite3:database? rdb))
-;; 	(begin
-;; 	  (sqlite3:finalize! rdb)
-;; 	  (dbr:dbstruct-localdb-set! dbstruct run-id #f)
-;; 	  (dbr:dbstruct-inmem-set! dbstruct #f)))))
+    (mutex-unlock! *db-multi-sync-mutex*)))
 
 ;; close all opened run-id dbs
 (define (db:close-all dbstruct)
   (if (dbr:dbstruct? dbstruct)
       (begin
@@ -559,15 +506,13 @@
 ;; if last-update specified ("field-name" . time-in-seconds)
 ;;    then sync only records where field-name >= time-in-seconds
 ;;    IFF field-name exists
 ;;
 (define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
-  (mutex-lock! *db-sync-mutex*)
   (handle-exceptions
    exn
    (begin
-     (mutex-unlock! *db-sync-mutex*)
      (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
      (print-call-chain (current-error-port))
      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
      (print "exn=" (condition->list exn))
      (debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
@@ -580,19 +525,11 @@
 			 (debug:print-error 0 *default-log-port* "Failed to rebuild " dbpath ", exiting now.")
 			 (exit)))))
 	       (cons todb slave-dbs))
      
      0)
-;;      (if *server-run* ;; we are inside a server, throw a sync-failed error
-;; 	 (signal (make-composite-condition
-;; 		 (make-property-condition 'sync-failed 'message "db:sync-tables failed in a server context.")))
-;; 	 0)) ;; return zero for num synced
-
-	 ;; (set! *time-to-exit* #t) ;; let watch dog know that it is time to die.
-	 ;; (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "shutting-down")
-	 ;; (portlogger:open-run-close portlogger:set-port port "released")
-	 ;; (exit 1)))
+   ;; this is the work to be done
    (cond
     ((not fromdb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with fromdb missing") -1)
     ((not todb)   (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with todb missing") -2)
     ((not (sqlite3:database? (db:dbdat-get-db fromdb)))
      (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb) -3)
@@ -709,13 +646,11 @@
 		  (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))))))
 	  (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
-       tot-count)))
-   (mutex-unlock! *db-sync-mutex*)))
-
+       tot-count)))))
 
 (define (db:patch-schema-rundb frundb)
   ;;
   ;; remove this some time after September 2016 (added in version v1.6031
   ;;
@@ -855,21 +790,17 @@
 ;;  'closeall     - close all opened dbs
 ;;  'schema       - attempt to apply schema changes
 ;;
 ;;  run-ids: '(1 2 3 ...) or #f (for all)
 ;;
-(define (db:multi-db-sync run-ids . options)
+(define (db:multi-db-sync dbstruct . options)
   (if (not (launch:setup))
       (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
-      (let* ((dbstruct (db:setup))
-	     (mtdb     (dbr:dbstruct-mtdb dbstruct))
+      (let* ((mtdb     (dbr:dbstruct-mtdb dbstruct))
 	     (tmpdb    (dbr:dbstruct-tmpdb dbstruct))
              (refndb   (dbr:dbstruct-refndb dbstruct))
-	     (allow-cleanup (if run-ids #f #t))
-;; 	     (run-ids  (if run-ids 
-;; 			   run-ids
-;; 			   (db:get-all-run-ids mtdb)))
+	     (allow-cleanup #t) ;; (if run-ids #f #t))
 	     (tdbdat  (tasks:open-db))
 	     (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
     
 	;; kill servers
 	(if (member 'killservers options)
@@ -993,12 +924,14 @@
 	)))
 
 ;; keeping it around for debugging purposes only
 (define (open-run-close-no-exception-handling  proc idb . params)
   (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
+  (print "I don't work anymore. open-run-close-no-exception-handling needs fixing or removing...")
+  (exit)
   (if (or *db-write-access*
-	  (not (member proc *db:all-write-procs*)))
+	  (not #t)) ;; was: (member proc * db:all-write-procs *)))
       (let* ((db (cond
 		  ((pair? idb)                 (db:dbdat-get-db idb))
 		  ((sqlite3:database? idb)     idb)
 		  ((not idb)                   (debug:print-error 0 *default-log-port* "cannot open-run-close with #f anymore"))
 		  ((procedure? idb)            (idb))
@@ -1376,11 +1309,11 @@
 
 ;;======================================================================
 ;; L O G G I N G    D B 
 ;;======================================================================
 
-(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
+(define (open-logging-db)
   (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
 	 (dbexists  (file-exists? dbpath))
 	 (db        (sqlite3:open-database dbpath))
 	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
 					   (string->number (args:get-arg "-override-timeout"))
@@ -3176,11 +3109,11 @@
     (if (and test-id state status (equal? status "AUTO")) 
 	(db:test-data-rollup dbstruct run-id test-id status))
     (mt:process-triggers run-id test-id state status)))
 
 ;; state is the priority rollup of all states
-;; status is the priority rollup of all completed states
+;; status is the priority rollup of all completed statesfu
 ;;
 ;; if test-name is an integer work off that instead of test-name test-path
 ;;
 (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
   ;; establish info on incoming test followed by info on top level test

DELETED debugger.scm
Index: debugger.scm
==================================================================
--- debugger.scm
+++ /dev/null
@@ -1,73 +0,0 @@
-(use iup)
-
-(define *debugger-control* #f)
-(define *debugger-rownum*  0)
-(define *debugger-matrix*  #f)
-(define *debugger*         #f)
-
-(define (debugger)
-  (if (not *debugger*)
-      (set! *debugger* 
-	    (thread-start!
-	     (make-thread
-	      (lambda ()
-		(show
-		 (dialog
-		  (let ((pause #f)
-			(mtrx  (matrix
-				#:expand "YES"
-				#:numlin 30
-				#:numcol 3
-				#:numlin-visible 20
-				#:numcol-visible 2
-				#:alignment1 "ALEFT"
-				)))
-		    (set! pause (button "Pause" 
-					#:action (lambda (obj)
-						   (set! *debugger-control* (not *debugger-control*))
-						   (attribute-set! pause "BGCOLOR" (if *debugger-control*
-										       "200 0 0"
-										       "0 0 200")))))
-		    (set! *debugger-matrix* mtrx)
-		    (attribute-set! mtrx "WIDTH1" "300")
-		    (vbox
-		     mtrx
-		     (hbox
-		      pause)))))
-		(main-loop)))))))
-
-(define (debugger-start #!key (start 2))
-  (set! *debugger-rownum* start))
-
-(define (debugger-trace-var varname varval)
-  (let ((oldval (attribute *debugger-matrix* (conc *debugger-rownum* ":1")))
-	(newval (conc varval)))
-    (if (not (equal? oldval newval))
-	(begin
-	  ;; (print "DEBUG: " varname " = " newval)
-	  (attribute-set! *debugger-matrix* (conc *debugger-rownum* ":0") varname)
-	  (attribute-set! *debugger-matrix* (conc *debugger-rownum* ":1") (conc varval))
-	  ;; (attribute-set! *debugger-matrix* "FITTOTEXT" "C1")
-	  ))
-    (set! *debugger-rownum* (+ *debugger-rownum* 1))))
-
-
-(define (debugger-pauser)
-  (debugger)
-  (attribute-set! *debugger-matrix* "REDRAW" "ALL")
-  (let loop ()
-    (if *debugger-control*
-	(begin
-	  (print "PAUSED!")
-	  (thread-sleep! 1)
-	  (loop))
-	;;(thread-sleep! 0.01)
-	)))
-		  
-;;    ;; lets use the debugger eh?
-;;    (debugger-start)
-;;    (debugger-trace-var "can-run-more"     can-run-more)
-;;    (debugger-trace-var "hed"              hed)
-;;    (debugger-trace-var "prereqs-not-met"  (runs:pretty-string prereqs-not-met))
-;;    (debugger-pauser)
-

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -36,11 +36,10 @@
   (if (not hostport)
       #f
       (conc "http://" (car hostport) ":" (cadr hostport))))
 
 (define *server-loop-heart-beat* (current-seconds))
-(define *heartbeat-mutex* (make-mutex))
 
 ;;======================================================================
 ;; S E R V E R
 ;;======================================================================
 
@@ -84,11 +83,11 @@
 				  ((equal? (uri-path (request-uri (current-request)))
 					   '(/ "api"))
 				   (send-response body:    (api:process-request *dbstruct-db* $) ;; the $ is the request vars proc
 						  headers: '((content-type text/plain)))
 				   (mutex-lock! *heartbeat-mutex*)
-				   (set! *last-db-access* (current-seconds))
+				   (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))) 
@@ -394,39 +393,16 @@
 	       (server-state 'available)
 	       (bad-sync-count 0))
 
       ;; Use this opportunity to sync the tmp db to megatest.db
       (if *dbstruct-db* 
-	  (let ((start-time (current-milliseconds))
-		(sync-time  #f)
-		(rem-time   #f))
-	    (condition-case
-	     ;; (if (and (member (mutex-state *db-sync-mutex*) '(abandoned not-abandoned))
-	     ;;	      (> (- (current-seconds) *db-last-sync*) 5)) ;; if not currently being synced nor recently synced
-	     (db:sync-touched *dbstruct-db* *run-id* force-sync: #t) ;; usually done in the watchdog, not here.
-	     ((sync-failed)(cond
-			    ((> bad-sync-count 10) ;; time to give up
-			     (http-transport:server-shutdown server-id port))
-			    (else ;; (> bad-sync-count 0)  ;; we've had a fail or two, delay and loop
-			     (thread-sleep! 5)
-			     (loop count server-state (+ bad-sync-count 1)))))
-	     ((exn)
-	      (debug:print-error 0 *default-log-port* "error from sync code other than 'sync-failed. Attempting to gracefully shutdown the server")
-	      (tasks:server-delete-record (db:delay-if-busy tdbdat) server-id " http-transport:keep-running crashed")
-	      (exit)))
-	    (set! sync-time  (- (current-milliseconds) start-time))
-	    (set! rem-time (quotient (- 4000 sync-time) 1000))
-	    (debug:print 4 *default-log-port* "SYNC: time= " sync-time ", rem-time=" rem-time)
-	    
-	    (if (and (<= rem-time 4)
-		     (> rem-time 0))
-		(thread-sleep! rem-time)
-		(thread-sleep! 4))) ;; fallback for if the math is changed ...
-
-	  ;;
+ 	  (let ((start-time (current-milliseconds))
+ 		(sync-time  #f)
+ 		(rem-time   #f))
+	    (thread-sleep! 4))
+	  ;; Removed code is pasted below (keeping it around until we are clear it is not needed).
 	  ;; no *dbstruct-db* yet, set running after our first pass through and start the db
-	  ;;
 	  (if (eq? server-state 'available)
 	      (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
 		(if (equal? new-server-id server-id)
 		    (begin
 		      (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
@@ -451,13 +427,13 @@
 	  (begin 
 	    (debug:print-info 0 *default-log-port* "interface changed, refreshing iface and port info")
 	    (set! iface (car sdat))
 	    (set! port  (cadr sdat))))
       
-      ;; Transfer *last-db-access* to last-access to use in checking that we are still alive
+      ;; Transfer *db-last-access* to last-access to use in checking that we are still alive
       (mutex-lock! *heartbeat-mutex*)
-      (set! last-access *last-db-access*)
+      (set! last-access *db-last-access*)
       (mutex-unlock! *heartbeat-mutex*)
 
       ;; (debug:print 11 *default-log-port* "last-access=" last-access ", server-timeout=" server-timeout)
       ;;
       ;; no_traffic, no running tests, if server 0, no running servers
@@ -483,11 +459,36 @@
 	      ;; (if (tasks:server-am-i-the-server? tdb run-id)
 	      ;;     (tasks:server-set-state! tdb server-id "running"))
 	      ;;
 	      (loop 0 server-state bad-sync-count))
 	    (http-transport:server-shutdown server-id port))))))
-  
+
+;; code cut out from above
+;;
+;; (condition-case
+;;  ;; (if (and (member (mutex-state *db-sync-mutex*) '(abandoned not-abandoned))
+;;  ;;	      (> (- (current-seconds) *db-last-sync*) 5)) ;; if not currently being synced nor recently synced
+;;  (db:sync-touched *dbstruct-db* *run-id* force-sync: #t) ;; usually done in the watchdog, not here.
+;;  ((sync-failed)(cond
+;; 		    ((> bad-sync-count 10) ;; time to give up
+;; 		     (http-transport:server-shutdown server-id port))
+;; 		    (else ;; (> bad-sync-count 0)  ;; we've had a fail or two, delay and loop
+;; 		     (thread-sleep! 5)
+;; 		     (loop count server-state (+ bad-sync-count 1)))))
+;;  ((exn)
+;;   (debug:print-error 0 *default-log-port* "error from sync code other than 'sync-failed. Attempting to gracefully shutdown the server")
+;;   (tasks:server-delete-record (db:delay-if-busy tdbdat) server-id " http-transport:keep-running crashed")
+;;   (exit)))
+;; (set! sync-time  (- (current-milliseconds) start-time))
+;; (set! rem-time (quotient (- 4000 sync-time) 1000))
+;; (debug:print 4 *default-log-port* "SYNC: time= " sync-time ", rem-time=" rem-time)
+;; 
+;; (if (and (<= rem-time 4)
+;; 	     (> rem-time 0))
+;; 	(thread-sleep! rem-time)
+;; 	(thread-sleep! 4))) ;; fallback for if the math is changed ...
+
 (define (http-transport:server-shutdown server-id port)
   (let ((tdbdat (tasks:open-db)))
     (debug:print-info 0 *default-log-port* "Starting to shutdown the server.")
     ;; need to delete only *my* server entry (future use)
     ;; (if *dbstruct-db* (db:sync-touched *dbstruct-db* *run-id* force-sync: #t)) ;; handled in the watchdog only
@@ -632,11 +633,11 @@
 	       "<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 *last-db-access*) "</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)

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -1951,11 +1951,11 @@
 ;; ;; ;; redo me       (set! *didsomething* #t)))
 
 (if (args:get-arg "-import-megatest.db")
     (begin
       (db:multi-db-sync 
-       #f ;; do all run-ids
+       (db:setup)
        'killservers
        'dejunk
        'adj-testids
        'old2new
        ;; 'new2old
@@ -1963,11 +1963,11 @@
       (set! *didsomething* #t)))
 
 (if (args:get-arg "-sync-to-megatest.db")
     (begin
       (db:multi-db-sync 
-       #f ;; do all run-ids
+       (db:setup)
        'new2old
        )
       (set! *didsomething* #t)))
 
 (if (args:get-arg "-generate-html")

DELETED newdashboard.scm
Index: newdashboard.scm
==================================================================
--- newdashboard.scm
+++ /dev/null
@@ -1,635 +0,0 @@
-;;======================================================================
-;; Copyright 2006-2013, Matthew Welland.
-;; 
-;;  This program is made available under the GNU GPL version 2.0 or
-;;  greater. See the accompanying file COPYING for details.
-;; 
-;;  This program is distributed WITHOUT ANY WARRANTY; without even the
-;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-;;  PURPOSE.
-;;======================================================================
-
-(use format numbers)
-(require-library iup)
-(import (prefix iup iup:))
-(use canvas-draw)
-
-(use sqlite3 srfi-1 posix regex regex-case srfi-69)
-(import (prefix sqlite3 sqlite3:))
-
-(declare (uses margs))
-(declare (uses launch))
-(declare (uses megatest-version))
-(declare (uses gutils))
-(declare (uses db))
-(declare (uses server))
-(declare (uses synchash))
-(declare (uses dcommon))
-(declare (uses tree))
-
-(include "common_records.scm")
-(include "db_records.scm")
-(include "key_records.scm")
-
-(define help (conc 
-"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
-  version " megatest-version "
-  license GPL, Copyright (C) Matt Welland 2011
-
-Usage: dashboard [options]
-  -h                : this help
-  -server host:port : connect to host:port instead of db access
-  -test testid      : control test identified by testid
-  -guimonitor       : control panel for runs
-
-Misc
-  -rows N         : set number of rows
-"))
-
-;; process args
-(define remargs (args:get-args 
-		 (argv)
-		 (list  "-rows"
-			"-run"
-			"-test"
-			"-debug"
-			"-host" 
-			) 
-		 (list  "-h"
-			"-guimonitor"
-			"-main"
-			"-v"
-			"-q"
-		       )
-		 args:arg-hash
-		 0))
-
-(if (args:get-arg "-h")
-    (begin
-      (print help)
-      (exit)))
-
-(if (not (launch:setup))
-    (begin
-      (print "Failed to find megatest.config, exiting") 
-      (exit 1)))
-
-;; (if (args:get-arg "-host")
-;;     (begin
-;;       (set! *runremote* (string-split (args:get-arg "-host" ":")))
-;;       (client:launch))
-;;     (client:launch))
-
-;; ease debugging by loading ~/.dashboardrc
-(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
-  (if (file-exists? debugcontrolf)
-      (load debugcontrolf)))
-
-(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
-(define *dbstruct-local*  (make-dbr:dbstruct path:  *dbdir*
-					     local: #t))
-(define *db-file-path* (db:dbfile-path 0))
-
-;; HACK ALERT: this is a hack, please fix.
-(define *read-only* (not (file-read-access? *db-file-path*)))
-
-(debug:setup)
-
-(define *tim* (iup:timer))
-(define *ord* #f)
-
-(iup:attribute-set! *tim* "TIME" 300)
-(iup:attribute-set! *tim* "RUN" "YES")
-
-(define (message-window msg)
-  (iup:show
-   (iup:dialog
-    (iup:vbox 
-     (iup:label msg #:margin "40x40")))))
-
-(define (iuplistbox-fill-list lb items . default)
-  (let ((i 1)
-	(selected-item (if (null? default) #f (car default))))
-    (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
-    (for-each (lambda (item)
-		(iup:attribute-set! lb (number->string i) item)
-		(if selected-item
-		    (if (equal? selected-item item)
-			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
-		(set! i (+ i 1)))
-	      items)
-    i))
-
-(define (pad-list l n)(append l (make-list (- n (length l)))))
-
-
-(define (mkstr . x)
-  (string-intersperse (map conc x) ","))
-
-(define (update-search x val)
-  (hash-table-set! *searchpatts* x val))
-
-;; mtest is actually the megatest.config file
-;;
-(define (mtest window-id)
-  (let* ((curr-row-num     0)
-	 (rawconfig        (read-config (conc *toppath* "/megatest.config") #f 'return-string))
-	 (keys-matrix      (dcommon:keys-matrix rawconfig))
-	 (setup-matrix     (dcommon:section-matrix rawconfig "setup" "Varname" "Value"))
-	 (jobtools-matrix  (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 5
-			    #:numcol-visible 1
-			    #:numlin-visible 3))
-	 (validvals-matrix (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 2
-			    #:numcol-visible 1
-			    #:numlin-visible 2))
-	 (envovrd-matrix   (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 20
-			    #:numcol-visible 1
-			    #:numlin-visible 8))
-	 (disks-matrix     (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 20
-			    #:numcol-visible 1
-			    #:numlin-visible 8))
-	 )
-    (iup:attribute-set! disks-matrix "0:0" "Disk Name")
-    (iup:attribute-set! disks-matrix "0:1" "Disk Path")
-    (iup:attribute-set! disks-matrix "WIDTH1" "120")
-    (iup:attribute-set! disks-matrix "WIDTH0" "100")
-    (iup:attribute-set! disks-matrix "ALIGNMENT1" "ALEFT")
-    (iup:attribute-set! disks-matrix "FIXTOTEXT" "C1")
-    (iup:attribute-set! disks-matrix "RESIZEMATRIX" "YES")
-
-    ;; fill in existing info
-    (for-each 
-     (lambda (mat fname)
-       (set! curr-row-num 1)
-       (for-each
-	(lambda (var)
-	  (iup:attribute-set! mat (conc curr-row-num ":0") var)
-	  (iup:attribute-set! mat (conc curr-row-num ":1") (config-lookup rawconfig fname var))
-	  (set! curr-row-num (+ curr-row-num 1)))
-	(configf:section-vars rawconfig fname)))
-     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix)
-     (list "setup"      "jobtools"      "validvalues"      "env-override" "disks"))
-
-    (for-each
-     (lambda (mat)
-       (iup:attribute-set! mat "0:1" "Value")
-       (iup:attribute-set! mat "0:0" "Var")
-       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
-       (iup:attribute-set! mat "FIXTOTEXT" "C1")
-       (iup:attribute-set! mat "RESIZEMATRIX" "YES")
-       (iup:attribute-set! mat "WIDTH1" "120")
-       (iup:attribute-set! mat "WIDTH0" "100")
-       )
-     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix))
-
-    (iup:attribute-set! validvals-matrix "WIDTH1" "290")
-    (iup:attribute-set! envovrd-matrix   "WIDTH1" "290")
-
-    (iup:vbox
-     (iup:hbox
-       
-      (iup:vbox
-       (let ((tabs (iup:tabs 
-		    ;; The required tab
-		    (iup:hbox
-		     ;; The keys
-		     (iup:frame 
-		      #:title "Keys (required)"
-		      (iup:vbox
-		       (iup:label (conc "Set the fields for organising your runs\n"
-					"here. Note: can only be changed before\n"
-					"running the first run when megatest.db\n"
-					"is created."))
-		       keys-matrix))
-		     (iup:vbox
-		      ;; The setup section
-		      (iup:frame
-		       #:title "Setup"
-		       (iup:vbox
-			(iup:label (conc "max_concurrent_jobs : limits total concurrent jobs (optional)\n"
-					 "linktree : directory where linktree will be created."))
-			setup-matrix))
-		      ;; The jobtools
-		      (iup:frame
-		       #:title "Jobtools"
-		       (iup:vbox 
-			(iup:label (conc "launcher : tool or script to run jobs (try nbfake)\n"
-					 "useshell : use system to run your launcher\n"
-					 "workhosts : spread jobs out on these hosts"))
-			jobtools-matrix))
-		      ;; The disks
-		      (iup:frame
-		       #:title "Disks"
-		       (iup:vbox
-			(iup:label (conc "Enter names and existing paths of locations to run tests")) 
-			disks-matrix))))
-		    ;; The optional tab
-		    (iup:vbox
-		     ;; The Environment Overrides
-		     (iup:frame 
-		      #:title "Env override"
-		      envovrd-matrix)
-		     ;; The valid values
-		     (iup:frame
-		      #:title "Validvalues"
-		      validvals-matrix)
-		     ))))
-	 (iup:attribute-set! tabs "TABTITLE0" "Required settings")
-	 (iup:attribute-set! tabs "TABTITLE1" "Optional settings")
-	 tabs))
-       ))))
-
-;; The runconfigs.config file
-;;
-(define (rconfig window-id)
-  (iup:vbox
-   (iup:frame #:title "Default")))
-
-;;======================================================================
-;; T E S T S
-;;======================================================================
-
-(define (tree-path->test-id path)
-  (if (not (null? path))
-      (hash-table-ref/default (dboard:data-path-test-ids *data*) path #f)
-      #f))
-
-(define (test-panel window-id)
-  (let* ((curr-row-num 0)
-	 (viewlog    (lambda (x)
-		       (if (file-exists? logfile)
-					;(system (conc "firefox " logfile "&"))
-			   (iup:send-url logfile)
-			   (message-window (conc "File " logfile " not found")))))
-	 (xterm      (lambda (x)
-		       (if (directory-exists? rundir)
-			   (let ((shell (if (get-environment-variable "SHELL") 
-					    (conc "-e " (get-environment-variable "SHELL"))
-					    "")))
-			     (system (conc "cd " rundir 
-					   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
-			   (message-window  (conc "Directory " rundir " not found")))))
-	 (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -12"))
-	 (command-launch-button (iup:button "Execute!" 
-					    ;; #:expand "HORIZONTAL"
-					    #:size "50x"
-					    #:action (lambda (x)
-						       (let ((cmd (iup:attribute command-text-box "VALUE")))
-							 (system (conc cmd "  &"))))))
-	 (run-test  (lambda (x)
-		      (iup:attribute-set! 
-		       command-text-box "VALUE"
-		       (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname 
-			     " -runtests " (conc testname "/" (if (equal? item-path "")
-								  "%" 
-								  item-path))
-			     ";echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
-	 (remove-test (lambda (x)
-			(iup:attribute-set!
-			 command-text-box "VALUE"
-			 (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname
-			       " -testpatt " (conc testname "/" (if (equal? item-path "")
-								    "%"
-								    item-path))
-			       " -v;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
-    	 (run-info-matrix  (iup:matrix 		            
-			    #:expand "YES"
-			    ;; #:scrollbar "YES"
-			    #:numcol 1
-			    #:numlin 4
-			    #:numcol-visible 1
-			    #:numlin-visible 4
-			    #:click-cb (lambda (obj lin col status)
-					 (print "obj: " obj " lin: " lin " col: " col " status: " status))))
-	 (test-info-matrix (iup:matrix
-		            #:expand "YES"
-		            #:numcol 1
-		            #:numlin 7
-		            #:numcol-visible 1
-		            #:numlin-visible 7))
-	 (test-run-matrix  (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 5
-			    #:numcol-visible 1
-			    #:numlin-visible 5))
-	 (meta-dat-matrix  (iup:matrix
-			    #:expand "YES"
-			    #:numcol 1
-			    #:numlin 5
-			    #:numcol-visible 1
-			    #:numlin-visible 5))
-	 (steps-matrix     (iup:matrix
-			    #:expand "YES"
-			    #:numcol 6
-			    #:numlin 50
-			    #:numcol-visible 6
-			    #:numlin-visible 8))
-	 (data-matrix      (iup:matrix
-			    #:expand "YES"
-			    #:numcol 8
-			    #:numlin 50
-			    #:numcol-visible 8
-			    #:numlin-visible 8))
-	 (updater          (lambda (testdat)
-			     (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix))))
-
-    ;; Set the updater in updaters
-    (hash-table-set! (dboard:data-updaters *data*) window-id updater)
-    ;; 
-    (for-each
-     (lambda (mat)
-       ;; (iup:attribute-set! mat "0:1" "Value")
-       ;; (iup:attribute-set! mat "0:0" "Var")
-       (iup:attribute-set! mat "HEIGHT0" 0)
-       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
-       ;; (iup:attribute-set! mat "FIXTOTEXT" "C1")
-       (iup:attribute-set! mat "RESIZEMATRIX" "YES"))
-       ;; (iup:attribute-set! mat "WIDTH1" "120")
-       ;; (iup:attribute-set! mat "WIDTH0" "100"))
-     (list run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix))
-
-    ;; Steps matrix
-    (iup:attribute-set! steps-matrix "0:1" "Step Name")
-    (iup:attribute-set! steps-matrix "0:2" "Start")
-    (iup:attribute-set! steps-matrix "WIDTH2" "40")
-    (iup:attribute-set! steps-matrix "0:3" "End")
-    (iup:attribute-set! steps-matrix "WIDTH3" "40")
-    (iup:attribute-set! steps-matrix "0:4" "Status")
-    (iup:attribute-set! steps-matrix "WIDTH4" "40")
-    (iup:attribute-set! steps-matrix "0:5" "Duration")
-    (iup:attribute-set! steps-matrix "WIDTH5" "40")
-    (iup:attribute-set! steps-matrix "0:6" "Log File")
-    (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
-    ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
-    (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
-    ;; (iup:attribute-set! steps-matrix "WIDTH1" "120")
-    ;; (iup:attribute-set! steps-matrix "WIDTH0" "100")
-
-    ;; Data matrix
-    ;; 
-    (let ((rownum 1))
-      (for-each
-       (lambda (x)
-	 (iup:attribute-set! data-matrix (conc "0:" rownum) x)
-	 (iup:attribute-set! data-matrix (conc "WIDTH" rownum) "50")
-	 (set! rownum (+ rownum 1)))
-       (list "Category" "Variable" "Value" "Expected" "Tolerance"  "Status" "Units" "Type" "Comment")))
-    (iup:attribute-set! data-matrix "REDRAW" "ALL")
-    
-    (for-each 
-     (lambda (data)
-       (let ((mat    (car data))
-	     (keys   (cadr data))
-	     (rownum 1))
-	 (for-each
-	  (lambda (key)
-	    (iup:attribute-set! mat (conc rownum ":0") key)
-	    (set! rownum (+ rownum 1)))
-	  keys)
-	 (iup:attribute-set! mat "REDRAW" "ALL")))
-     (list
-      (list run-info-matrix  '("Run Id"  "Target"   "Runname" "Run Start Time" ))
-      (list test-info-matrix '("Test Id" "Testname" "Itempath" "State"   "Status" "Test Start Time" "Comment"))
-      (list test-run-matrix  '("Hostname" "Host info" "Disk Free" "CPU Load" "Run Duration"))
-      (list meta-dat-matrix  '("Author"   "Owner"     "Last Reviewed" "Tags" "Description"))))
-	    
-    (iup:split
-      #:orientation "HORIZONTAL"
-      (iup:vbox
-       (iup:hbox
-	(iup:vbox
-	 run-info-matrix
-	 test-info-matrix)
-       ;; test-info-matrix)
-	(iup:vbox
-	 test-run-matrix
-	 meta-dat-matrix))
-       (iup:vbox
-	(iup:vbox
-	 (iup:hbox 
-	  (iup:button "View Log"    #:action viewlog      #:size "60x" )   ;; #:size "30x" 
-	  (iup:button "Start Xterm" #:action xterm        #:size "60x" ))	 ;; #:size "30x" 
-	 (iup:hbox
-	   (iup:button "Run Test"    #:action run-test    #:size "60x" )	 ;; #:size "30x" 
-	   (iup:button "Clean Test"  #:action remove-test #:size "60x" )))	 ;; #:size "30x" 
-	(iup:hbox
-	 ;; hiup:split ;; hbox
-	 ;; #:orientation "HORIZONTAL"
-	 ;; #:value 300
-	 command-text-box
-	 command-launch-button)))
-      (iup:vbox
-       (let ((tabs (iup:tabs
-		    steps-matrix
-		    data-matrix)))
-	 (iup:attribute-set! tabs "TABTITLE0" "Test Steps")
-	 (iup:attribute-set! tabs "TABTITLE1" "Test Data")
-	 tabs)))))
-       
-;; Test browser
-(define (tests window-id)
-  (iup:split
-   (let* ((tb      (iup:treebox
-		    #:selection-cb
-		    (lambda (obj id state)
-		      ;; (print "obj: " obj ", id: " id ", state: " state)
-		      (let* ((run-path (tree:node->path obj id))
-			     (test-id  (tree-path->test-id (cdr run-path))))
-			(if test-id
-			    (hash-table-set! (dboard:data-curr-test-ids *data*)
-					     window-id test-id))
-			(print "path: " (tree:node->path obj id) " test-id: " test-id))))))
-     (iup:attribute-set! tb "VALUE" "0")
-     (iup:attribute-set! tb "NAME" "Runs")
-     ;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
-     (dboard:data-tests-tree-set! *data* tb)
-     tb)
-   (test-panel window-id)))
-
-;; The function to update the fields in the test view panel
-(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
-  ;; get test-id
-  ;; then get test record
-  (if testdat
-      (let* ((test-id      (hash-table-ref/default (dboard:data-curr-test-ids *data*) window-id #f))
-	     (test-data    (hash-table-ref/default testdat test-id #f))
-	     (run-id       (db:test-get-run_id test-data))
-	     (targ/runname (hash-table-ref/default (dboard:data-run-keys *data*) 
-						   run-id
-						   '()))
-	     (target       (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
-	     (runname      (if (null? targ/runname) "" (car (cdr targ/runname))))
-	     (steps-dat    (tests:get-compressed-steps *dbstruct-local* run-id test-id)))
-				
-	(if test-data
-	    (begin
-	      ;; 
-	      (for-each 
-	       (lambda (data)
-		 (let ((mat    (car data))
-		       (vals   (cadr data))
-		       (rownum 1))
-		   (for-each 
-		    (lambda (key)
-		      (let ((cell   (conc rownum ":1")))
-			(if (not (equal? (iup:attribute mat cell)(conc key)))
-			    (begin
-			      ;; (print "setting cell " cell " in matrix " mat " to value " key)
-			      (iup:attribute-set! mat cell (conc key))
-			      (iup:attribute-set! mat "REDRAW" cell)))
-			(set! rownum (+ rownum 1))))
-		    vals)))
-	       (list 
-		(list run-info-matrix
-		      (if test-id
-			  (list (db:test-get-run_id test-data)
-				target
-				runname
-				"n/a")
-			  (make-list 4 "")))
-		(list test-info-matrix
-		      (if test-id
-			  (list test-id
-				(db:test-get-testname test-data)
-				(db:test-get-item-path test-data)
-				(db:test-get-state    test-data)
-				(db:test-get-status   test-data)
-				(seconds->string (db:test-get-event_time test-data))
-				(db:test-get-comment  test-data))
-			  (make-list 7 "")))
-		(list test-run-matrix
-		      (if test-id
-			  (list (db:test-get-host     test-data)
-				(db:test-get-uname    test-data)
-				(db:test-get-diskfree test-data)
-				(db:test-get-cpuload  test-data)
-				(seconds->hr-min-sec (db:test-get-run_duration test-data)))
-			  (make-list 5 "")))
-		))
-	      (dcommon:populate-steps steps-dat steps-matrix))))))
-		;;(list meta-dat-matrix
-		;;      (if test-id
-		;;	  (list (
-
-  
-;; db:test-get-id           
-;; db:test-get-run_id       
-;; db:test-get-testname     
-;; db:test-get-state        
-;; db:test-get-status       
-;; db:test-get-event_time   
-;; db:test-get-host         
-;; db:test-get-cpuload      
-;; db:test-get-diskfree     
-;; db:test-get-uname        
-;; db:test-get-rundir       
-;; db:test-get-item-path    
-;; db:test-get-run_duration 
-;; db:test-get-final_logf   
-;; db:test-get-comment      
-;; db:test-get-fullname     	  
-
-
-;;======================================================================
-;; R U N   C O N T R O L
-;;======================================================================
-
-;; Overall runs browser
-;;
-(define (runs window-id)
-  (let* ((runs-matrix     (iup:matrix
-			   #:expand "YES"
-			   ;; #:fittosize "YES"
-			   #:scrollbar "YES"
-			   #:numcol 100
-			   #:numlin 100
-			   #:numcol-visible 7
-			   #:numlin-visible 7
-			   #:click-cb (lambda (obj lin col status)
-					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
-
-    (iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES")
-    (iup:attribute-set! runs-matrix "WIDTH0" "100")
-
-    (dboard:data-runs-matrix-set! *data* runs-matrix)
-    (iup:hbox
-     (iup:frame 
-      #:title "Runs browser"
-      (iup:vbox
-       runs-matrix)))))
-
-;; Browse and control a single run
-;;
-(define (runcontrol window-id)
-  (iup:hbox))
-
-;;======================================================================
-;; D A S H B O A R D
-;;======================================================================
-
-;; Main Panel
-(define (main-panel window-id)
-  (iup:dialog
-   #:title "Megatest Control Panel"
-   #:menu (dcommon:main-menu)
-   #:shrink "YES"
-   (let ((tabtop (iup:tabs 
-		  (runs window-id)
-		  (tests window-id)
-		  (runcontrol window-id)
-		  (mtest window-id) 
-		  (rconfig window-id)
-		  )))
-     (iup:attribute-set! tabtop "TABTITLE0" "Runs")
-     (iup:attribute-set! tabtop "TABTITLE1" "Tests")
-     (iup:attribute-set! tabtop "TABTITLE2" "Run Control")
-     (iup:attribute-set! tabtop "TABTITLE3" "megatest.config") 
-     (iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config")
-     tabtop)))
-
-(define *current-window-id* 0)
-
-(define (newdashboard dbstruct)
-  (let* ((data     (make-hash-table))
-	 (keys     (db:get-keys dbstruct))
-	 (runname  "%")
-	 (testpatt "%")
-	 (keypatts (map (lambda (k)(list k "%")) keys))
-	 (states   '())
-	 (statuses '())
-	 (nextmintime (current-milliseconds))
-	 (my-window-id *current-window-id*))
-    (set! *current-window-id* (+ 1 *current-window-id*))
-    (dboard:data-runs-set! *data* data) ;; make this data available to the rest of the application
-    (iup:show (main-panel my-window-id))
-    ;; Yes, running iup:show will pop up a new panel
-    ;; (iup:show (main-panel my-window-id))
-    (iup:callback-set! *tim*
-		       "ACTION_CB"
-		       (lambda (x)
-			 ;; Want to dedicate no more than 50% of the time to this so skip if
-			 ;; 2x delta time has not passed since last query
-			 (if (< nextmintime (current-milliseconds))
-			     (let* ((starttime (current-milliseconds))
-				    (changes   (dcommon:run-update keys data runname keypatts testpatt states statuses 'full my-window-id))
-				    (endtime   (current-milliseconds)))
-			       (set! nextmintime (+ endtime (* 2 (- endtime starttime))))
-			       (debug:print 11 *default-log-port* "CHANGE(S): " (car changes) "..."))
-			     (debug:print-info 11 *default-log-port* "Server overloaded"))))))
-
-(dboard:data-updaters-set! *data* (make-hash-table))
-(newdashboard *dbstruct-local*)    
-(iup:main-loop)

ADDED   oldsrc/debugger.scm
Index: oldsrc/debugger.scm
==================================================================
--- /dev/null
+++ oldsrc/debugger.scm
@@ -0,0 +1,73 @@
+(use iup)
+
+(define *debugger-control* #f)
+(define *debugger-rownum*  0)
+(define *debugger-matrix*  #f)
+(define *debugger*         #f)
+
+(define (debugger)
+  (if (not *debugger*)
+      (set! *debugger* 
+	    (thread-start!
+	     (make-thread
+	      (lambda ()
+		(show
+		 (dialog
+		  (let ((pause #f)
+			(mtrx  (matrix
+				#:expand "YES"
+				#:numlin 30
+				#:numcol 3
+				#:numlin-visible 20
+				#:numcol-visible 2
+				#:alignment1 "ALEFT"
+				)))
+		    (set! pause (button "Pause" 
+					#:action (lambda (obj)
+						   (set! *debugger-control* (not *debugger-control*))
+						   (attribute-set! pause "BGCOLOR" (if *debugger-control*
+										       "200 0 0"
+										       "0 0 200")))))
+		    (set! *debugger-matrix* mtrx)
+		    (attribute-set! mtrx "WIDTH1" "300")
+		    (vbox
+		     mtrx
+		     (hbox
+		      pause)))))
+		(main-loop)))))))
+
+(define (debugger-start #!key (start 2))
+  (set! *debugger-rownum* start))
+
+(define (debugger-trace-var varname varval)
+  (let ((oldval (attribute *debugger-matrix* (conc *debugger-rownum* ":1")))
+	(newval (conc varval)))
+    (if (not (equal? oldval newval))
+	(begin
+	  ;; (print "DEBUG: " varname " = " newval)
+	  (attribute-set! *debugger-matrix* (conc *debugger-rownum* ":0") varname)
+	  (attribute-set! *debugger-matrix* (conc *debugger-rownum* ":1") (conc varval))
+	  ;; (attribute-set! *debugger-matrix* "FITTOTEXT" "C1")
+	  ))
+    (set! *debugger-rownum* (+ *debugger-rownum* 1))))
+
+
+(define (debugger-pauser)
+  (debugger)
+  (attribute-set! *debugger-matrix* "REDRAW" "ALL")
+  (let loop ()
+    (if *debugger-control*
+	(begin
+	  (print "PAUSED!")
+	  (thread-sleep! 1)
+	  (loop))
+	;;(thread-sleep! 0.01)
+	)))
+		  
+;;    ;; lets use the debugger eh?
+;;    (debugger-start)
+;;    (debugger-trace-var "can-run-more"     can-run-more)
+;;    (debugger-trace-var "hed"              hed)
+;;    (debugger-trace-var "prereqs-not-met"  (runs:pretty-string prereqs-not-met))
+;;    (debugger-pauser)
+

ADDED   oldsrc/newdashboard.scm
Index: oldsrc/newdashboard.scm
==================================================================
--- /dev/null
+++ oldsrc/newdashboard.scm
@@ -0,0 +1,635 @@
+;;======================================================================
+;; Copyright 2006-2013, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+;;======================================================================
+
+(use format numbers)
+(require-library iup)
+(import (prefix iup iup:))
+(use canvas-draw)
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69)
+(import (prefix sqlite3 sqlite3:))
+
+(declare (uses margs))
+(declare (uses launch))
+(declare (uses megatest-version))
+(declare (uses gutils))
+(declare (uses db))
+(declare (uses server))
+(declare (uses synchash))
+(declare (uses dcommon))
+(declare (uses tree))
+
+(include "common_records.scm")
+(include "db_records.scm")
+(include "key_records.scm")
+
+(define help (conc 
+"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
+  version " megatest-version "
+  license GPL, Copyright (C) Matt Welland 2011
+
+Usage: dashboard [options]
+  -h                : this help
+  -server host:port : connect to host:port instead of db access
+  -test testid      : control test identified by testid
+  -guimonitor       : control panel for runs
+
+Misc
+  -rows N         : set number of rows
+"))
+
+;; process args
+(define remargs (args:get-args 
+		 (argv)
+		 (list  "-rows"
+			"-run"
+			"-test"
+			"-debug"
+			"-host" 
+			) 
+		 (list  "-h"
+			"-guimonitor"
+			"-main"
+			"-v"
+			"-q"
+		       )
+		 args:arg-hash
+		 0))
+
+(if (args:get-arg "-h")
+    (begin
+      (print help)
+      (exit)))
+
+(if (not (launch:setup))
+    (begin
+      (print "Failed to find megatest.config, exiting") 
+      (exit 1)))
+
+;; (if (args:get-arg "-host")
+;;     (begin
+;;       (set! *runremote* (string-split (args:get-arg "-host" ":")))
+;;       (client:launch))
+;;     (client:launch))
+
+;; ease debugging by loading ~/.dashboardrc
+(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
+  (if (file-exists? debugcontrolf)
+      (load debugcontrolf)))
+
+(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
+(define *dbstruct-local*  (make-dbr:dbstruct path:  *dbdir*
+					     local: #t))
+(define *db-file-path* (db:dbfile-path 0))
+
+;; HACK ALERT: this is a hack, please fix.
+(define *read-only* (not (file-read-access? *db-file-path*)))
+
+(debug:setup)
+
+(define *tim* (iup:timer))
+(define *ord* #f)
+
+(iup:attribute-set! *tim* "TIME" 300)
+(iup:attribute-set! *tim* "RUN" "YES")
+
+(define (message-window msg)
+  (iup:show
+   (iup:dialog
+    (iup:vbox 
+     (iup:label msg #:margin "40x40")))))
+
+(define (iuplistbox-fill-list lb items . default)
+  (let ((i 1)
+	(selected-item (if (null? default) #f (car default))))
+    (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
+    (for-each (lambda (item)
+		(iup:attribute-set! lb (number->string i) item)
+		(if selected-item
+		    (if (equal? selected-item item)
+			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
+		(set! i (+ i 1)))
+	      items)
+    i))
+
+(define (pad-list l n)(append l (make-list (- n (length l)))))
+
+
+(define (mkstr . x)
+  (string-intersperse (map conc x) ","))
+
+(define (update-search x val)
+  (hash-table-set! *searchpatts* x val))
+
+;; mtest is actually the megatest.config file
+;;
+(define (mtest window-id)
+  (let* ((curr-row-num     0)
+	 (rawconfig        (read-config (conc *toppath* "/megatest.config") #f 'return-string))
+	 (keys-matrix      (dcommon:keys-matrix rawconfig))
+	 (setup-matrix     (dcommon:section-matrix rawconfig "setup" "Varname" "Value"))
+	 (jobtools-matrix  (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 5
+			    #:numcol-visible 1
+			    #:numlin-visible 3))
+	 (validvals-matrix (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 2
+			    #:numcol-visible 1
+			    #:numlin-visible 2))
+	 (envovrd-matrix   (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 20
+			    #:numcol-visible 1
+			    #:numlin-visible 8))
+	 (disks-matrix     (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 20
+			    #:numcol-visible 1
+			    #:numlin-visible 8))
+	 )
+    (iup:attribute-set! disks-matrix "0:0" "Disk Name")
+    (iup:attribute-set! disks-matrix "0:1" "Disk Path")
+    (iup:attribute-set! disks-matrix "WIDTH1" "120")
+    (iup:attribute-set! disks-matrix "WIDTH0" "100")
+    (iup:attribute-set! disks-matrix "ALIGNMENT1" "ALEFT")
+    (iup:attribute-set! disks-matrix "FIXTOTEXT" "C1")
+    (iup:attribute-set! disks-matrix "RESIZEMATRIX" "YES")
+
+    ;; fill in existing info
+    (for-each 
+     (lambda (mat fname)
+       (set! curr-row-num 1)
+       (for-each
+	(lambda (var)
+	  (iup:attribute-set! mat (conc curr-row-num ":0") var)
+	  (iup:attribute-set! mat (conc curr-row-num ":1") (config-lookup rawconfig fname var))
+	  (set! curr-row-num (+ curr-row-num 1)))
+	(configf:section-vars rawconfig fname)))
+     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix)
+     (list "setup"      "jobtools"      "validvalues"      "env-override" "disks"))
+
+    (for-each
+     (lambda (mat)
+       (iup:attribute-set! mat "0:1" "Value")
+       (iup:attribute-set! mat "0:0" "Var")
+       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
+       (iup:attribute-set! mat "FIXTOTEXT" "C1")
+       (iup:attribute-set! mat "RESIZEMATRIX" "YES")
+       (iup:attribute-set! mat "WIDTH1" "120")
+       (iup:attribute-set! mat "WIDTH0" "100")
+       )
+     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix))
+
+    (iup:attribute-set! validvals-matrix "WIDTH1" "290")
+    (iup:attribute-set! envovrd-matrix   "WIDTH1" "290")
+
+    (iup:vbox
+     (iup:hbox
+       
+      (iup:vbox
+       (let ((tabs (iup:tabs 
+		    ;; The required tab
+		    (iup:hbox
+		     ;; The keys
+		     (iup:frame 
+		      #:title "Keys (required)"
+		      (iup:vbox
+		       (iup:label (conc "Set the fields for organising your runs\n"
+					"here. Note: can only be changed before\n"
+					"running the first run when megatest.db\n"
+					"is created."))
+		       keys-matrix))
+		     (iup:vbox
+		      ;; The setup section
+		      (iup:frame
+		       #:title "Setup"
+		       (iup:vbox
+			(iup:label (conc "max_concurrent_jobs : limits total concurrent jobs (optional)\n"
+					 "linktree : directory where linktree will be created."))
+			setup-matrix))
+		      ;; The jobtools
+		      (iup:frame
+		       #:title "Jobtools"
+		       (iup:vbox 
+			(iup:label (conc "launcher : tool or script to run jobs (try nbfake)\n"
+					 "useshell : use system to run your launcher\n"
+					 "workhosts : spread jobs out on these hosts"))
+			jobtools-matrix))
+		      ;; The disks
+		      (iup:frame
+		       #:title "Disks"
+		       (iup:vbox
+			(iup:label (conc "Enter names and existing paths of locations to run tests")) 
+			disks-matrix))))
+		    ;; The optional tab
+		    (iup:vbox
+		     ;; The Environment Overrides
+		     (iup:frame 
+		      #:title "Env override"
+		      envovrd-matrix)
+		     ;; The valid values
+		     (iup:frame
+		      #:title "Validvalues"
+		      validvals-matrix)
+		     ))))
+	 (iup:attribute-set! tabs "TABTITLE0" "Required settings")
+	 (iup:attribute-set! tabs "TABTITLE1" "Optional settings")
+	 tabs))
+       ))))
+
+;; The runconfigs.config file
+;;
+(define (rconfig window-id)
+  (iup:vbox
+   (iup:frame #:title "Default")))
+
+;;======================================================================
+;; T E S T S
+;;======================================================================
+
+(define (tree-path->test-id path)
+  (if (not (null? path))
+      (hash-table-ref/default (dboard:data-path-test-ids *data*) path #f)
+      #f))
+
+(define (test-panel window-id)
+  (let* ((curr-row-num 0)
+	 (viewlog    (lambda (x)
+		       (if (file-exists? logfile)
+					;(system (conc "firefox " logfile "&"))
+			   (iup:send-url logfile)
+			   (message-window (conc "File " logfile " not found")))))
+	 (xterm      (lambda (x)
+		       (if (directory-exists? rundir)
+			   (let ((shell (if (get-environment-variable "SHELL") 
+					    (conc "-e " (get-environment-variable "SHELL"))
+					    "")))
+			     (system (conc "cd " rundir 
+					   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
+			   (message-window  (conc "Directory " rundir " not found")))))
+	 (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -12"))
+	 (command-launch-button (iup:button "Execute!" 
+					    ;; #:expand "HORIZONTAL"
+					    #:size "50x"
+					    #:action (lambda (x)
+						       (let ((cmd (iup:attribute command-text-box "VALUE")))
+							 (system (conc cmd "  &"))))))
+	 (run-test  (lambda (x)
+		      (iup:attribute-set! 
+		       command-text-box "VALUE"
+		       (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname 
+			     " -runtests " (conc testname "/" (if (equal? item-path "")
+								  "%" 
+								  item-path))
+			     ";echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
+	 (remove-test (lambda (x)
+			(iup:attribute-set!
+			 command-text-box "VALUE"
+			 (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname
+			       " -testpatt " (conc testname "/" (if (equal? item-path "")
+								    "%"
+								    item-path))
+			       " -v;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
+    	 (run-info-matrix  (iup:matrix 		            
+			    #:expand "YES"
+			    ;; #:scrollbar "YES"
+			    #:numcol 1
+			    #:numlin 4
+			    #:numcol-visible 1
+			    #:numlin-visible 4
+			    #:click-cb (lambda (obj lin col status)
+					 (print "obj: " obj " lin: " lin " col: " col " status: " status))))
+	 (test-info-matrix (iup:matrix
+		            #:expand "YES"
+		            #:numcol 1
+		            #:numlin 7
+		            #:numcol-visible 1
+		            #:numlin-visible 7))
+	 (test-run-matrix  (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 5
+			    #:numcol-visible 1
+			    #:numlin-visible 5))
+	 (meta-dat-matrix  (iup:matrix
+			    #:expand "YES"
+			    #:numcol 1
+			    #:numlin 5
+			    #:numcol-visible 1
+			    #:numlin-visible 5))
+	 (steps-matrix     (iup:matrix
+			    #:expand "YES"
+			    #:numcol 6
+			    #:numlin 50
+			    #:numcol-visible 6
+			    #:numlin-visible 8))
+	 (data-matrix      (iup:matrix
+			    #:expand "YES"
+			    #:numcol 8
+			    #:numlin 50
+			    #:numcol-visible 8
+			    #:numlin-visible 8))
+	 (updater          (lambda (testdat)
+			     (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix))))
+
+    ;; Set the updater in updaters
+    (hash-table-set! (dboard:data-updaters *data*) window-id updater)
+    ;; 
+    (for-each
+     (lambda (mat)
+       ;; (iup:attribute-set! mat "0:1" "Value")
+       ;; (iup:attribute-set! mat "0:0" "Var")
+       (iup:attribute-set! mat "HEIGHT0" 0)
+       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
+       ;; (iup:attribute-set! mat "FIXTOTEXT" "C1")
+       (iup:attribute-set! mat "RESIZEMATRIX" "YES"))
+       ;; (iup:attribute-set! mat "WIDTH1" "120")
+       ;; (iup:attribute-set! mat "WIDTH0" "100"))
+     (list run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix))
+
+    ;; Steps matrix
+    (iup:attribute-set! steps-matrix "0:1" "Step Name")
+    (iup:attribute-set! steps-matrix "0:2" "Start")
+    (iup:attribute-set! steps-matrix "WIDTH2" "40")
+    (iup:attribute-set! steps-matrix "0:3" "End")
+    (iup:attribute-set! steps-matrix "WIDTH3" "40")
+    (iup:attribute-set! steps-matrix "0:4" "Status")
+    (iup:attribute-set! steps-matrix "WIDTH4" "40")
+    (iup:attribute-set! steps-matrix "0:5" "Duration")
+    (iup:attribute-set! steps-matrix "WIDTH5" "40")
+    (iup:attribute-set! steps-matrix "0:6" "Log File")
+    (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
+    ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
+    (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
+    ;; (iup:attribute-set! steps-matrix "WIDTH1" "120")
+    ;; (iup:attribute-set! steps-matrix "WIDTH0" "100")
+
+    ;; Data matrix
+    ;; 
+    (let ((rownum 1))
+      (for-each
+       (lambda (x)
+	 (iup:attribute-set! data-matrix (conc "0:" rownum) x)
+	 (iup:attribute-set! data-matrix (conc "WIDTH" rownum) "50")
+	 (set! rownum (+ rownum 1)))
+       (list "Category" "Variable" "Value" "Expected" "Tolerance"  "Status" "Units" "Type" "Comment")))
+    (iup:attribute-set! data-matrix "REDRAW" "ALL")
+    
+    (for-each 
+     (lambda (data)
+       (let ((mat    (car data))
+	     (keys   (cadr data))
+	     (rownum 1))
+	 (for-each
+	  (lambda (key)
+	    (iup:attribute-set! mat (conc rownum ":0") key)
+	    (set! rownum (+ rownum 1)))
+	  keys)
+	 (iup:attribute-set! mat "REDRAW" "ALL")))
+     (list
+      (list run-info-matrix  '("Run Id"  "Target"   "Runname" "Run Start Time" ))
+      (list test-info-matrix '("Test Id" "Testname" "Itempath" "State"   "Status" "Test Start Time" "Comment"))
+      (list test-run-matrix  '("Hostname" "Host info" "Disk Free" "CPU Load" "Run Duration"))
+      (list meta-dat-matrix  '("Author"   "Owner"     "Last Reviewed" "Tags" "Description"))))
+	    
+    (iup:split
+      #:orientation "HORIZONTAL"
+      (iup:vbox
+       (iup:hbox
+	(iup:vbox
+	 run-info-matrix
+	 test-info-matrix)
+       ;; test-info-matrix)
+	(iup:vbox
+	 test-run-matrix
+	 meta-dat-matrix))
+       (iup:vbox
+	(iup:vbox
+	 (iup:hbox 
+	  (iup:button "View Log"    #:action viewlog      #:size "60x" )   ;; #:size "30x" 
+	  (iup:button "Start Xterm" #:action xterm        #:size "60x" ))	 ;; #:size "30x" 
+	 (iup:hbox
+	   (iup:button "Run Test"    #:action run-test    #:size "60x" )	 ;; #:size "30x" 
+	   (iup:button "Clean Test"  #:action remove-test #:size "60x" )))	 ;; #:size "30x" 
+	(iup:hbox
+	 ;; hiup:split ;; hbox
+	 ;; #:orientation "HORIZONTAL"
+	 ;; #:value 300
+	 command-text-box
+	 command-launch-button)))
+      (iup:vbox
+       (let ((tabs (iup:tabs
+		    steps-matrix
+		    data-matrix)))
+	 (iup:attribute-set! tabs "TABTITLE0" "Test Steps")
+	 (iup:attribute-set! tabs "TABTITLE1" "Test Data")
+	 tabs)))))
+       
+;; Test browser
+(define (tests window-id)
+  (iup:split
+   (let* ((tb      (iup:treebox
+		    #:selection-cb
+		    (lambda (obj id state)
+		      ;; (print "obj: " obj ", id: " id ", state: " state)
+		      (let* ((run-path (tree:node->path obj id))
+			     (test-id  (tree-path->test-id (cdr run-path))))
+			(if test-id
+			    (hash-table-set! (dboard:data-curr-test-ids *data*)
+					     window-id test-id))
+			(print "path: " (tree:node->path obj id) " test-id: " test-id))))))
+     (iup:attribute-set! tb "VALUE" "0")
+     (iup:attribute-set! tb "NAME" "Runs")
+     ;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
+     (dboard:data-tests-tree-set! *data* tb)
+     tb)
+   (test-panel window-id)))
+
+;; The function to update the fields in the test view panel
+(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
+  ;; get test-id
+  ;; then get test record
+  (if testdat
+      (let* ((test-id      (hash-table-ref/default (dboard:data-curr-test-ids *data*) window-id #f))
+	     (test-data    (hash-table-ref/default testdat test-id #f))
+	     (run-id       (db:test-get-run_id test-data))
+	     (targ/runname (hash-table-ref/default (dboard:data-run-keys *data*) 
+						   run-id
+						   '()))
+	     (target       (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
+	     (runname      (if (null? targ/runname) "" (car (cdr targ/runname))))
+	     (steps-dat    (tests:get-compressed-steps *dbstruct-local* run-id test-id)))
+				
+	(if test-data
+	    (begin
+	      ;; 
+	      (for-each 
+	       (lambda (data)
+		 (let ((mat    (car data))
+		       (vals   (cadr data))
+		       (rownum 1))
+		   (for-each 
+		    (lambda (key)
+		      (let ((cell   (conc rownum ":1")))
+			(if (not (equal? (iup:attribute mat cell)(conc key)))
+			    (begin
+			      ;; (print "setting cell " cell " in matrix " mat " to value " key)
+			      (iup:attribute-set! mat cell (conc key))
+			      (iup:attribute-set! mat "REDRAW" cell)))
+			(set! rownum (+ rownum 1))))
+		    vals)))
+	       (list 
+		(list run-info-matrix
+		      (if test-id
+			  (list (db:test-get-run_id test-data)
+				target
+				runname
+				"n/a")
+			  (make-list 4 "")))
+		(list test-info-matrix
+		      (if test-id
+			  (list test-id
+				(db:test-get-testname test-data)
+				(db:test-get-item-path test-data)
+				(db:test-get-state    test-data)
+				(db:test-get-status   test-data)
+				(seconds->string (db:test-get-event_time test-data))
+				(db:test-get-comment  test-data))
+			  (make-list 7 "")))
+		(list test-run-matrix
+		      (if test-id
+			  (list (db:test-get-host     test-data)
+				(db:test-get-uname    test-data)
+				(db:test-get-diskfree test-data)
+				(db:test-get-cpuload  test-data)
+				(seconds->hr-min-sec (db:test-get-run_duration test-data)))
+			  (make-list 5 "")))
+		))
+	      (dcommon:populate-steps steps-dat steps-matrix))))))
+		;;(list meta-dat-matrix
+		;;      (if test-id
+		;;	  (list (
+
+  
+;; db:test-get-id           
+;; db:test-get-run_id       
+;; db:test-get-testname     
+;; db:test-get-state        
+;; db:test-get-status       
+;; db:test-get-event_time   
+;; db:test-get-host         
+;; db:test-get-cpuload      
+;; db:test-get-diskfree     
+;; db:test-get-uname        
+;; db:test-get-rundir       
+;; db:test-get-item-path    
+;; db:test-get-run_duration 
+;; db:test-get-final_logf   
+;; db:test-get-comment      
+;; db:test-get-fullname     	  
+
+
+;;======================================================================
+;; R U N   C O N T R O L
+;;======================================================================
+
+;; Overall runs browser
+;;
+(define (runs window-id)
+  (let* ((runs-matrix     (iup:matrix
+			   #:expand "YES"
+			   ;; #:fittosize "YES"
+			   #:scrollbar "YES"
+			   #:numcol 100
+			   #:numlin 100
+			   #:numcol-visible 7
+			   #:numlin-visible 7
+			   #:click-cb (lambda (obj lin col status)
+					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
+
+    (iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES")
+    (iup:attribute-set! runs-matrix "WIDTH0" "100")
+
+    (dboard:data-runs-matrix-set! *data* runs-matrix)
+    (iup:hbox
+     (iup:frame 
+      #:title "Runs browser"
+      (iup:vbox
+       runs-matrix)))))
+
+;; Browse and control a single run
+;;
+(define (runcontrol window-id)
+  (iup:hbox))
+
+;;======================================================================
+;; D A S H B O A R D
+;;======================================================================
+
+;; Main Panel
+(define (main-panel window-id)
+  (iup:dialog
+   #:title "Megatest Control Panel"
+   #:menu (dcommon:main-menu)
+   #:shrink "YES"
+   (let ((tabtop (iup:tabs 
+		  (runs window-id)
+		  (tests window-id)
+		  (runcontrol window-id)
+		  (mtest window-id) 
+		  (rconfig window-id)
+		  )))
+     (iup:attribute-set! tabtop "TABTITLE0" "Runs")
+     (iup:attribute-set! tabtop "TABTITLE1" "Tests")
+     (iup:attribute-set! tabtop "TABTITLE2" "Run Control")
+     (iup:attribute-set! tabtop "TABTITLE3" "megatest.config") 
+     (iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config")
+     tabtop)))
+
+(define *current-window-id* 0)
+
+(define (newdashboard dbstruct)
+  (let* ((data     (make-hash-table))
+	 (keys     (db:get-keys dbstruct))
+	 (runname  "%")
+	 (testpatt "%")
+	 (keypatts (map (lambda (k)(list k "%")) keys))
+	 (states   '())
+	 (statuses '())
+	 (nextmintime (current-milliseconds))
+	 (my-window-id *current-window-id*))
+    (set! *current-window-id* (+ 1 *current-window-id*))
+    (dboard:data-runs-set! *data* data) ;; make this data available to the rest of the application
+    (iup:show (main-panel my-window-id))
+    ;; Yes, running iup:show will pop up a new panel
+    ;; (iup:show (main-panel my-window-id))
+    (iup:callback-set! *tim*
+		       "ACTION_CB"
+		       (lambda (x)
+			 ;; Want to dedicate no more than 50% of the time to this so skip if
+			 ;; 2x delta time has not passed since last query
+			 (if (< nextmintime (current-milliseconds))
+			     (let* ((starttime (current-milliseconds))
+				    (changes   (dcommon:run-update keys data runname keypatts testpatt states statuses 'full my-window-id))
+				    (endtime   (current-milliseconds)))
+			       (set! nextmintime (+ endtime (* 2 (- endtime starttime))))
+			       (debug:print 11 *default-log-port* "CHANGE(S): " (car changes) "..."))
+			     (debug:print-info 11 *default-log-port* "Server overloaded"))))))
+
+(dboard:data-updaters-set! *data* (make-hash-table))
+(newdashboard *dbstruct-local*)    
+(iup:main-loop)

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -256,11 +256,11 @@
 	  ;; (rmt:update-db-stats run-id cmd params duration)
 	  ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it
 	  (if qry-is-write
 	      (let ((start-time (current-seconds)))
 		(mutex-lock! *db-multi-sync-mutex*)
-		(hash-table-set! *db-local-sync* (or run-id 0) start-time) ;; the oldest "write"
+		(set! *db-last-write* start-time) ;; the oldest "write"
                 (mutex-unlock! *db-multi-sync-mutex*)))))
     res))
 
 (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
   (let* ((run-id   (if run-id run-id 0))

Index: rpc-transport.scm
==================================================================
--- rpc-transport.scm
+++ rpc-transport.scm
@@ -123,13 +123,13 @@
     ;; server last used then start shutdown
     (let loop ((count 0))
       (thread-sleep! 5) ;; no need to do this very often
       (let ((numrunning -1)) ;; (db:get-count-tests-running db)))
 	(if (or (> numrunning 0)
-		(> (+ *last-db-access* 60)(current-seconds)))
+		(> (+ *db-last-access* 60)(current-seconds)))
 	    (begin
-	      (debug:print-info 0 *default-log-port* "Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*))
+	      (debug:print-info 0 *default-log-port* "Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *db-last-access*))
 	      (loop (+ 1 count)))
 	    (begin
 	      (debug:print-info 0 *default-log-port* "Starting to shutdown the server side")
 	      (open-run-close tasks:server-delete-record tasks:open-db server-id " rpc-transport:try-start-server stop")
 	      (thread-sleep! 10)

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -34,11 +34,10 @@
   (if (not hostport)
       #f
       (conc "http://" (car hostport) ":" (cadr hostport))))
 
 (define  *server-loop-heart-beat* (current-seconds))
-(define *heartbeat-mutex* (make-mutex))
 
 ;;======================================================================
 ;; S E R V E R
 ;;======================================================================
 
@@ -187,25 +186,27 @@
 		    #f ;; failed for some reason, for the moment simply return #f
 		    (with-output-to-file server-file
 		      (lambda ()
 			(print hostport)))
 		    #t)))
+	  (debug:print-info 0 *default-log-port* "server file " serverfile " for " hostport " created")
 	  (common:simple-file-release-lock lock-file)
 	  res)
 	#f)))
 
 (define (server:remove-dotserver-file areapath hostport)
   (let ((dotserver   (server:read-dotserver areapath))
 	(server-file (conc areapath "/.server"))
 	(lock-file   (conc areapath "/.server.lock")))
-    (if (string-match (conc ".*:" hostport "$") dotserver) ;; port matches, good enough info to decide to remove the file
+    (if (and dotserver (string-match (conc ".*:" hostport "$") dotserver)) ;; port matches, good enough info to decide to remove the file
 	(if (common:simple-file-lock lock-file)
 	    (begin
 	      (handle-exceptions
 	       exn
 	       #f
 	       (delete-file* server-file))
+	      (debug:print-info 0 *default-log-port* "server file " server-file " for " hostport " removed")
 	      (common:simple-file-release-lock lock-file))))))
 
 ;; no longer care if multiple servers are started by accident. older servers will drop off in time.
 ;;
 (define (server:check-if-running areapath)
@@ -264,11 +265,11 @@
 	     (else       #f))
 	   (loop (read-line) inl))))))
 
 (define (server:login toppath)
   (lambda (toppath)
-    (set! *last-db-access* (current-seconds))
+    (set! *db-last-access* (current-seconds)) ;; might not be needed.
     (if (equal? *toppath* toppath)
 	#t
 	#f)))
 
 (define (server:get-timeout)

Index: tree.scm
==================================================================
--- tree.scm
+++ tree.scm
@@ -135,10 +135,10 @@
                      ;; (print "obj: " obj ", id: " id ", state: " state)
                      (let* ((run-path (tree:node->path obj id))
                             (run-id   (tree-path->run-id (cdr run-path))))
                        (if run-id
                            (begin
-                             (dboard:data-curr-run-id-set! *data* run-id)
+                             (dboard:data-curr-run-id-set! data run-id)
                              (dashboard:update-run-summary-tab)))
                        ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
                        ))))
 |#

ADDED   utils/find-unused-globals.sh
Index: utils/find-unused-globals.sh
==================================================================
--- /dev/null
+++ utils/find-unused-globals.sh
@@ -0,0 +1,29 @@
+#!/bin/bash
+
+echo "Finding unused globals:"
+
+for var in $(egrep '^\s*\(define\s+\*' *.scm|awk '{print $2}'|sort -u);do
+    if ! $(egrep -v '^\s*\(define' *scm| grep "$var" > /dev/null);then
+	echo "$var not used";
+    fi;
+done
+
+echo
+echo "Finding globals without proper definition in common.scm:"
+
+for var in $(egrep -v '^\s*\(define' *.scm|\
+		    grep -P -v '^\s*;'|\
+		    grep -P '\*[a-zA-Z]+\S+\*'|\
+		    tr '*' '/' |\
+		    perl -p -e 's%.*(\/\S+\/).*%$1%'|\
+		    egrep '\/[a-zA-Z]+\S+\/'|\
+		    sort -u);do
+    newvar=$(echo $var | tr '/' '*')
+    # echo "VAR is $var, newvar is $newvar"
+    if ! $(grep -P '^\s*\(define\s+' common.scm|\
+		  grep -P -v '^\s*;'|\
+		  grep "$newvar" > /dev/null);then
+	echo "$newvar not defined in common.scm"
+    fi
+done
+