Index: archive.scm ================================================================== --- archive.scm +++ archive.scm @@ -407,11 +407,11 @@ (bup-restore-params (list "-d" archive-path "restore" "-C" *toppath* archive-internal-path))) (debug:print-info 2 *default-log-port* "Restoring archived data to " *toppath* " from archive in " archive-path " ... " archive-internal-path) (run-n-wait bup-exe params: bup-restore-params print-cmd: "Running:")) (sleep 2) (db:multi-db-sync - (db:setup #t) ;; (db:setup-db *dbstruct-dbs* *toppath* #f) + (db:setup) ;; (db:setup-db *dbstruct-dbs* *toppath* #f) 'killservers ;'dejunk ;'adj-testids 'old2new ) Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -613,11 +613,11 @@ (common:on-homehost?)) (if (common:api-changed?) (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config")) (dbfile (conc (get-environment-variable "MT_RUN_AREA_HOME") ".mtdb/main.db")) (read-only (not (file-write-access? dbfile))) - (dbstruct (db:setup #t))) ;; (db:setup-db *dbstruct-dbs* *toppath* #f))) ;; #t))) + (dbstruct (db:setup))) ;; (db:setup-db *dbstruct-dbs* *toppath* #f))) ;; #t))) (debug:print 0 *default-log-port* "WARNING: Version mismatch!\n" " expected: " (common:version-signature) "\n" " got: " (common:get-last-run-version)) (cond ADDED dashboard-transport-mode.scm Index: dashboard-transport-mode.scm ================================================================== --- /dev/null +++ dashboard-transport-mode.scm @@ -0,0 +1,22 @@ +;;====================================================================== +;; set up transport, db cache and sync methods +;; +;; sync-method: 'original, 'attach or 'none +;; cache-method: 'tmp or 'none +;; rmt:transport-mode: 'http, 'tcp, 'nfs +;; +;; NOTE: NOT ALL COMBINATIONS WORK +;; +;;====================================================================== + +;; uncomment this block to test without tcp or cachedb +;; (dbfile:sync-method 'none) +;; (dbfile:cache-method 'none) +;; (rmt:transport-mode 'nfs) + +;; uncomment this block to test with tcp and cachedb +(dbfile:sync-method 'none) ;; original was causing crash on start. +(dbfile:cache-method 'none) +(rmt:transport-mode 'nfs) + + Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -907,16 +907,16 @@ (recently-done (< (- (current-seconds) (hash-table-ref/default *dashboard-last-run-id-update* run-id 0)) 3)) (run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)) ;; (last-update (if run-struct (dboard:rundat-last-update run-struct) 0)) (key-vals (rmt:get-key-vals run-id)) - (tests-ht (let* ((tht (if recently-done + (tests-ht (let* ((tht (if (and recently-done run-struct) (let ((rht (dboard:rundat-tests run-struct))) ;; (dboard:tabdat-allruns-by-id tabdat))) (or rht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))) (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)))) - (assert (hash-table? tht) "FATAL: But here tht should be a hash-table") + (assert (hash-table? tht) "FATAL: But here tht should be a hash-table") tht)) ;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate ;; dboard:get-tests-for-run-duplicate - returns a hash table ;; (dboard:get-tests-dat tabdat run-id last-update)) (all-test-ids (hash-table-keys tests-ht)) @@ -3954,11 +3954,11 @@ (define (sync-db-to-tmp tabdat) (let* ((db-file "./.mtdb/main.db")) (if (and (not (file-write-access? db-file)) ( > (current-seconds) (+ last-copy-time 5))) (begin - (db:multi-db-sync (db:setup #f) 'old2new) + (db:multi-db-sync (db:setup) 'old2new) (set! last-copy-time (current-seconds)) ) ) ) ) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -649,14 +649,14 @@ ;; (tmpdb (dbfile:open-db dbstruct run-id dbfile:db-init-proc))) (if dejunk (begin + (debug:print 0 *default-log-port* "Cleaning tmp DB") + (db:clean-up run-id tmpdb) (debug:print 0 *default-log-port* "Cleaning nfs DB") (db:clean-up run-id mtdb) - (debug:print 0 *default-log-port* "Cleaning tmp DB") - (db:clean-up run-id tmpdb) ) ) (debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds") (if old2new (begin Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -2434,11 +2434,11 @@ (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) ;; keep this one local ;; (open-run-close patch-db #f) - (let ((dbstructs (db:setup #f))) + (let ((dbstructs (db:setup))) (common:cleanup-db dbstructs full: #t)) (set! *didsomething* #t))) (if (args:get-arg "-cleanup-db") (begin @@ -2511,11 +2511,11 @@ (let* ((toppath (launch:setup)) (dbstructs (if (and toppath ;; NOTE: server:choose-server is starting a server ;; either add equivalent for tcp mode or ???? #;(server:choose-server toppath 'home?)) - (db:setup #t) + (db:setup) #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f))) (if *toppath* (cond ((getenv "MT_RUNSCRIPT") ;; How to run megatest scripts @@ -2602,11 +2602,11 @@ (if (args:get-arg "-import-megatest.db") (begin (launch:setup) (db:multi-db-sync - (db:setup #f) + (db:setup) 'killservers 'dejunk 'adj-testids 'old2new ) @@ -2618,11 +2618,11 @@ (rmt:import-sexpr (args:get-arg "-import-sexpr")) (set! *didsomething* #t))) (if (args:get-arg "-sync-to-megatest.db") (let* ((duh (launch:setup)) - (dbstruct (db:setup #t)) + (dbstruct (db:setup)) (tmpdbpth (dbr:dbstruct-tmppath dbstruct)) (lockfile (conc tmpdbpth ".lock")) (locked (common:simple-file-lock lockfile)) (res (if locked (db:multi-db-sync Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -148,11 +148,11 @@ res)) (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((qry-is-write (not (member cmd api:read-only-queries))) (db-file-path (common:make-tmpdir-name *toppath* "")) ;; 0)) - (dbstructs-local (db:setup #t)) + (dbstructs-local (db:setup)) (read-only (not (file-write-access? db-file-path))) (start (current-milliseconds)) (resdat (if (not (and read-only qry-is-write)) (let ((v (api:execute-requests dbstructs-local (vector (symbol->string cmd) params)))) ;; (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong.. ADDED transport-mode.scm Index: transport-mode.scm ================================================================== --- /dev/null +++ transport-mode.scm @@ -0,0 +1,22 @@ +;;====================================================================== +;; set up transport, db cache and sync methods +;; +;; sync-method: 'original, 'attach or 'none +;; cache-method: 'tmp 'none +;; rmt:transport-mode: 'http, 'tcp, 'nfs +;; +;; NOTE: NOT ALL COMBINATIONS WORK +;; +;;====================================================================== + +;; uncomment this block to test without tcp +;; (dbfile:sync-method 'none) +;; (dbfile:cache-method 'none) +;; (rmt:transport-mode 'nfs) + +;; uncomment this block to test with tcp +(dbfile:sync-method 'attach) ;; attach) ;; original +(dbfile:cache-method 'tmp) +(rmt:transport-mode 'tcp) + +