Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -18,10 +18,11 @@
 
 ;; allow these queries through without starting a server
 ;;
 (define api:read-only-queries
   '(get-key-val-pairs
+    get-var
     get-keys
     get-key-vals
     test-toplevel-num-items
     get-test-info-by-id
     test-get-rundir-from-test-id
@@ -115,163 +116,172 @@
 ;;    - returns #( flag result )
 ;;
 (define (api:execute-requests dbstruct dat)
   (handle-exceptions
    exn
-   (let ((call-chain (get-call-chain)))
+   (let ((call-chain (get-call-chain))
+         )
      (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer")
      (print-call-chain (current-error-port))
      (debug:print 0 *default-log-port* " message: "  ((condition-property-accessor 'exn 'message) exn))       
      (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
-   (if (not (vector? dat))                    ;; it is an error to not receive a vector
-       (vector #f #f "remote must be called with a vector")       
-       (vector                                   ;; return a vector + the returned data structure
-	#t 
-	(let* ((cmd-in (vector-ref dat 0))
-	       (cmd    (if (symbol? cmd-in)
-			  cmd-in
-			  (string->symbol cmd-in)))
-	       (params (vector-ref dat 1))
-	       (start-t (current-milliseconds))
-	       (res    
-		(case cmd
-		  ;;===============================================
-		  ;; READ/WRITE QUERIES
-		  ;;===============================================
-
-		  ;; SERVERS
-		  ((start-server)                    (apply server:kind-run params))
-		  ((kill-server)                     (set! *server-run* #f))
-
-		  ;; TESTS
-		  ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
-		  ((delete-test-records)             (apply db:delete-test-records dbstruct params))
-		  ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
-		  ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
-		  ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
-		  ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
-		  ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
-		  ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))
-
-		  ;; RUNS
-		  ((register-run)                 (apply db:register-run dbstruct params))
-		  ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
-		  ((delete-run)                   (apply db:delete-run dbstruct params))
-		  ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
-		  ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
-		  ((update-run-stats)             (apply db:update-run-stats dbstruct params))
-		  ((set-var)                      (apply db:set-var dbstruct params))
-
-		  ;; STEPS
-		  ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
-
-		  ;; TEST DATA
-		  ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
-		  ((csv->test-data)               (apply db:csv->test-data dbstruct params))
-
-		  ;; MISC
-		  ((sync-inmem->db)               (let ((run-id (car params)))
-						    (db:sync-touched dbstruct run-id force-sync: #t)))
-		  ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
-
-		  ;; TESTMETA
-		  ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
-		  ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
-		  ((get-tests-tags)            (db:get-tests-tags dbstruct))
-
-		  ;; TASKS
-		  ((tasks-add)                 (apply tasks:add dbstruct params))   
-		  ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
-		  ((tasks-get-last)            (apply tasks:get-last dbstruct params))
-
-		  ;; ARCHIVES
-		  ;; ((archive-get-allocations)   
-		  ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
-		  ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
-		  ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
-
-		  ;;======================================================================
-		  ;; READ ONLY QUERIES
-		  ;;======================================================================
-
-		  ;; KEYS
-		  ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
-		  ((get-keys)                        (db:get-keys dbstruct))
-		  ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server
-		  ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
-		  ((get-target)                      (apply db:get-target dbstruct params))
-		  ((get-targets)                     (db:get-targets dbstruct))
-
-		  ;; ARCHIVES
-		  ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
-		  
-		  ;; TESTS
-		  ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
-		  ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
-		  ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
-		  ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
-		  ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
-		  ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
-		  ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
-		  ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
-		  ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
-		  ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
-		  ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
-		  ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
-		  ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
-		  ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
-		  ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
-		  ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
-		  ((synchash-get)                    (apply synchash:server-get dbstruct params))
-		  ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
-
-		  ;; RUNS
-		  ((get-run-info)                 (apply db:get-run-info dbstruct params))
-		  ((get-run-status)               (apply db:get-run-status dbstruct params))
-		  ((set-run-status)               (apply db:set-run-status dbstruct params))
-		  ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
-		  ((get-test-id)                  (apply db:get-test-id dbstruct params))
-		  ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
-		  ((get-runs)                     (apply db:get-runs dbstruct params))
-		  ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
-		  ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
-		  ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
-		  ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
-		  ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
-		  ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
-		  ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
-		  ((get-var)                      (apply db:get-var dbstruct params))
-		  ((get-run-stats)                (apply db:get-run-stats dbstruct params))
-
-		  ;; STEPS
-		  ((get-steps-data)               (apply db:get-steps-data dbstruct params))
-		  ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
-
-		  ;; TEST DATA
-		  ((read-test-data)               (apply db:read-test-data dbstruct params))
-
-		  ;; MISC
-		  ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
-		  ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
-		  ((login)                        (apply db:login dbstruct params))
-		  ((general-call)                 (let ((stmtname   (car params))
-							(run-id     (cadr params))
-							(realparams (cddr params)))
-						    (db:general-call dbstruct stmtname realparams)))
-		  ((sdb-qry)                      (apply sdb:qry params))
-		  ((ping)                         (current-process-id))
-
-		  ;; TESTMETA
-		  ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))
-
-		  ;; TASKS 
-		  ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params)))))
-	  (let ((delta-t (- (current-milliseconds)
-			    start-t)))
-	    (hash-table-set! *db-api-call-time* cmd
-			     (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
-	  res)))))
+   (cond
+    ((not (vector? dat))                    ;; it is an error to not receive a vector
+     (vector #f #f "remote must be called with a vector")       )
+    (else  
+     (let* ((cmd-in (vector-ref dat 0))
+            (cmd    (if (symbol? cmd-in)
+                        cmd-in
+                        (string->symbol cmd-in)))
+            (params (vector-ref dat 1))
+            (start-t (current-milliseconds))
+            (readonly-mode (dbr:dbstruct-read-only dbstruct))
+            (readonly-command (member cmd api:read-only-queries))
+            (writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
+            (res    
+             (if writecmd-in-readonly-mode
+                 (conc "attempt to run write command "cmd" on a read-only database")
+                 (case cmd
+                   ;;===============================================
+                   ;; READ/WRITE QUERIES
+                   ;;===============================================
+
+                   ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
+                   
+                   ;; SERVERS
+                   ((start-server)                    (apply server:kind-run params))
+                   ((kill-server)                     (set! *server-run* #f))
+
+                   ;; TESTS
+                   ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
+                   ((delete-test-records)             (apply db:delete-test-records dbstruct params))
+                   ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
+                   ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
+                   ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
+                   ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
+                   ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
+                   ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))
+
+                   ;; RUNS
+                   ((register-run)                 (apply db:register-run dbstruct params))
+                   ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
+                   ((delete-run)                   (apply db:delete-run dbstruct params))
+                   ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
+                   ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
+                   ((update-run-stats)             (apply db:update-run-stats dbstruct params))
+                   ((set-var)                      (apply db:set-var dbstruct params))
+
+                   ;; STEPS
+                   ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
+
+                   ;; TEST DATA
+                   ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
+                   ((csv->test-data)               (apply db:csv->test-data dbstruct params))
+
+                   ;; MISC
+                   ((sync-inmem->db)               (let ((run-id (car params)))
+                                                     (db:sync-touched dbstruct run-id force-sync: #t)))
+                   ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
+
+                   ;; TESTMETA
+                   ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
+                   ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
+                   ((get-tests-tags)            (db:get-tests-tags dbstruct))
+
+                   ;; TASKS
+                   ((tasks-add)                 (apply tasks:add dbstruct params))   
+                   ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
+                   ((tasks-get-last)            (apply tasks:get-last dbstruct params))
+
+                   ;; ARCHIVES
+                   ;; ((archive-get-allocations)   
+                   ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
+                   ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
+                   ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
+
+                   ;;======================================================================
+                   ;; READ ONLY QUERIES
+                   ;;======================================================================
+
+                   ;; KEYS
+                   ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct params))
+                   ((get-keys)                        (db:get-keys dbstruct))
+                   ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
+                   ((get-target)                      (apply db:get-target dbstruct params))
+                   ((get-targets)                     (db:get-targets dbstruct))
+
+                   ;; ARCHIVES
+                   ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct params))
+                   
+                   ;; TESTS
+                   ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
+                   ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
+                   ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
+                   ((get-count-tests-running-for-testname) (apply db:get-count-tests-running-for-testname dbstruct params))
+                   ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
+                   ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
+                   ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
+                   ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
+                   ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
+                   ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
+                   ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
+                   ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
+                   ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
+                   ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
+                   ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
+                   ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
+                   ((synchash-get)                    (apply synchash:server-get dbstruct params))
+                   ((get-raw-run-stats)               (apply db:get-raw-run-stats dbstruct params))
+
+                   ;; RUNS
+                   ((get-run-info)                 (apply db:get-run-info dbstruct params))
+                   ((get-run-status)               (apply db:get-run-status dbstruct params))
+                   ((set-run-status)               (apply db:set-run-status dbstruct params))
+                   ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
+                   ((get-test-id)                  (apply db:get-test-id dbstruct params))
+                   ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
+                   ((get-runs)                     (apply db:get-runs dbstruct params))
+                   ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
+                   ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
+                   ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
+                   ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
+                   ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
+                   ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
+                   ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
+                   ((get-var)                      (apply db:get-var dbstruct params))
+                   ((get-run-stats)                (apply db:get-run-stats dbstruct params))
+
+                   ;; STEPS
+                   ((get-steps-data)               (apply db:get-steps-data dbstruct params))
+                   ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
+
+                   ;; TEST DATA
+                   ((read-test-data)               (apply db:read-test-data dbstruct params))
+
+                   ;; MISC
+                   ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
+                   ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
+                   ((login)                        (apply db:login dbstruct params))
+                   ((general-call)                 (let ((stmtname   (car params))
+                                                         (run-id     (cadr params))
+                                                         (realparams (cddr params)))
+                                                     (db:general-call dbstruct stmtname realparams)))
+                   ((sdb-qry)                      (apply sdb:qry params))
+                   ((ping)                         (current-process-id))
+
+                   ;; TESTMETA
+                   ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))
+
+                   ;; TASKS 
+                   ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))))))
+       (if (not writecmd-in-readonly-mode)
+           (let ((delta-t (- (current-milliseconds)
+                             start-t)))
+             (hash-table-set! *db-api-call-time* cmd
+                              (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '())))
+             (vector #t res))
+           (vector #f res)))))))
 
 ;; http-server  send-response
 ;;                 api:process-request
 ;;                    db:*
 ;;

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -272,31 +272,46 @@
 ;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
 ;;
 (define (common:exit-on-version-changed)
   (if (common:version-changed?)
       (if (common:on-homehost?)
-	  (let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
-		(dbstruct (db:setup)))
+	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
+                (dbfile (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.db"))
+                (read-only (not (file-write-access? dbfile)))
+                (dbstruct (db:setup)))
 	    (debug:print 0 *default-log-port*
 			 "WARNING: Version mismatch!\n"
 			 "   expected: " (common:version-signature) "\n"
 			 "   got:      " (common:get-last-run-version))
-	    (if (and (file-exists? mtconf)
-		     (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
-		(begin
-		  (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
-		  (handle-exceptions
-		   exn
-		   (begin
-		     (debug:print 0 *default-log-port* "Failed to switch versions.")
-		     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-		     (print-call-chain (current-error-port))
-		     (exit 1))
-		   (common:cleanup-db dbstruct)))
-		(begin
-		  (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
-		  (exit 1))))
+            (cond
+             ((get-environment-variable "MT_SKIP_DB_MIGRATE") #t)
+             ((and (file-exists? mtconf) (file-exists? dbfile) (not read-only)
+                   (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
+              (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
+              (handle-exceptions
+               exn
+               (begin
+                 (debug:print 0 *default-log-port* "Failed to switch versions.")
+                 (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+                 (print-call-chain (current-error-port))
+                 (exit 1))
+               (common:cleanup-db dbstruct)))
+             ((not (file-exists? mtconf))
+              (debug:print 0 *default-log-port* "   megatest.config does not exist in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             ((not (file-exists? dbfile))
+              (debug:print 0 *default-log-port* "   megatest.db does not exist in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             ((not (eq? (current-user-id)(file-owner mtconf)))
+              (debug:print 0 *default-log-port* "   You do not own megatest.db in this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             (read-only
+              (debug:print 0 *default-log-port* "   You have read-only access to this area.  Cannot proceed with megatest version migration.")
+              (exit 1))
+             (else
+              (debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
+              (exit 1))))
 	  (begin
 	    (debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
 	    (exit 1)))))
 
 ;;======================================================================
@@ -584,19 +599,48 @@
 (define *wdnum* 0)
 (define *wdnum*mutex (make-mutex))
 ;; 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)
+
+
+(define (common:readonly-watchdog dbstruct)
+  (thread-sleep! 0.05) ;; delay for startup
+
+  ;; sync megatest.db to /tmp/.../megatst.db
+  (let ((sync-cool-off-duration   3)
+        (golden-mtdb     (dbr:dbstruct-mtdb dbstruct))
+        (golden-mtpath   (db:dbdat-get-path mtdb))
+        (tmp-mtdb        (dbr:dbstruct-tmpdb dbstruct))
+        (tmp-mtpath      (db:dbdat-get-path mtdb)))
+    (debug:print-info 0 *default-log-port* "Read-only periodic sync thread started.")
+    (let loop ((last-sync-time 0))
+      (let* ((duration-since-last-sync (- (current-seconds) last-sync-time)))
+        (if (and (not *time-to-exit*)
+                 (< duration-since-last-sync sync-cool-off-duration))
+            (thread-sleep! (- sync-cool-off-duration duration-since-last-sync)))
+        (if (not *time-to-exit*)
+            (let ((golden-mtdb-mtime (file-modification-time golden-mtpath))
+                  (tmp-mtdb-mtime    (file-modification-time tmp-mtpath)))
+              (if (> golden-mtdb-mtime tmp-mtdb-mtime)
+                  (let ((res (db:multi-db-sync dbstruct 'old2new)))
+                    (debug:print-info 0 *default-log-port* "rosync called, " res " records transferred."))
+                  (loop (current-seconds)))
+              #t))))
+    (debug:print-info 0 *default-log-port* "Exiting readonly-watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" mtpath="golden-mtpath)))
+
+
+        
+(define (common:writable-watchdog dbstruct)
   (thread-sleep! 0.05) ;; delay for startup
   (let ((legacy-sync (common:run-sync?))
 	(debug-mode  (debug:debug-mode 1))
 	(last-time   (current-seconds))
         (this-wd-num     (begin (mutex-lock! *wdnum*mutex) (let ((x *wdnum*)) (set! *wdnum* (add1 *wdnum*)) (mutex-unlock! *wdnum*mutex) x))))
     (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is " legacy-sync" pid="(current-process-id)" this-wd-num="this-wd-num)
     (if (and legacy-sync (not *time-to-exit*))
-	(let* ((dbstruct (db:setup))
+	(let* (;;(dbstruct (db:setup))
 	       (mtdb     (dbr:dbstruct-mtdb dbstruct))
 	       (mtpath   (db:dbdat-get-path mtdb)))
 	  (debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
 	  (let loop ()
 	    ;; sync for filesystem local db writes
@@ -649,10 +693,18 @@
 			(thread-sleep! 1)
 			(delay-loop (+ count 1))))
 		  (if (not *time-to-exit*) (loop))))
 	    (if (common:low-noise-print 30)
 		(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" this-wd-num="this-wd-num)))))))
+
+;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
+(define (common:watchdog)
+  (let ((dbstruct (db:setup)))
+    (if (dbr:dbstruct-read-only dbstruct)
+        (common:readonly-watchdog dbstruct)
+        (common:writable-watchdog dbstruct))))
+
 
 (define (std-exit-procedure)
   (on-exit (lambda () 0))
   ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
   (let ((no-hurry  (if *time-to-exit* ;; hurry up

Index: common_records.scm
==================================================================
--- common_records.scm
+++ common_records.scm
@@ -124,19 +124,24 @@
 
 ;; Brandon's debug printer shortcut (indulge me :)
 (define *BB-process-starttime* (current-milliseconds))
 (define (BB> . in-args)
   (let* ((stack (get-call-chain))
-         (location #f))
+         (location "??"))
     (for-each
      (lambda (frame)
        (let* ((this-loc (vector-ref frame 0))
-              (this-func (cadr (string-split this-loc " "))))
+              (temp     (string-split (->string this-loc) " "))
+              (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
          (if (equal? this-func "BB>")
              (set! location this-loc))))
      stack)
-    (let ((dp-args (append (list 0 *default-log-port* (conc location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000)"   ")  ) in-args)))
+    (let ((dp-args
+           (append
+            (list 0 *default-log-port*
+                  (conc location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000)"   ")  )
+            in-args)))
       (apply debug:print dp-args))))
 
 (define *BBpp_custom_expanders_list* (make-hash-table))
 
 

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -42,16 +42,17 @@
 
 ;; each db entry is a pair ( db . dbfilepath )
 ;; I propose this record evolves into the area record
 ;;
 (defstruct dbr:dbstruct 
-  ;; (tmpdb       #f)
+  (tmpdb       #f)
   (dbstack     #f) ;; stack for tmp db handles, do not initialize with a stack
   (mtdb        #f)
   (refndb      #f)
   (homehost    #f) ;; not used yet
   (on-homehost #f) ;; not used yet
+  (read-only   #f)
   )                ;; goal is to converge on one struct for an area but for now it is too confusing
   
 
 ;; record for keeping state,status and count for doing roll-ups in
 ;; iterated tests
@@ -269,11 +270,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))
+(define (db:open-db dbstruct #!key (areapath #f)) ;; TODO: actually use areapath
   (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct
     (if (stack? tmpdb-stack)
 	(db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used
         (let* ((dbpath       (db:dbfile-path)) ;;  0))
                (dbexists     (file-exists? dbpath))
@@ -281,13 +282,15 @@
                (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
                (mtdb         (db:open-megatest-db))
                (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
                (write-access (file-write-access? dbpath)))
           (if (and dbexists (not write-access))
-              (set! *db-write-access* #f))
+              (begin (set! *db-write-access* #f)
+                     (dbr:dbstruct-readonly-set! dbstruct #t)))
           (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
-          (dbr:dbstruct-dbstack-set! dbstruct (make-stack))
+          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
+          (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
           (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
           (dbr:dbstruct-refndb-set! dbstruct refndb)
           ;;	    (mutex-unlock! *rundb-mutex*)
           (if (and (not dbfexists)
                    write-access) ;; *db-write-access*) ;; did not have a prior db and do have write access
@@ -301,19 +304,22 @@
 ;; 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))
-  (or *dbstruct-db*
-      (if (common:on-homehost?)
-	  (let* ((dbstruct (make-dbr:dbstruct)))
-	    (db:open-db dbstruct areapath: areapath)
-	    (set! *dbstruct-db* dbstruct)
-	    dbstruct)
-	  (begin
-	    (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
-	    (exit 1)))))
+  ;;
+  (cond
+   (*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
+   (else ;;(common:on-homehost?)
+    (let* ((dbstruct (make-dbr:dbstruct)))
+      (when (not *toppath*) (launch:setup areapath: areapath))
+      (db:open-db dbstruct areapath: areapath)
+      (set! *dbstruct-db* 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!
 ;;
@@ -555,16 +561,35 @@
 	       (cons todb slave-dbs))
      
      0)
    ;; 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 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)
+     (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)))
-     (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb) -4)
+     (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb)
+     -4)
+
+    ((not (file-write-access? (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)
+    ((not (null? (let ((readonly-slave-dbs
+                        (filter
+                         (lambda (dbdat)
+                           (not (file-write-access? (db:dbdat-get-path todb))))
+                         slave-dbs)))
+                   (for-each
+                    (lambda (bad-dbdat)
+                      (debug:print-error
+                       0 *default-log-port* "db:sync-tables called with todb not a read-only database " bad-dbdat))
+                    readonly-slave-dbs)
+                   readonly-slave-dbs))) -6)
     (else
      (let ((stmts       (make-hash-table)) ;; table-field => stmt
 	   (all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
 	   (numrecs     (make-hash-table))
 	   (start-time  (current-milliseconds))
@@ -811,15 +836,14 @@
 ;; options:
 ;;
 ;;  'killservers  - kills all servers
 ;;  'dejunk       - removes junk records
 ;;  'adj-testids  - move test-ids into correct ranges
-;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db
-;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
+;;  'old2new      - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
+;;  '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.")
@@ -858,11 +882,13 @@
 
 	;; sync runs, test_meta etc.
 	;;
 	(if (member 'old2new options)
 	    ;; (begin
-	    (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb))
+            (set! data-synced
+                  (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb)
+                     data-synced)))
 			      ;; (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
 ;; 	      (for-each 
 ;; 	       (lambda (run-id)
 ;; 		 (db:delay-if-busy mtdb)
 ;; 		 (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
@@ -877,10 +903,11 @@
 	;;
 	(if (member 'new2old options)
 	    (set! data-synced
 		  (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
 		      data-synced)))
+
 
 
         (if (member 'fixschema options)
             (begin
               (db:patch-schema-maindb (db:dbdat-get-db mtdb))

ADDED   docs/api_access_methods_evolution.ods
Index: docs/api_access_methods_evolution.ods
==================================================================
--- /dev/null
+++ docs/api_access_methods_evolution.ods
cannot compute difference between binary files

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -721,24 +721,24 @@
 ;;   side effects:
 ;;     sets; *configdat*    (megatest.config info)
 ;;           *runconfigdat* (runconfigs.config info)
 ;;           *configstatus* (status of the read data)
 ;;
-(define (launch:setup #!key (force #f))
+(define (launch:setup #!key (force #f) (areapath #f))
   (mutex-lock! *launch-setup-mutex*)
   (if (and *toppath*
 	   (eq? *configstatus* 'fulldata)) ;; got it all
       (begin
 	(debug:print 0 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata")
 	(mutex-unlock! *launch-setup-mutex*)
 	*toppath*)
-      (let ((res (launch:setup-body force: force)))
+      (let ((res (launch:setup-body force: force areapath: areapath)))
 	(mutex-unlock! *launch-setup-mutex*)
 	res)))
 
-(define (launch:setup-body #!key (force #f))
-  (let* ((toppath  (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
+(define (launch:setup-body #!key (force #f) (areapath #f))
+  (let* ((toppath  (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
 	 (runname  (common:args-get-runname))
 	 (target   (common:args-get-target))
 	 (linktree (common:get-linktree))
 	 (sections (if target (list "default" target) #f)) ;; for runconfigs
 	 (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -364,10 +364,12 @@
 (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
   (if targ (setenv "MT_TARGET" targ)))
 
 ;; The watchdog is to keep an eye on things like db sync etc.
 ;;
+
+;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
 (define *watchdog* (make-thread common:watchdog "Watchdog thread"))
 
 (if (not (args:get-arg "-server"))
     (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
 
@@ -2019,10 +2021,11 @@
     (debug:print 0 *default-log-port* help))
 ;;(BB> "thread-join! watchdog")
 
 ;; join the watchdog thread if it has been thread-start!ed  (it may not have been started in the case of a server that never enters running state)
 ;;   (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
+;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
 (if (thread? *watchdog*)
     (case (thread-state *watchdog*)
       ((ready running blocked sleeping terminated dead)
        (thread-join! *watchdog*))))
 

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -55,16 +55,37 @@
   ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote
   ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds.
   ;; 3. do the query, if on homehost use local access
   ;;
   (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
+         (areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
+         (dbfile (conc *toppath* "/megatest.db"))
+         (readonly-mode (not (file-write-access? dbfile))) ;; TODO: use dbstruct or runremote to figure this out in future
 	 (runremote  (or area-dat *runremote*)))
+    ;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile)
     (cond
      ;; give up if more than 15 attempts
      ((> attemptnum 15)
       (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.")
       (exit 1))
+
+     ;; readonly mode, read request-  handle it - case 20
+     ((and readonly-mode
+           (member cmd api:read-only-queries)) 
+      (mutex-unlock! *rmt-mutex*)
+      (debug:print-info 12 *default-log-port* "rmt:send-receive, case 20")
+      (rmt:open-qry-close-locally cmd 0 params)
+      )
+
+     ;; readonly mode, write request.  Do nothing, return #f
+     (readonly-mode
+      (mutex-unlock! *rmt-mutex*)
+      (debug:print-info 12 *default-log-port* "rmt:send-receive, case 21")
+      (debug:print 0 *default-log-port* "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
+      #f
+      )
+
      ;; reset the connection if it has been unused too long
      ((and runremote
            (remote-conndat runremote)
 	   (let ((expire-time (+ (- start-time (remote-server-timeout runremote))(random 30)))) ;; add 30 seconds of noise so that not all running tests expire at the same time causing a storm of server starts
 	     (< (http-transport:server-dat-get-last-access (remote-conndat runremote)) expire-time)))

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -202,10 +202,12 @@
   (let* ((keys               (keys:config-get-fields *configdat*))
 	 (keyvals            (keys:target->keyval keys target))
 	 (run-id             (rmt:register-run keyvals runname "new" "n/a" user))  ;;  test-name)))
 	 ;; (deferred          '()) ;; delay running these since they have a waiton clause
 	 (runconfigf         (conc  *toppath* "/runconfigs.config"))
+         (dbfile             (conc  *toppath* "/megatest.db"))
+         (readonly-mode      (not (file-write-access? dbfile)))
 	 (test-records       (make-hash-table))
 	 ;; need to process runconfigs before generating these lists
 	 (all-tests-registry #f)  ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
 	 (all-test-names     #f)  ;; (hash-table-keys all-tests-registry))
 	 (test-names         #f)  ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
@@ -212,15 +214,20 @@
 	 (required-tests     #f)  ;; Put fully qualified test/testpath names in this list to be done
 	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
 	 (tdbdat             (tasks:open-db))
 	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
 			       (if x (string->number x) #f))))
+
+    ;; check if readonly
+    (when readonly-mode
+      (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed.")
+      (exit 1))
 
     ;; per user request. If less than 100Meg space on dbdir partition, bail out with error
     ;; this will reduce issues in database corruption
     (common:check-db-dir-and-exit-if-insufficient)
-    
+
     ;; override the number of reruns from the configs
     (if (and config-reruns
 	     (> run-count config-reruns))
 	(set! run-count config-reruns))
     
@@ -1639,10 +1646,20 @@
 	 (states       (if state  (string-split state  ",") '()))
 	 (statuses     (if status (string-split status ",") '()))
 	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
 	 (rp-mutex     (make-mutex))
 	 (bup-mutex    (make-mutex)))
+
+    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait))
+           (dbfile             (conc  *toppath* "/megatest.db"))
+           (readonly-mode      (not (file-write-access? dbfile))))
+      (when (and readonly-mode
+                 (member action write-access-actions))
+        (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")
+        (exit 1)))
+
+    
     (debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)
     (if (> 2 (length state-status))
 	(begin
 	  (debug:print-error 0 *default-log-port* "the parameter to -set-state-status is a comma delimited string. E.g. COMPLETED,FAIL")
 	  (exit)))
@@ -1892,10 +1909,12 @@
 	      (full-runconfigs-read) ;; cache the run config
 	      (launch:cache-config)) ;; do not cache here - need to be sure runconfigs is processed
 	    (begin 
 	      (debug:print 0 *default-log-port* "Failed to setup, exiting")
 	      (exit 1)))
+
+        
 	(set! keys (keys:config-get-fields *configdat*))
 	;; have enough to process -target or -reqtarg here
 	(if (args:get-arg "-reqtarg")
 	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL 
 		   (runconfig  (read-config runconfigf #f #t environ-patt: #f)))