Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -89,27 +89,28 @@
 ;; each db entry in the hash is a dbr:dbdat
 ;; this record will evolve into the area record
 ;;
 (defstruct dbr:dbstruct 
   (mtdb        #f)
-  (dbs         (make-hash-table)) ;; id => db
+  (dbdats      (make-hash-table)) ;; id => dbdat
   (read-only   #f)                ;; the area is read-only
   (stmt-cache  (make-hash-table)))
 
 (defstruct dbr:dbdat
   (db          #f)
   (inmem       #f)
   (last-sync   0)
+  (last-write  (current-seconds))
   (run-id      #f)
   (fname       #f))
   
-;; Returns the database for a particular run-id fron dbstruct-dbs
+;; Returns the dbdat for a particular run-id from dbstruct
 ;;
-(define (dbr:dbstruct-db v run-id)
+(define (dbr:dbstruct-get-dbdat v run-id)
   (hash-table-ref/default (dbr:dbstruct-dbs v) run-id #f))
 
-(define (dbr:dbstruct-db-set! v run-id db)
+(define (dbr:dbstruct-dbdat-put! v run-id db)
   (hash-table-set! (dbr:dbstruct-dbs v) run-id db))
 
 (define (db:run-id->first-num run-id)
   (let* ((s (number->string run-id))
 	 (l (string-length s)))
@@ -125,65 +126,81 @@
 (defstruct dbr:counts
   (state #f)
   (status #f)
   (count  0)) 
 
-;; Get/open a database
+;; Retrieve a db handle for inmemory db given run-id, open and setup both inmemory and
+;; db file if needed
+;;
 ;;    if run-id => get run specific db
-;;    if #f     => get main db
+;;    if #f     => get main.db
 ;;    if db already open - return inmem
 ;;    if db not open, open inmem, rundb and sync then return inmem
 ;;    inuse gets set automatically for rundb's
 ;;
+(define (db:get-dbdat dbstruct run-id)
+  (let* ((dbfile   (db:run-id->path run-id))
+	 (dbdat    (dbr:dbstruct-get-dbdat dbstruct run-id))
+	 (newdbdat (if dbdat
+		       #f
+		       (db:open-dbdat run-id db:setup-schema))))
+    (if dbdat
+	dbdat
+	(begin
+	  (dbr:dbstruct-dbdat-put! dbstruct newdbdat)
+	  newdbdat))))
+
+;; get the inmem db for actual db operations
+;;
+(define (db:get-inmem dbstruct run-id)
+  (dbr:dbdat-inmem (db:get-dbdat dbstruct run-id)))
+
+;; get the handle for the on-disk db
+;;
 (define (db:get-db dbstruct run-id)
-  (let* ((db    (dbr:dbstruct-db dbstruct run-id))
-	 (newdb (if db
-		    #f
-		    (db:open-megatest-db path: (db:run-id->path run-id)))))
-    (if db
-	db
-	(let* 
-    (db:open-db dbstruct run-id)))
-
-;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
-(define (db:dbdat-get-db dbdat)
-  (dbr:dbdat-db dbdat))
-
-(define (db:dbdat-get-path dbdat)
-  (dbr:dbdat-fname dbdat))
-
-;;======================================================================
-;; alist-of-alists
-;;======================================================================
+  (dbr:dbdat-db (db:get-dbdat dbstruct run-id)))
+
+;; open or create the disk db file
+;; create and fill the inmemory db
+;; assemble into dbr:dbdat struct and return
 ;; 
-;; (define (db:aa-set! dat key1 key2 val)
-;;   (let loop ((
-
-;;======================================================================
-;; hash of hashs
-;;======================================================================
-
-(define (db:hoh-set! dat key1 key2 val)
-  (let* ((subhash (hash-table-ref/default dat key1 #f)))
-    (if subhash
-	(hash-table-set! subhash key2 val)
-	(begin
-	  (hash-table-set! dat key1 (make-hash-table))
-	  (db:hoh-set! dat key1 key2 val)))))
-
-(define (db:hoh-get dat key1 key2)
-  (let* ((subhash (hash-table-ref/default dat key1 #f)))
-    (and subhash
-	 (hash-table-ref/default subhash key2 #f))))
-
-(define (db:get-cache-stmth dbstruct db stmt)
-  (let* ((stmt-cache        (dbr:dbstruct-stmt-cache dbstruct))
-	 (stmth             (db:hoh-get stmt-cache db stmt)))
-    (or stmth
-	(let* ((newstmth (sqlite3:prepare db stmt)))
-	  (db:hoh-set! stmt-cache db stmt newstmth)
-	  newstmth))))
+(define (db:open-dbdat run-id dbinit-proc)
+  (let* ((dbfile   (db:run-id->path run-id))
+	 (db       (db:open-run-db dbfile dbinit-proc))
+	 (inmem    (db:open-inmem-db dbinit-proc))
+	 (dbdat    (dbr:dbdat-make
+		    db:     db
+		    inmem:  inmem
+		    run-id: run-id
+		    fname:  dbfile)))
+    ;; now sync the disk file data into the inmemory db
+    (db:sync-tables (db:sync-all-tables-list) #f db inmem)
+    dbdat))
+    
+;; open the disk database file
+;; NOTE: May need to add locking to file create process here
+;; returns an sqlite3 database handle
+;;
+(define (db:open-run-db dbfile dbinit-proc)
+  (let* ((exists (file-exists? dbfile))
+	 (db     (sqlite3:open-database dbfile))
+	 (handler (make-busy-timeout 3600)))
+    (sqlite3:set-busy-handler! db handler)
+    (db:set-sync db)
+    (if (not exists)
+	(dbinit-proc db))
+    db))
+    
+;; open and initialize the inmem db
+;; NOTE: Does NOT sync in the data from the disk db
+;;
+(define (db:open-inmem-db)
+  (let* ((db      (sqlite3:open-database ":memory:"))
+	 (handler (make-busy-timeout 3600)))
+    (sqlite3:set-busy-handler! db handler)
+    (db:initialize-run-id-db db)
+    db))
 
 ;;======================================================================
 ;; SQLITE3 HELPERS
 ;;======================================================================
 
@@ -220,18 +237,14 @@
 
 ;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
 ;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
 ;;
 (define (db:with-db dbstruct run-id r/w proc . params)
-  (let* ((have-struct (dbr:dbstruct? dbstruct))
-         (dbdat     (if have-struct 
-			(db:get-db dbstruct)
-			#f))
-	 (db        (if have-struct
-			(db:dbdat-get-db dbdat run-id)
-			dbstruct))
-	 (fname     (db:dbdat-get-path dbdat))
+  (assert (dbr:dbstruct? dbstruct) "FATAL: db:with-db called with bad dbstruct")
+  (let* ((dbdat     (db:get-dbdat dbstruct))
+	 (db        (dbr:dbdat-inmem dbdat))
+	 (fname     (db:dbdat-fname dbdat))
 	 (use-mutex (> *api-process-request-count* 25))) ;; was 25
     (if (and use-mutex
 	     (common:low-noise-print 120 "over-50-parallel-api-requests"))
 	(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
     (if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
@@ -254,205 +267,32 @@
      (exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
      (exn ()
 	  (db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
 				     ((condition-property-accessor 'exn 'message) exn))))))
       
-;;======================================================================
-;; K E E P   F I L E D B   I N   dbstruct
-;;======================================================================
-
-;; (define (db:get-filedb dbstruct run-id)
-;;   (let ((db (vector-ref dbstruct 2)))
-;;     (if db
-;; 	db
-;; 	(let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db"))))
-;; 	  (vector-set! dbstruct 2 fdb)
-;; 	  fdb))))
-;; 
-;; ;; Can also be used to save arbitrary strings
-;; ;;
-;; (define (db:save-path dbstruct path)
-;;   (let ((fdb (db:get-filedb dbstruct)))b
-;;     (filedb:register-path fdb path)))
-;; 
-;; ;; Use to get a path. To get an arbitrary string see next define
-;; ;;
-;; (define (db:get-path dbstruct id)
-;;   (let ((fdb (db:get-filedb dbstruct)))
-;;     (filedb:get-path db id)))
-
 (define (db:set-sync db)
   (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
     (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 0) ";")))) 
 
-;; open an sql database inside a file lock
-;; returns: db existed-prior-to-opening
-;; RA => Returns a db handler; sets the lock if opened in writable mode
-;;
-;; (define *db-open-mutex* (make-mutex))
-
-(define (db:lock-create-open fname initproc)
-  (let* ((parent-dir   (or (pathname-directory fname)(current-directory))) ;; no parent? go local
-         (raw-fname    (pathname-file fname))
-	 (dir-writable (file-writable? parent-dir))
-	 (file-exists  (common:file-exists? fname))
-	 (file-write   (if file-exists
-			   (file-writable? fname)
-			   dir-writable )))
-    ;; (mutex-lock! *db-open-mutex*) ;; tried this mutex, not clear it helped.
-    (if file-write ;; dir-writable
-	(condition-case
-         (let* ((lockfname   (conc fname ".lock"))
-                (readyfname  (conc parent-dir "/.ready-" raw-fname))
-                (readyexists (common:file-exists? readyfname)))
-           (if (not readyexists)
-               (common:simple-file-lock-and-wait lockfname))
-           (let ((db      (sqlite3:open-database fname)))
-             (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
-             (sqlite3:execute db "PRAGMA synchronous = 0;")
-             #;(if (and (configf:lookup *configdat* "setup" "tmp_mode") (string-match "^/tmp/.*" fname))
-                 (begin
-                   ;;(print "DEBUG: Setting tmp_mode for " fname) 
-                   (sqlite3:execute db (configf:lookup *configdat* "setup" "tmp_mode"))
-                   )
-                 )  
-             #;(if (and (configf:lookup *configdat* "setup" "nfs_mode") (not (string-match "^/tmp/.*" fname)))
-                 (begin
-                   ;;(print "DEBUG: Setting nfs_mode for " fname)
-                   (sqlite3:execute db (configf:lookup *configdat* "setup" "nfs_mode"))
-                   )
-                 )  
-             #;(if (and (not (or (configf:lookup *configdat* "setup" "tmp_mode") (configf:lookup *configdat* "setup" "nfs_mode")))  
-                      (configf:lookup *configdat* "setup" "use-wal")
-                      (string-match "^/tmp/.*" fname)) ;; this is a file in /tmp
-                 (sqlite3:execute db "PRAGMA journal_mode=WAL;")
-                 (debug:print 2 *default-log-port* "Creating " fname " in NON-WAL mode."))
-             (if (not file-exists)
-                 (initproc db))
-             (if (not readyexists)
-                 (begin
-                   (common:simple-file-release-lock lockfname)
-                   (with-output-to-file
-                       readyfname
-                     (lambda ()
-                       (print "Ready at " 
-                              (seconds->year-work-week/day-time 
-                               (current-seconds)))))))
-             db))
-         (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
-         (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
-         (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
-         (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
-         (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
-        
-	(condition-case
-         (begin
-           (debug:print 2 *default-log-port* "WARNING: opening db in non-writable dir " fname)
-           (let ((db (sqlite3:open-database fname)))
-             (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
-             (sqlite3:execute db "PRAGMA synchronous = 0;")
-	     ;; (mutex-unlock! *db-open-mutex*)
-             db))
-         (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
-         (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
-         (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
-         (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
-         (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
-	)))
-
-
-;; 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 run-id)
-  (let* ((max-stale-tmp (configf:lookup-number *configdat* "server" "filling-db-max-stale-seconds" default: 10))
-	 (dbpath       (common:get-db-tmp-area ))      ;; path to tmp db area
-	 (dbexists     (common:file-exists? dbpath))
-	 (tmpdbfname   (conc dbpath "/megatest.db"))
-	 (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
-	 (mtdbexists   (common:file-exists? (conc *toppath* "/megatest.db")))
-	 
-	 (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db"))   #f))
-	 (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) 
-	 (mtdb         (db:open-megatest-db))
-	 (mtdbpath     (db:dbdat-get-path mtdb))
-	 (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
-	 (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
-	 (write-access (file-writable? mtdbpath))
-	 (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
-
-          (when write-access
-            (sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger")
-            (sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))
-          
-	  (if (and dbexists (not write-access))
-              (begin
-                (set! *db-write-access* #f)
-                (dbr:dbstruct-read-only-set! dbstruct #t)))
-          (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
-          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
-          (if (and  (or (not dbfexists)
-			(and modtimedelta
-			     (> modtimedelta max-stale-tmp))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
-		    do-sync)
-	      (begin
-		(debug:print 1 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n    from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
-		(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
-		;; touch tmp db to avoid wal mode wierdness  
-		(set-file-times! tmpdbfname (current-seconds))  
-                (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
-                )
-	      (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n     " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
-	  ;; (db:multi-db-sync dbstruct 'old2new))  ;; migrate data from megatest.db automatically
-          tmpdb))))
-
-
+;; get last time a record was updated in either tests or runs table
+;;
+;;    NOTE: Takes a sqlite3 db handle, not dbstruct or dbdat
+;;
 (define (db:get-last-update-time db)
-;	(db:with-db
-;   dbstruct #f #f 
-;    (lambda (db)
-			(let ((last-update-time #f))
-      	(sqlite3:for-each-row 
-          (lambda (lup) 
-             (set! last-update-time lup))     
-          db    
-					"select max(lup) from ( select max(last_update) as lup  from tests union select max(last_update) as lup from runs);")
-        last-update-time))
-;))
-
-;; 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 do-sync #!key (areapath #f))
-  ;;
-  (cond
-   (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
-   (else ;;(common:on-homehost?)
-    (debug:print-info 13 *default-log-port* "db:setup entered (first time, not cached.)")
-    (let* ((dbstruct (make-dbr:dbstruct)))
-      (assert *toppath* "ERROR: db:setup called before launch:setup. This is fatal.")
-      #;(when (not *toppath*)
-        (debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup")
-        (launch:setup areapath: areapath))
-      (debug:print-info 13 *default-log-port* "Begin db:open-db")
-      (db:open-db dbstruct areapath: areapath do-sync: do-sync)
-      (debug:print-info 13 *default-log-port* "Done db:open-db")
-      (set! *dbstruct-db* dbstruct)
-      ;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct))
-      dbstruct))))
-   ;; (else
-   ;;  (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
-   ;;  (exit 1))))
-
-;; Open the classic megatest.db file (defaults to open in toppath)
-;;
-;;   NOTE: returns a dbdat not a dbstruct!
-;;
-
-;;(define (db:reopen-megatest-db
-
-(define (db:open-megatest-db fname)
+  (let ((last-update-time #f))
+    (sqlite3:for-each-row 
+     (lambda (lup) 
+       (set! last-update-time lup))     
+     db    
+     "select max(lup) from ( select max(last_update) as lup  from tests union select max(last_update) as lup from runs);")
+    last-update-time))
+
+;; NOTE: opens the legacy megatest.db at the top of *toppath*
+;;
+;;  - NOT ready for use
+;;
+(define (db:open-legacy-megatest-db fname)
   (let* ((dbexists     (if (equal? fname ":inmem:")
 			   #f
 			   (common:file-exists? dbpath)))
 	 (db           (db:lock-create-open dbpath
 					    (lambda (db)
@@ -463,27 +303,49 @@
     (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
     (if (and dbexists (not write-access))
 	(set! *db-write-access* #f))
     (cons db dbpath)))
 
+;; ;; ;; sync run to disk if touched
+;; ;; ;;
+;; ;; (define (db:sync-touched dbstruct run-id #!key (force-sync #f))
+;; ;;   (let ((tmpdb   (db:get-db dbstruct))
+;; ;; 	(mtdb    (dbr:dbstruct-mtdb   dbstruct))
+;; ;;         (refndb  (dbr:dbstruct-refndb dbstruct))
+;; ;; 	(start-t (current-seconds)))
+;; ;;     (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
+;; ;;     (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)
+;; ;;     (set! *db-last-access* start-t)
+;; ;;     (mutex-unlock! *db-multi-sync-mutex*)
+;; ;;     (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))
+
+;; NOTE: touched logic is disabled/not done
 ;; sync run to disk if touched
 ;;
-(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
-  (let ((tmpdb   (db:get-db dbstruct))
-	(mtdb    (dbr:dbstruct-mtdb   dbstruct))
-        (refndb  (dbr:dbstruct-refndb dbstruct))
+(define (db:sync-inmem->disk dbstruct run-id #!key (force-sync #f))
+  (let ((dbdat   (db:get-dbdat dbstruct run-id))
+	(db      (dbr:dbdat-db dbstruct))
+	(inmem   (dbr:dbdat-inmem dbstruct))
 	(start-t (current-seconds)))
     (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
     (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))
+    ;; (let* ((update_info (cons (if force-sync 0 *db-last-sync*) "last_update"))
+    ;;	   (need-sync   (or force-sync (>= last_update (dbr:dbdat-last-write dbdat)))))
+    ;;  (mutex-unlock! *db-multi-sync-mutex*)
+    (if #t ;; need-sync
+	(db:sync-tables (db:sync-all-tables-list) update_info inmem db)
+	(debug:print 0 *default-log-port* "Skipping sync as nothing touched."))
     (mutex-lock! *db-multi-sync-mutex*)
-    (set! *db-last-sync* start-t)
-    (set! *db-last-access* start-t)
-    (mutex-unlock! *db-multi-sync-mutex*)
-    (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))
+    (dbr:dbdat-last-sync-set! dbdat start-t)
+    (dbr:dbdat-last-write-set! dbdat start-t)
+    (mutex-unlock! *db-multi-sync-mutex*)))
+
 
 (define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
   (if (<= try-num 0)
       #f
       (handle-exceptions
@@ -500,40 +362,23 @@
 	      #t)
 	    #f))))
 
 ;; close all opened run-id dbs
 (define (db:close-all dbstruct)
-  (if (dbr:dbstruct? dbstruct)
-      (handle-exceptions
-	  exn
-	  (begin
-	    (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
-	    (print-call-chain *default-log-port*))
-	;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
-        (let ((tdbs       (map db:dbdat-get-db 
-			       (stack->list (dbr:dbstruct-dbstack dbstruct))))
-              (mdb        (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
-              (rdb        (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct)))
-	      (stmt-cache (dbr:dbstruct-stmt-cache dbstruct)))
-          (map (lambda (db)
-		 (db:safely-close-sqlite3-db db stmt-cache))
-	       tdbs)
-          (db:safely-close-sqlite3-db mdb stmt-cache)     ;; (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
-          (db:safely-close-sqlite3-db rdb stmt-cache))))) ;; (if (sqlite3:database? rdb) (sqlite3:finalize! rdb))))))
-
-;;   (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
-;;     (if (hash-table? locdbs)
-;; 	(for-each (lambda (run-id)
-;; 		    (db:close-run-db dbstruct run-id))
-;; 		  (hash-table-keys locdbs)))))
-
-;; (define (db:open-inmem-db)
-;;   (let* ((db      (sqlite3:open-database ":memory:"))
-;; 	 (handler (make-busy-timeout 3600)))
-;;     (sqlite3:set-busy-handler! db handler)
-;;     (db:initialize-run-id-db db)
-;;     (cons db #f)))
+  (assert (dbr:dbstruct? dbstruct) "FATAL: db:close-all called with dbstruct not set up.")
+  (handle-exceptions
+   exn
+   (begin
+     (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
+     (print-call-chain *default-log-port*))
+   ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
+   (let ((tdbs       (map db:dbdat-db 
+			  (hash-table-values (dbr:dbstruct-dbdats dbstruct))))
+	 (stmt-cache (dbr:dbstruct-stmt-cache dbstruct)))
+     (map (lambda (db)
+	    (db:safely-close-sqlite3-db db stmt-cache))
+	  tdbs))))
 
 ;; just tests, test_steps and test_data tables
 (define db:sync-tests-only
   (list
    ;; (list "strs"
@@ -586,12 +431,12 @@
 	 '("type"           #f)
          '("last_update"    #f))))
 
 ;; needs db to get keys, this is for syncing all tables
 ;;
-(define (db:sync-main-list dbstruct)
-  (let ((keys  (db:get-keys dbstruct)))
+(define (db:sync-main-list) ;;  dbstruct)
+  (let ((keys  (common:get-fields *configdat*))) ;; (db:get-keys dbstruct)))
     (list
      (list "keys"
 	   '("id"        #f)
 	   '("fieldname" #f)
 	   '("fieldtype" #f))
@@ -709,11 +554,11 @@
 	 
 	 (sqlite3:finalize! db)
 	 #t))))))
     
 ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
-;; db's are dbdat's
+;; db's are sqlite3 handles
 ;;
 ;; if last-update specified ("field-name" . time-in-seconds)
 ;;    then sync only records where field-name >= time-in-seconds
 ;;    IFF field-name exists
 ;;
@@ -740,16 +585,16 @@
    (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)
-    ((or (not (file-exists? fromdb))(not (file-exists? todb)))
+    #;((or (not (file-exists? fromdb))(not (file-exists? todb)))
      (debug:print-info 0 *default-log-port* "db:sync-tables called but db files do not exist.") 0)
-    ((not (sqlite3:database? (db:dbdat-get-db fromdb)))
+    ((not (sqlite3:database? (db:dbdat-db fromdb)))
      (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb)
      -3)
-    ((not (sqlite3:database? (db:dbdat-get-db todb)))
+    ((not (sqlite3:database? (db:dbdat-db todb)))
      (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb)
      -4)
     ((not (file-writable? (db:dbdat-get-path todb)))
      (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a read-only database " todb)
      -5)
@@ -1030,31 +875,31 @@
       (debug:print 2 *default-log-port* "not doing cached calls right now"))
 ;;      (apply db:call-with-cached-db db-cmd params)
       (apply rmt-cmd params))
 ;;)
 
-;; return the target db handle so it can be used
-;;
-(define (db:cache-for-read-only source target #!key (use-last-update #f))
-  (assert *toppath* "ERROR: db:cache-for-read-only called before launch:setup. This is fatal.")
-  (if (and (hash-table-ref/default *global-db-store* target #f)
-	   (>= (file-modification-time target)(file-modification-time source)))
-      (hash-table-ref *global-db-store* target)
-      (let* ((toppath  *toppath*) ;;  (launch:setup))
-	     (targ-db-last-mod (if (common:file-exists? target)
-				   (file-modification-time target)
-				   0))
-	     (cache-db  (or (hash-table-ref/default *global-db-store* target #f)
-			    (db:open-megatest-db path: target)))
-	     (source-db (db:open-megatest-db path: source))
-	     (curr-time (current-seconds))
-	     (res      '())
-	     (last-update (if use-last-update (cons "last_update" targ-db-last-mod) #f)))
-	(db:sync-tables (db:sync-main-list source-db) last-update source-db cache-db)
-	(db:sync-tables db:sync-tests-only last-update source-db cache-db)
-	(hash-table-set! *global-db-store* target cache-db)
-	cache-db)))
+;; ;; ;; return the target db handle so it can be used
+;; ;; ;;
+;; ;; (define (db:cache-for-read-only source target #!key (use-last-update #f))
+;; ;;   (assert *toppath* "ERROR: db:cache-for-read-only called before launch:setup. This is fatal.")
+;; ;;   (if (and (hash-table-ref/default *global-db-store* target #f)
+;; ;; 	   (>= (file-modification-time target)(file-modification-time source)))
+;; ;;       (hash-table-ref *global-db-store* target)
+;; ;;       (let* ((toppath  *toppath*) ;;  (launch:setup))
+;; ;; 	     (targ-db-last-mod (if (common:file-exists? target)
+;; ;; 				   (file-modification-time target)
+;; ;; 				   0))
+;; ;; 	     (cache-db  (or (hash-table-ref/default *global-db-store* target #f)
+;; ;; 			    (db:open-megatest-db path: target)))
+;; ;; 	     (source-db (db:open-megatest-db path: source))
+;; ;; 	     (curr-time (current-seconds))
+;; ;; 	     (res      '())
+;; ;; 	     (last-update (if use-last-update (cons "last_update" targ-db-last-mod) #f)))
+;; ;; 	(db:sync-tables (db:sync-main-list source-db) last-update source-db cache-db)
+;; ;; 	(db:sync-tables db:sync-tests-only last-update source-db cache-db)
+;; ;; 	(hash-table-set! *global-db-store* target cache-db)
+;; ;; 	cache-db)))
 
 ;; ;; call a proc with a cached db
 ;; ;;
 ;; (define (db:call-with-cached-db proc . params)
 ;;   ;; first cache the db in /tmp
@@ -1095,124 +940,124 @@
 ;;  'new2old      - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
 ;;  '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 dbstruct . options)
-  ;; (if (not (launch:setup))
-  ;;    (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
-  (let* ((mtdb     (dbr:dbstruct-mtdb dbstruct))
-	 (tmpdb    (db:get-db dbstruct))
-	 (refndb   (dbr:dbstruct-refndb dbstruct))
-	 (allow-cleanup #t) ;; (if run-ids #f #t))
-	 (servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat)))
-	 (data-synced 0)) ;; count of changed records (I hope)
-    
-    (for-each
-     (lambda (option)
-
-       (case option
-	 ;; kill servers
-	 ((killservers)
-	  (for-each
-	   (lambda (server)
-             (handle-exceptions
-             exn
-             (begin 
-               (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " server ", exn=" exn)     
-               #f)
-	     (match-let (((mod-time host port start-time server-id pid) server))
-	       (if (and host pid)
-		   (tasks:kill-server host pid)))))
-	   servers)
-
-          ;; /tmp/bjbarcla/megatest_localdb/fullrun/.nfs.pdx.disks.icf_env_disk001.bjbarcla.gwa.issues.mtdev.matt-bisect.megatest.ext-tests.runs.all.v1.65.1.6524.dev.bb-24-justrollup-f8.rollup.fullrun/megatest.db.lock
-          (delete-file* (common:get-sync-lock-filepath))
-          )
-	 
-	 ;; clear out junk records
-	 ;;
-	 ((dejunk)
-	  ;; (db:delay-if-busy mtdb) ;; ok to delay on mtdb
-	  (when (file-writable? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
-	  (db:clean-up tmpdb)
-	  (db:clean-up refndb))
-
-	 ;; sync runs, test_meta etc.
-	 ;;
-	 ((old2new)
-	  (set! data-synced
-	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb)
-	       data-synced)))
-	 
-	 ;; now ensure all newdb data are synced to megatest.db
-	 ;; do not use the run-ids list passed in to the function
-	 ;;
-	 ((new2old)
-	  (set! data-synced
-	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
-	       data-synced)))
-
-	 ((adj-target)
-	  (db:adj-target (db:dbdat-get-db mtdb))
-	  (db:adj-target (db:dbdat-get-db tmpdb))
-	  (db:adj-target (db:dbdat-get-db refndb)))
-	 
-	 ((schema)
-	  (db:patch-schema-maindb (db:dbdat-get-db mtdb))
-	  (db:patch-schema-maindb (db:dbdat-get-db tmpdb))
-	  (db:patch-schema-maindb (db:dbdat-get-db refndb))
-	  (db:patch-schema-rundb  (db:dbdat-get-db mtdb))
-	  (db:patch-schema-rundb  (db:dbdat-get-db tmpdb))
-	  (db:patch-schema-rundb  (db:dbdat-get-db refndb))))
-       
-       (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb))
-     options)
-    data-synced))
-
-(define (db:tmp->megatest.db-sync dbstruct last-update)
-  (let* ((mtdb        (dbr:dbstruct-mtdb dbstruct))
-	 (tmpdb       (db:get-db dbstruct))
-	 (refndb      (dbr:dbstruct-refndb dbstruct))
-	 (res         (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb)))
-    (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)
-    res))
-
-;;;; run-ids
-;;    if #f use *db-local-sync* : or 'local-sync-flags
-;;    if #t use timestamps      : or 'timestamps
-;;
-;;  NB// no-sync-db is the db handle, not a flag!
-;;
-(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
-  (let* ((start-time         (current-seconds))
-	 (last-full-update   (if no-sync-db
-				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
-				 0))
-	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
-	 (last-update        (if full-sync-needed
-				 0
-				 (if no-sync-db
-				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
-				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
-	 (sync-needed        (> (- start-time last-update) 6))
-	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
-				     full-sync-needed)
-				 (begin
-				   (if no-sync-db
-				       (begin
-					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
-					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
-				   (db:tmp->megatest.db-sync dbstruct last-update))
-				 0))
-	 (sync-time           (- (current-seconds) start-time)))
-      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
-      (if (common:low-noise-print 30 "sync new to old")
-          (if sync-needed
-              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
-              (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
-      res))
+;; ;; (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* ((mtdb     (dbr:dbstruct-mtdb dbstruct))
+;; ;; 	 (tmpdb    (db:get-db dbstruct))
+;; ;; 	 (refndb   (dbr:dbstruct-refndb dbstruct))
+;; ;; 	 (allow-cleanup #t) ;; (if run-ids #f #t))
+;; ;; 	 (servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat)))
+;; ;; 	 (data-synced 0)) ;; count of changed records (I hope)
+;; ;;     
+;; ;;     (for-each
+;; ;;      (lambda (option)
+;; ;; 
+;; ;;        (case option
+;; ;; 	 ;; kill servers
+;; ;; 	 ((killservers)
+;; ;; 	  (for-each
+;; ;; 	   (lambda (server)
+;; ;;              (handle-exceptions
+;; ;;              exn
+;; ;;              (begin 
+;; ;;                (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " server ", exn=" exn)     
+;; ;;                #f)
+;; ;; 	     (match-let (((mod-time host port start-time server-id pid) server))
+;; ;; 	       (if (and host pid)
+;; ;; 		   (tasks:kill-server host pid)))))
+;; ;; 	   servers)
+;; ;; 
+;; ;;           ;; /tmp/bjbarcla/megatest_localdb/fullrun/.nfs.pdx.disks.icf_env_disk001.bjbarcla.gwa.issues.mtdev.matt-bisect.megatest.ext-tests.runs.all.v1.65.1.6524.dev.bb-24-justrollup-f8.rollup.fullrun/megatest.db.lock
+;; ;;           (delete-file* (common:get-sync-lock-filepath))
+;; ;;           )
+;; ;; 	 
+;; ;; 	 ;; clear out junk records
+;; ;; 	 ;;
+;; ;; 	 ((dejunk)
+;; ;; 	  ;; (db:delay-if-busy mtdb) ;; ok to delay on mtdb
+;; ;; 	  (when (file-writable? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
+;; ;; 	  (db:clean-up tmpdb)
+;; ;; 	  (db:clean-up refndb))
+;; ;; 
+;; ;; 	 ;; sync runs, test_meta etc.
+;; ;; 	 ;;
+;; ;; 	 ((old2new)
+;; ;; 	  (set! data-synced
+;; ;; 	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb)
+;; ;; 	       data-synced)))
+;; ;; 	 
+;; ;; 	 ;; now ensure all newdb data are synced to megatest.db
+;; ;; 	 ;; do not use the run-ids list passed in to the function
+;; ;; 	 ;;
+;; ;; 	 ((new2old)
+;; ;; 	  (set! data-synced
+;; ;; 	    (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
+;; ;; 	       data-synced)))
+;; ;; 
+;; ;; 	 ((adj-target)
+;; ;; 	  (db:adj-target (db:dbdat-get-db mtdb))
+;; ;; 	  (db:adj-target (db:dbdat-get-db tmpdb))
+;; ;; 	  (db:adj-target (db:dbdat-get-db refndb)))
+;; ;; 	 
+;; ;; 	 ((schema)
+;; ;; 	  (db:patch-schema-maindb (db:dbdat-get-db mtdb))
+;; ;; 	  (db:patch-schema-maindb (db:dbdat-get-db tmpdb))
+;; ;; 	  (db:patch-schema-maindb (db:dbdat-get-db refndb))
+;; ;; 	  (db:patch-schema-rundb  (db:dbdat-get-db mtdb))
+;; ;; 	  (db:patch-schema-rundb  (db:dbdat-get-db tmpdb))
+;; ;; 	  (db:patch-schema-rundb  (db:dbdat-get-db refndb))))
+;; ;;        
+;; ;;        (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb))
+;; ;;      options)
+;; ;;     data-synced))
+;; ;; 
+;; ;; (define (db:tmp->megatest.db-sync dbstruct last-update)
+;; ;;   (let* ((mtdb        (dbr:dbstruct-mtdb dbstruct))
+;; ;; 	 (tmpdb       (db:get-db dbstruct))
+;; ;; 	 (refndb      (dbr:dbstruct-refndb dbstruct))
+;; ;; 	 (res         (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb)))
+;; ;;     (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)
+;; ;;     res))
+;; ;; 
+;; ;; ;;;; run-ids
+;; ;; ;;    if #f use *db-local-sync* : or 'local-sync-flags
+;; ;; ;;    if #t use timestamps      : or 'timestamps
+;; ;; ;;
+;; ;; ;;  NB// no-sync-db is the db handle, not a flag!
+;; ;; ;;
+;; ;; (define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
+;; ;;   (let* ((start-time         (current-seconds))
+;; ;; 	 (last-full-update   (if no-sync-db
+;; ;; 				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
+;; ;; 				 0))
+;; ;; 	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
+;; ;; 	 (last-update        (if full-sync-needed
+;; ;; 				 0
+;; ;; 				 (if no-sync-db
+;; ;; 				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
+;; ;; 				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
+;; ;; 	 (sync-needed        (> (- start-time last-update) 6))
+;; ;; 	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
+;; ;; 				     full-sync-needed)
+;; ;; 				 (begin
+;; ;; 				   (if no-sync-db
+;; ;; 				       (begin
+;; ;; 					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
+;; ;; 					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
+;; ;; 				   (db:tmp->megatest.db-sync dbstruct last-update))
+;; ;; 				 0))
+;; ;; 	 (sync-time           (- (current-seconds) start-time)))
+;; ;;       (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
+;; ;;       (if (common:low-noise-print 30 "sync new to old")
+;; ;;           (if sync-needed
+;; ;;               (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
+;; ;;               (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
+;; ;;       res))
 
 ;; 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...")
@@ -5454,8 +5299,216 @@
 		     (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
 		     )))
 	     pkts)))))
       pktsdirs))
    use-lt: use-lt))
+
+;; ;; open an sql database inside a file lock
+;; ;; returns: db existed-prior-to-opening
+;; ;; RA => Returns a db handler; sets the lock if opened in writable mode
+;; ;;
+;; ;; (define *db-open-mutex* (make-mutex))
+;; 
+;; (define (db:lock-create-open fname initproc)
+;;   (let* ((parent-dir   (or (pathname-directory fname)(current-directory))) ;; no parent? go local
+;;          (raw-fname    (pathname-file fname))
+;; 	 (dir-writable (file-writable? parent-dir))
+;; 	 (file-exists  (common:file-exists? fname))
+;; 	 (file-write   (if file-exists
+;; 			   (file-writable? fname)
+;; 			   dir-writable )))
+;;     ;; (mutex-lock! *db-open-mutex*) ;; tried this mutex, not clear it helped.
+;;     (if file-write ;; dir-writable
+;; 	(condition-case
+;;          (let* ((lockfname   (conc fname ".lock"))
+;;                 (readyfname  (conc parent-dir "/.ready-" raw-fname))
+;;                 (readyexists (common:file-exists? readyfname)))
+;;            (if (not readyexists)
+;;                (common:simple-file-lock-and-wait lockfname))
+;;            (let ((db      (sqlite3:open-database fname)))
+;;              (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+;;              (sqlite3:execute db "PRAGMA synchronous = 0;")
+;;              #;(if (and (configf:lookup *configdat* "setup" "tmp_mode") (string-match "^/tmp/.*" fname))
+;;                  (begin
+;;                    ;;(print "DEBUG: Setting tmp_mode for " fname) 
+;;                    (sqlite3:execute db (configf:lookup *configdat* "setup" "tmp_mode"))
+;;                    )
+;;                  )  
+;;              #;(if (and (configf:lookup *configdat* "setup" "nfs_mode") (not (string-match "^/tmp/.*" fname)))
+;;                  (begin
+;;                    ;;(print "DEBUG: Setting nfs_mode for " fname)
+;;                    (sqlite3:execute db (configf:lookup *configdat* "setup" "nfs_mode"))
+;;                    )
+;;                  )  
+;;              #;(if (and (not (or (configf:lookup *configdat* "setup" "tmp_mode") (configf:lookup *configdat* "setup" "nfs_mode")))  
+;;                       (configf:lookup *configdat* "setup" "use-wal")
+;;                       (string-match "^/tmp/.*" fname)) ;; this is a file in /tmp
+;;                  (sqlite3:execute db "PRAGMA journal_mode=WAL;")
+;;                  (debug:print 2 *default-log-port* "Creating " fname " in NON-WAL mode."))
+;;              (if (not file-exists)
+;;                  (initproc db))
+;;              (if (not readyexists)
+;;                  (begin
+;;                    (common:simple-file-release-lock lockfname)
+;;                    (with-output-to-file
+;;                        readyfname
+;;                      (lambda ()
+;;                        (print "Ready at " 
+;;                               (seconds->year-work-week/day-time 
+;;                                (current-seconds)))))))
+;;              db))
+;;          (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
+;;          (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
+;;          (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
+;;          (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
+;;          (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
+;;         
+;; 	(condition-case
+;;          (begin
+;;            (debug:print 2 *default-log-port* "WARNING: opening db in non-writable dir " fname)
+;;            (let ((db (sqlite3:open-database fname)))
+;;              (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+;;              (sqlite3:execute db "PRAGMA synchronous = 0;")
+;; 	     ;; (mutex-unlock! *db-open-mutex*)
+;;              db))
+;;          (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
+;;          (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
+;;          (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
+;;          (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
+;;          (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
+;; 	)))
+
+
+;; ;; 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 run-id)
+;;   (let* ((max-stale-tmp (configf:lookup-number *configdat* "server" "filling-db-max-stale-seconds" default: 10))
+;; 	 (dbpath       (common:get-db-tmp-area ))      ;; path to tmp db area
+;; 	 (dbexists     (common:file-exists? dbpath))
+;; 	 (tmpdbfname   (conc dbpath "/megatest.db"))
+;; 	 (dbfexists    (common:file-exists? tmpdbfname))  ;; (conc dbpath "/megatest.db")))
+;; 	 (mtdbexists   (common:file-exists? (conc *toppath* "/megatest.db")))
+;; 	 
+;; 	 (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db"))   #f))
+;; 	 (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) 
+;; 	 (mtdb         (db:open-megatest-db))
+;; 	 (mtdbpath     (db:dbdat-get-path mtdb))
+;; 	 (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
+;; 	 (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
+;; 	 (write-access (file-writable? mtdbpath))
+;; 	 (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
+;; 
+;;           (when write-access
+;;             (sqlite3:execute (car mtdb) "drop trigger if exists update_tests_trigger")
+;;             (sqlite3:execute (car mtdb) "drop trigger if exists update_runs_trigger"))
+;;           
+;; 	  (if (and dbexists (not write-access))
+;;               (begin
+;;                 (set! *db-write-access* #f)
+;;                 (dbr:dbstruct-read-only-set! dbstruct #t)))
+;;           (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
+;;           (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
+;;           (if (and  (or (not dbfexists)
+;; 			(and modtimedelta
+;; 			     (> modtimedelta max-stale-tmp))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
+;; 		    do-sync)
+;; 	      (begin
+;; 		(debug:print 1 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n    from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
+;; 		(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
+;; 		;; touch tmp db to avoid wal mode wierdness  
+;; 		(set-file-times! tmpdbfname (current-seconds))  
+;;                 (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
+;;                 )
+;; 	      (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n     " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
+;; 	  ;; (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 do-sync #!key (areapath #f))
+;;   ;;
+;;   (cond
+;;    (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
+;;    (else ;;(common:on-homehost?)
+;;     (debug:print-info 13 *default-log-port* "db:setup entered (first time, not cached.)")
+;;     (let* ((dbstruct (make-dbr:dbstruct)))
+;;       (assert *toppath* "ERROR: db:setup called before launch:setup. This is fatal.")
+;;       #;(when (not *toppath*)
+;;         (debug:print-info 13 *default-log-port* "in db:setup, *toppath* not set; calling launch:setup")
+;;         (launch:setup areapath: areapath))
+;;       (debug:print-info 13 *default-log-port* "Begin db:open-db")
+;;       (db:open-db dbstruct areapath: areapath do-sync: do-sync)
+;;       (debug:print-info 13 *default-log-port* "Done db:open-db")
+;;       (set! *dbstruct-db* dbstruct)
+;;       ;;(debug:print-info 13 *default-log-port* "new dbstruct = "(dbr:dbstruct->alist dbstruct))
+;;       dbstruct))))
+;;    ;; (else
+;;    ;;  (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
+;;    ;;  (exit 1))))
+
+;; Open the classic megatest.db file (defaults to open in toppath)
+;;
+;;   NOTE: returns a dbdat not a dbstruct!
+;;
+
+;;(define (db:reopen-megatest-db
+
+;;======================================================================
+;; K E E P   F I L E D B   I N   dbstruct
+;;======================================================================
+
+;; (define (db:get-filedb dbstruct run-id)
+;;   (let ((db (vector-ref dbstruct 2)))
+;;     (if db
+;; 	db
+;; 	(let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db"))))
+;; 	  (vector-set! dbstruct 2 fdb)
+;; 	  fdb))))
+;; 
+;; ;; Can also be used to save arbitrary strings
+;; ;;
+;; (define (db:save-path dbstruct path)
+;;   (let ((fdb (db:get-filedb dbstruct)))b
+;;     (filedb:register-path fdb path)))
+;; 
+;; ;; Use to get a path. To get an arbitrary string see next define
+;; ;;
+;; (define (db:get-path dbstruct id)
+;;   (let ((fdb (db:get-filedb dbstruct)))
+;;     (filedb:get-path db id)))
+
+;;======================================================================
+;; alist-of-alists
+;;======================================================================
+;; 
+;; (define (db:aa-set! dat key1 key2 val)
+;;   (let loop ((
+
+;;======================================================================
+;; hash of hashs
+;;======================================================================
+
+(define (db:hoh-set! dat key1 key2 val)
+  (let* ((subhash (hash-table-ref/default dat key1 #f)))
+    (if subhash
+	(hash-table-set! subhash key2 val)
+	(begin
+	  (hash-table-set! dat key1 (make-hash-table))
+	  (db:hoh-set! dat key1 key2 val)))))
+
+(define (db:hoh-get dat key1 key2)
+  (let* ((subhash (hash-table-ref/default dat key1 #f)))
+    (and subhash
+	 (hash-table-ref/default subhash key2 #f))))
+
+(define (db:get-cache-stmth dbstruct db stmt)
+  (let* ((stmt-cache        (dbr:dbstruct-stmt-cache dbstruct))
+	 (stmth             (db:hoh-get stmt-cache db stmt)))
+    (or stmth
+	(let* ((newstmth (sqlite3:prepare db stmt)))
+	  (db:hoh-set! stmt-cache db stmt newstmth)
+	  newstmth))))
 
 
 )