Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -174,11 +174,13 @@ (let ((exists (file-exists? fname)) (lock (obtain-dot-lock fname 1 5 10)) (db (sqlite3:open-database fname))) (sqlite3:set-busy-handler! db (make-busy-timeout 136000)) (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;") - (if (not exists)(initproc db)) + (if (not exists) + (initproc db) + (initproc db update-only: #t)) (release-dot-lock fname) db) (begin (debug:print 0 "ERROR: no such db in non-writable dir " fname) (sqlite3:open-database fname)))))) @@ -196,27 +198,11 @@ (let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db")) (dbexists (file-exists? dbpath)) (inmem (if local #f (db:open-inmem-db))) (refdb (if local #f (db:open-inmem-db))) (db (db:lock-create-open dbpath ;; this is the database physically on disk - (lambda (db) - (handle-exceptions - exn - (begin - (release-dot-lock dbpath) - (if (> attemptnum 2) - (debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath) - (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1)))) - (db:initialize-run-id-db db) - (sqlite3:execute - db - "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');" - (* run-id 30000) ;; allow for up to 30k tests per run - run-id) - ;; do a dummy query to test that the table exists and the db is truly readable - (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000)) - )))) ;; add strings db to rundb, not in use yet + whatever-goes-here! ) ;; add strings db to rundb, not in use yet ;; )) ;; (sqlite3:open-database dbpath)) (olddb (if *megatest-db* *megatest-db* (let ((db (db:open-megatest-db))) (set! *megatest-db* db) @@ -275,13 +261,13 @@ ;; (define (db:open-megatest-db) (let* ((dbpath (conc *toppath* "/megatest.db")) (dbexists (file-exists? dbpath)) (db (db:lock-create-open dbpath - (lambda (db) - (db:initialize-main-db db) - (db:initialize-run-id-db db)))) + (lambda (db update-only) + (db:initialize-main-db db update-only) + (db:initialize-run-id-db db update-only)))) (write-access (file-write-access? dbpath))) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) (cons db dbpath))) @@ -721,26 +707,27 @@ (define open-run-close open-run-close-exception-handling) ;; open-run-close-no-exception-handling ;; open-run-close-exception-handling) ;;) -(define (db:initialize-main-db dbdat) +(define (db:initialize-main-db dbdat update-only) (let* ((configdat (car *configinfo*)) ;; tut tut, global warning... (keys (keys:config-get-fields configdat)) (havekeys (> (length keys) 0)) (keystr (keys->keystr keys)) (fieldstr (keys->key/field keys)) (db (db:dbdat-get-db dbdat))) - (for-each (lambda (key) - (let ((keyn key)) - (if (member (string-downcase keyn) - (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" - "pass_count")) - (begin - (print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and /.db before trying again.") - (exit 1))))) - keys) + (if (not update-only) + (for-each (lambda (key) + (let ((keyn key)) + (if (member (string-downcase keyn) + (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" + "pass_count")) + (begin + (print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and /.db before trying again.") + (exit 1))))) + keys)) (sqlite3:with-transaction db (lambda () (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));") (for-each (lambda (key) @@ -797,11 +784,19 @@ ;;====================================================================== ;; R U N S P E C I F I C D B ;;====================================================================== -(define (db:initialize-run-id-db db) +(define (db:initialize-run-id-db db update-only) + (handle-exceptions + exn + (begin + (release-dot-lock dbpath) + (if (> attemptnum 2) + (debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath) + (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1)))) + (db:initialize-run-id-db db) (sqlite3:with-transaction db (lambda () (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests (id INTEGER PRIMARY KEY, @@ -866,10 +861,20 @@ update_time TIMESTAMP, cpuload INTEGER DEFAULT -1, diskfree INTEGER DEFAULT -1, diskusage INTGER DEFAULT -1, run_duration INTEGER DEFAULT 0);"))) + (sqlite3:execute + db + "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s',' + (* run-id 30000) ;; allow for up to 30k tests per run + run-id) + ;; do a dummy query to test that the table exists and the db is truly readable + (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000)) + )))) ;; add strings db to rundb, not in use yet + + db) ;;====================================================================== ;; L O G G I N G D B ;;====================================================================== Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -133,13 +133,13 @@ port 8080 # This server will keep running this number of hours after last access. # Three minutes is 0.05 hours # timeout 0.025 -timeout 0.1 +timeout 0.01 -# Server is required - slower but more resistant to Sqlite issues. +# Server is required - slower but may be more resistant to Sqlite issues. # required yes # Start server when average query takes longer than this server-query-threshold 100 # 55500