Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -16,10 +16,13 @@
# along with Megatest. If not, see .
TODO
====
+23WW21
+. Dashboard needs its own cache db in /tmp
+
23WW07
. Remove use of *dbstruct-dbs*
WW15
. fill newview matrix with data, filter pipeline gui elements
Index: dashboard-transport-mode.scm.template
==================================================================
--- dashboard-transport-mode.scm.template
+++ dashboard-transport-mode.scm.template
@@ -13,10 +13,10 @@
;; (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:sync-method 'attach) ;; original was causing crash on start.
(dbfile:cache-method 'none)
(rmt:transport-mode 'nfs)
Index: dbfile.scm
==================================================================
--- dbfile.scm
+++ dbfile.scm
@@ -200,12 +200,12 @@
)
#f
)
)
-(define (dbfile:make-tmpdir-name areapath)
- (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" "."))))
+(define (dbfile:make-tmpdir-name areapath tmpadj)
+ (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" ".") tmpadj)))
(unless (directory-exists? dname)
(create-directory dname #t))
dname))
(define (dbfile:run-id->path apath run-id)
Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -71,17 +71,17 @@
;;======================================================================
(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct
;; called in rmt.scm nfs-transport-handler
-(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath)
+(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath #!key (tmpadj ""))
(assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
(if dbstruct
dbstruct
- (let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk)))
+ (let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk tmpadj: tmpadj)))
(hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
newdbstruct))))
;;======================================================================
;; The cachedb one-db file per server method goes in here
@@ -97,12 +97,11 @@
(dbfile (dbr:dbdat-dbfile dbdat)))
;; if nfs mode do a sync if delta > 2
(let* ((last-update (dbr:dbstruct-last-update dbstruct))
(sync-proc (dbr:dbstruct-sync-proc dbstruct))
(curr-secs (current-seconds)))
- (if (and (not (eq? (dbfile:cache-method) 'none)) ;; used by dashboard, no need for sync
- (> (- curr-secs last-update) 5))
+ (if (> (- curr-secs last-update) 5)
(begin
(sync-proc last-update)
;; MOVE THIS CALL TO INSIDE THE sync-proc CALL
(dbr:dbstruct-last-update-set! dbstruct curr-secs)
@@ -172,11 +171,11 @@
(lambda ()
(let* ((dbexists (file-exists? dbfullname))
(db (sqlite3:open-database dbfullname))
(handler (sqlite3:make-busy-timeout 136000)))
(sqlite3:set-busy-handler! db handler)
- (if (and dbexists
+ (if (and (not dbexists)
write-access)
(init-proc db))
db))
run-anyway: #t))
@@ -191,18 +190,19 @@
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;;
(define (dbmod:open-dbmoddb areapath run-id dbfname-in init-proc keys
#!key (dbstruct-in #f)
- ;; (dbcontext 'megatest) ;; use dashboard to do the dashboard
+ ;; (dbcontext 'megatest) ;; use dashboard to do the dashboard
+ (tmpadj "") ;; add to tmp path
(syncdir 'todisk)) ;; todisk is used when caching in /tmp and writing data back to MTRAH
(let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
(dbfname (or dbfname-in (dbmod:run-id->dbfname run-id)))
(dbpath (dbmod:get-dbdir dbstruct)) ;; directory where all the .db files are kept
(dbfullname (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
(dbexists (file-exists? dbfullname))
- (tmpdir (dbfile:make-tmpdir-name areapath))
+ (tmpdir (dbfile:make-tmpdir-name areapath tmpadj))
(tmpdb (let* ((fname (conc tmpdir"/"dbfname)))
fname))
(cachedb (dbmod:open-cachedb-db init-proc
;; (if (eq? (dbfile:cache-method) 'cachedb)
;; #f
@@ -226,11 +226,13 @@
(dbr:dbstruct-sync-proc-set! dbstruct
(lambda (last-update)
(if *sync-in-progress*
(debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
(let* ((syncer-logfile (conc areapath"/logs/"dbfname"-syncer.log"))
- (sync-cmd (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &"))
+ (sync-cmd (if (eq? syncdir 'todisk)
+ (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &")
+ (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "dbfullname" -to "tmpdb" -period 5 -timeout 10 &")))
(synclock-file (conc dbfullname".lock"))
(syncer-running-file (conc dbfullname"-sync-running"))
(synclock-mod-time (if (file-exists? synclock-file)
(handle-exceptions
exn
@@ -245,12 +247,13 @@
(debug:print-info "Running "sync-cmd)
(if (file-exists? syncer-running-file)
(debug:print-info 0 *default-log-port* "Syncer still running, skipping syncer start.")
(system sync-cmd))
(set! *sync-in-progress* #f)))))))
- (if (< (file-modification-time tmpdb)
- (file-modification-time dbfullname))
+ (if ((if (eq? syncdir 'todisk) < >) ;; use less than for todisk, greater than for from disk
+ (file-modification-time tmpdb)
+ (file-modification-time dbfullname))
(debug:print 0 *default-log-port* "Skipping sync, "tmpdb" older than "dbfullname)
(if synclock-mod-time
(if (< (- (current-seconds) synclock-mod-time) 20) ;; something wrong with sync, remove file
(begin
(handle-exceptions
@@ -495,11 +498,16 @@
;; attach the destdbfile
;; for each table
;; insert into dest. select * from src. where last_update>last_update
;; done
(debug:print 0 *default-log-port* "Attaching "destdbfile" as auxdb")
- (sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;"))
+ (handle-exceptions
+ exn
+ (begin
+ (debug:print 0 "ATTACH failed, exiting. exn="(condition->list exn))
+ (exit 1))
+ (sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;")))
(for-each
(lambda (table)
(let* ((tbldat (alist-ref table tables equal?))
(fields (map car tbldat))
(no-id-fields (filter (lambda (x)(not (equal? x "id"))) fields))
Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -117,11 +117,11 @@
((nfs) (nfs-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
)))
(define (nfs-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
(let* ((keys (common:get-fields *configdat*))
- (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath)))
+ (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath tmpadj: "/dashboard")))
(api:dispatch-request dbstruct cmd run-id params)))
(define (tcp-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
(if (not runremote)
(let* ((newremote (make-and-init-remote areapath)))