Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -366,13 +366,16 @@ (conc "ERROR: BAD api call " cmd)))))) ;; save all stats (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 '())))) + start-t)) + (modified-cmd (if (eq? cmd 'general-call) + (string->symbol (conc "general-call-" (car params))) + cmd))) + (hash-table-set! *db-api-call-time* modified-cmd + (cons delta-t (hash-table-ref/default *db-api-call-time* modified-cmd '())))) (if writecmd-in-readonly-mode (begin #;(common:telemetry-log (conc "api-out:"(->string cmd)) payload: `((params . ,params) (ok-res . #t))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3603,18 +3603,18 @@ (mutex-unlock! *db-transaction-mutex*) tr-res)))) (define (db:get-all-state-status-counts-for-run dbstruct run-id) (let* ((test-count-recs (db:with-db - dbstruct #f #f - (lambda (dbdat db) - (sqlite3:map-row - (lambda (state status count) - (make-dbr:counts state: state status: status count: count)) - db - "SELECT state,status,count(id) FROM tests WHERE run_id=? GROUP BY state,status;" - run-id ))))) + dbstruct #f #f + (lambda (dbdat db) + (sqlite3:map-row + (lambda (state status count) + (make-dbr:counts state: state status: status count: count)) + db + "SELECT state,status,count(id) FROM tests WHERE run_id=? GROUP BY state,status;" + run-id ))))) test-count-recs)) ;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status* ;; Index: dbfile.scm ================================================================== --- dbfile.scm +++ dbfile.scm @@ -254,11 +254,11 @@ (let* ((dbname (dbfile:run-id->dbname run-id)) (areapath (dbr:dbstruct-areapath dbstruct)) (tmppath (dbr:dbstruct-tmppath dbstruct)) (mtdbpath (dbfile:run-id->path areapath run-id)) (tmpdbpath (dbfile:run-id->path tmppath run-id)) - (mtdbdat (dbfile:open-sqlite3-db mtdbpath init-proc)) + (mtdbdat (dbfile:open-sqlite3-db mtdbpath init-proc sync-mode: 0 journal-mode: #f)) ;; "WAL")) (newsubdb (make-dbr:subdb dbname: dbname mtdbfile: mtdbpath tmpdbfile: tmpdbpath mtdbdat: mtdbdat))) (dbfile:set-subdb dbstruct run-id newsubdb) @@ -287,11 +287,11 @@ (let* ((dbdat (dbfile:get-dbdat dbstruct run-id))) (if dbdat dbdat (let* ((tmppath (dbr:dbstruct-tmppath dbstruct)) (tmpdbpath (dbfile:run-id->path tmppath run-id))) - (dbfile:open-sqlite3-db tmpdbpath init-proc))))))) + (dbfile:open-sqlite3-db tmpdbpath init-proc sync-mode: 0 journal-mode: "WAL"))))))) ;; COMBINE dbfile:open-sqlite-db and dbfile:lock-create-open ;; ;; this stuff is for initial debugging, please remove it when @@ -306,14 +306,14 @@ ;; Open the classic megatest.db file (defaults to open in toppath) ;; ;; NOTE: returns a dbdat not a dbstruct! ;; -(define (dbfile:open-sqlite3-db dbpath init-proc) +(define (dbfile:open-sqlite3-db dbpath init-proc #!key (sync-mode 0)(journal-mode #f)) (let* ((dbexists (file-exists? dbpath)) (write-access (file-write-access? dbpath)) - (db (dbfile:cautious-open-database dbpath init-proc))) #;(sqlite3:open-database dbpath) + (db (dbfile:cautious-open-database dbpath init-proc sync-mode journal-mode))) #;(sqlite3:open-database dbpath) (dbfile:inc-db-open dbpath) ;; (init-proc db) (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access)))) (define (dbfile:print-and-exit . params) @@ -469,20 +469,21 @@ (dbfile:print-err " db, " (dbr:dbdat-dbfile tmpdb) " already exists or fresh enough, not propogating data from\n " (dbr:dbdat-dbfile mtdb) " mod time delta: " modtimedelta) ) ;; (db:multi-db-sync subdb 'old2new)) ;; migrate data from megatest.db automatically tmpdb)) -(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 500)) - +(define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500)) (let* ((busy-file (conc fname"-journal")) (delay-time (* (- 51 tries-left) 1.1)) (write-access (file-write-access? fname)) (dir-access (file-write-access? (pathname-directory fname))) (retry (lambda () (thread-sleep! delay-time) (if (> tries-left 0) - (dbfile:cautious-open-database fname init-proc (- tries-left 1)))))) + (dbfile:cautious-open-database fname init-proc + sync-mode: sync-mode journal-mode: journal-mode + (- tries-left 1)))))) (assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up.")) (if (and (file-write-access? fname) (file-exists? busy-file)) (begin @@ -492,33 +493,34 @@ (thread-sleep! 1) (if (eq? tries-left 2) (begin (dbfile:print-err "INFO: forcing journal rollup "busy-file) (dbfile:brute-force-salvage-db fname))) - (dbfile:cautious-open-database fname init-proc (- tries-left 1))) + (dbfile:cautious-open-database fname init-proc sync-mode: sync-mode journal-mode: journal-mode (- tries-left 1))) (let* ((result (condition-case - (if dir-access - (dbfile:with-simple-file-lock - (conc fname ".lock") - (lambda () - (let* ((db-exists (file-exists? fname)) - (db (sqlite3:open-database fname))) ;; creates an empty db if it did not already exist. - (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000)) - (sqlite3:execute db (conc "PRAGMA synchronous = 0;")) - (if (and init-proc (not db-exists)) - (init-proc db)) - db))) - (begin - (if (file-exists? fname ) - (begin - (sqlite3:open-database fname) - ) - (print "file doesn't exist: " fname) - ) - ) - ) + (if dir-access + (dbfile:with-simple-file-lock + (conc fname ".lock") + (lambda () + (let* ((db-exists (file-exists? fname)) + (db (sqlite3:open-database fname))) ;; creates an empty db if it did not already exist. + (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000)) + (if sync-mode + (sqlite3:execute db (conc "PRAGMA synchronous = "sync-mode";"))) + (if journal-mode + (sqlite3:execute db (conc "PRAGMA journal_mode = "journal-mode";"))) + (if (and init-proc (not db-exists)) + (init-proc db)) + db))) + (begin + (if (file-exists? fname ) + (let ((db (sqlite3:open-database fname))) + ;; pragmas synchronous not needed because this db is used read-only + ;; (sqlite3:execute db (conc "PRAGMA synchronous = "mode";") + db ) + (print "file doesn't exist: " fname)))) (exn (io-error) (dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.") (retry)) (exn (corrupt) (dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.") @@ -599,12 +601,12 @@ (init-proc (lambda (db) (if (not db-exists) (begin (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")) ))) - (db (dbfile:cautious-open-database dbname init-proc))) ;; (sqlite3:open-database dbname))) - (sqlite3:execute db "PRAGMA synchronous = 0;") + (db (dbfile:cautious-open-database dbname init-proc 0 "WAL"))) ;; (sqlite3:open-database dbname))) + ;; (sqlite3:execute db "PRAGMA synchronous = 0;") (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000)) (set! *no-sync-db* db) db)))) (define (db:no-sync-set db var val)