Changes In Branch v1.80-dboard-dbs Excluding Merge-Ins
This is equivalent to a diff from 9062c1c10d to ac9bff739e
2023-05-29
| ||
20:53 | Merged in dashboard-db stuff check-in: 19fa6f67c5 user: matt tags: v1.80 | |
20:49 | Fixed db init - should be if it didn't exists then init. Added running of dashboard syncer which seems to be somewhat working. Leaf check-in: ac9bff739e user: matt tags: v1.80-dboard-dbs | |
2023-05-24
| ||
18:39 | guarded a create-directory with directory-exists? check-in: 60290c5f00 user: mmgraham tags: v1.80 | |
06:24 | Separate dbs for dashboard. check-in: ea08cd04fb user: matt tags: v1.80-dboard-dbs | |
04:16 | Added exception handlers on transactions on sync and in one additional with-input in simple locks. check-in: 9062c1c10d user: matt tags: v1.80 | |
2023-05-23
| ||
20:48 | Simplify the locking scenario for sync check-in: cdf8c77efe user: matt tags: v1.80 | |
Modified TODO from [fa3d981ca6] to [14d60a1c73].
︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | # # You should have received a copy of the GNU General Public License # along with Megatest. If not, see <http://www.gnu.org/licenses/>. TODO ==== 23WW07 . Remove use of *dbstruct-dbs* WW15 . fill newview matrix with data, filter pipeline gui elements . improve [script], especially indent handling | > > > | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # # You should have received a copy of the GNU General Public License # along with Megatest. If not, see <http://www.gnu.org/licenses/>. 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 . improve [script], especially indent handling |
︙ | ︙ |
Modified dashboard-transport-mode.scm.template from [a7eb4115fd] to [ae157b10fd].
︙ | ︙ | |||
11 12 13 14 15 16 17 | ;; 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 | | | 11 12 13 14 15 16 17 18 19 20 21 22 | ;; 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 'attach) ;; original was causing crash on start. (dbfile:cache-method 'none) (rmt:transport-mode 'nfs) |
Modified dbfile.scm from [5c3217f805] to [8d04f9a6ab].
︙ | ︙ | |||
198 199 200 201 202 203 204 | subdbs) #t ) #f ) ) | | | | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | subdbs) #t ) #f ) ) (define (dbfile:make-tmpdir-name areapath tmpadj) (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" ".") tmpadj))) (create-directory dname #t) dname)) (define (dbfile:run-id->path apath run-id) (conc apath"/"(dbfile:run-id->dbname run-id))) (define (db:dbname->path apath dbname) |
︙ | ︙ |
Modified dbmod.scm from [9a189716e8] to [94a50f00a9].
︙ | ︙ | |||
69 70 71 72 73 74 75 | ;;====================================================================== ;; Read-only cachedb cached direct from disk method ;;====================================================================== (define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct ;; called in rmt.scm nfs-transport-handler | | | < | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | ;;====================================================================== ;; Read-only cachedb cached direct from disk method ;;====================================================================== (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 #!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 tmpadj: tmpadj))) (hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct) newdbstruct)))) ;;====================================================================== ;; The cachedb one-db file per server method goes in here ;;====================================================================== ;; NOTE: the r/w is now w/r, #t=db modified by query, #f=db NOT modified by query (define (dbmod:with-db dbstruct run-id w/r proc params) (let* ((use-mutex (or (and w/r ;; use the mutex on queries that modify the db and for sync to disk (> *api-process-request-count* 5)) ;; when writes are happening throttle more (> *api-process-request-count* 50))) (dbdat (dbmod:open-db dbstruct run-id (dbfile:db-init-proc))) (dbh (dbr:dbdat-dbh dbdat)) ;; this will be the cachedb handle (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 (> (- 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) ))) (assert (sqlite3:database? dbh) "FATAL: bad db handle in dbmod:with-db") |
︙ | ︙ | |||
170 171 172 173 174 175 176 | (dbfile:with-simple-file-lock (conc dbfullname".lock") (lambda () (let* ((dbexists (file-exists? dbfullname)) (db (sqlite3:open-database dbfullname)) (handler (sqlite3:make-busy-timeout 136000))) (sqlite3:set-busy-handler! db handler) | | | > | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | (dbfile:with-simple-file-lock (conc dbfullname".lock") (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 (not dbexists) write-access) (init-proc db)) db)) run-anyway: #t)) (define *sync-in-progress* #f) ;; Open the cachedb db and the on-disk db ;; populate the cachedb db with data ;; ;; Updates fields in dbstruct ;; Returns dbstruct ;; ;; * 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 (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 tmpadj)) (tmpdb (let* ((fname (conc tmpdir"/"dbfname))) fname)) (cachedb (dbmod:open-cachedb-db init-proc ;; (if (eq? (dbfile:cache-method) 'cachedb) ;; #f tmpdb ;; ) |
︙ | ︙ | |||
224 225 226 227 228 229 230 | (dbr:dbstruct-dbtmpname-set! dbstruct tmpdb) (dbr:dbstruct-dbfname-set! dbstruct dbfname) (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")) | > | > > | | | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | (dbr:dbstruct-dbtmpname-set! dbstruct tmpdb) (dbr:dbstruct-dbfname-set! dbstruct dbfname) (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 (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 #f (file-modification-time synclock-file)) #f)) (thethread (lambda () (thread-start! (make-thread (lambda () (set! *sync-in-progress* #t) (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 ((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 exn #f |
︙ | ︙ | |||
493 494 495 496 497 498 499 | (dest-exists (file-exists? destdbfile))) (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile) ;; attach the destdbfile ;; for each table ;; insert into dest.<table> select * from src.<table> where last_update>last_update ;; done (debug:print 0 *default-log-port* "Attaching "destdbfile" as auxdb") | > > > > > | | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | (dest-exists (file-exists? destdbfile))) (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile) ;; attach the destdbfile ;; for each table ;; insert into dest.<table> select * from src.<table> where last_update>last_update ;; done (debug:print 0 *default-log-port* "Attaching "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)) (fields-str (string-intersperse fields ",")) (no-id-fields-str (string-intersperse no-id-fields ",")) |
︙ | ︙ |
Modified rmt.scm from [0af3ea0170] to [8f04a626a2].
︙ | ︙ | |||
115 116 117 118 119 120 121 | ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)) ((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe)) ((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*)) | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)) ((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe)) ((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 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))) (set! *runremote* newremote) (set! runremote newremote))) |
︙ | ︙ |