Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -469,12 +469,12 @@ ;;====================================================================== ;; ;;====================================================================== (define (examine-test run-id test-id) ;; run-id run-key origtest) - (let* ((db-path (conc *toppath* "/db/" run-id ".db")) - (dbstruct (make-dbr:dbstruct path: *toppath* local: #t)) + (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) + (dbstruct (make-dbr:dbstruct path: (configf:lookup *configdat* "setup" "linktree") local: #t)) (testdat (db:get-test-info-by-id dbstruct run-id test-id)) (db-mod-time 0) ;; (file-modification-time db-path)) (last-update 0) ;; (current-seconds)) (request-update #t)) (if (not testdat) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -86,22 +86,22 @@ (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) -(define *dbstruct-local* (make-dbr:dbstruct path: *toppath* local: #t)) +(define *dbdir* (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) +(define *dbstruct-local* (make-dbr:dbstruct path: *dbdir* + local: #t)) +(define *db-file-path* (db:dbfile-path 0)) ;; HACK ALERT: this is a hack, please fix. -(define *read-only* (not (file-read-access? (conc *toppath* "db/main.db")))) -;; (client:setup *dbstruct-local*) +(define *read-only* (not (file-read-access? *db-file-path*))) (define toplevel #f) (define dlg #f) (define max-test-num 0) (define *keys* (db:get-keys *dbstruct-local*)) -;; (define *keys* (cdb:remote-run db:get-keys #f)) -;; (define *keys* (db:get-keys *dbstruct-local*)) (define *dbkeys* (append *keys* (list "runname"))) (define *header* #f) (define *allruns* '()) @@ -131,12 +131,10 @@ (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) (define *status-ignore-hash* (make-hash-table)) (define *state-ignore-hash* (make-hash-table)) -(define *db-file-path* (conc *toppath* "/db/main.db")) - (define *tests-sort-options* (vector (vector "Sort +a" 'testname "ASC") (vector "Sort -a" 'testname "DESC") (vector "Sort +t" 'event_time "ASC") (vector "Sort -t" 'event_time "DESC") (vector "Sort +s" 'statestatus "ASC") @@ -1410,36 +1408,36 @@ (iup:attribute-set! *tim* "TIME" 300) (iup:attribute-set! *tim* "RUN" "YES") ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... ;; -(define *last-db-update-time* (file-modification-time (conc *toppath* "/db/main.db"))) +(define *last-db-update-time* (file-modification-time *db-file-path*)) ;; (conc *toppath* "/db/main.db"))) (define *last-recalc-ended-time* 0) (define (dashboard:been-changed) - (> (file-modification-time (conc *toppath* "/db/main.db")) *last-db-update-time*)) + (> (file-modification-time *db-file-path* *last-db-update-time*))) (define (dashboard:set-db-update-time) - (set! *last-db-update-time* (file-modification-time (conc *toppath* "/db/main.db")))) + (set! *last-db-update-time* (file-modification-time *db-file-path*))) (define (dashboard:recalc modtime please-update-buttons last-db-update-time) (or please-update-buttons (and (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) (> modtime last-db-update-time) (> (current-seconds)(+ last-db-update-time 1))))) -(define *monitor-db-path* (conc *toppath* "/db/monitor.db")) +(define *monitor-db-path* (conc *dbdir* "/monitor.db")) (define *last-monitor-update-time* 0) ;; Force creation of the db in case it isn't already there. (let ((db (tasks:open-db))) (sqlite3:finalize! db)) (define (dashboard:get-youngest-run-db-mod-time) (apply max (map (lambda (filen) (file-modification-time filen)) - (glob (conc *toppath* "/db/*.db"))))) + (glob (conc *dbdir* "/*.db"))))) (define (dashboard:run-update x) (let* ((modtime (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time *db-file-path*)) (monitor-modtime (file-modification-time *monitor-db-path*)) (run-update-time (current-seconds)) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -106,21 +106,35 @@ ;; ;; ;; (define (db:get-path dbstruct id) ;; (let ((fdb (db:get-filedb dbstruct))) ;; (filedb:get-path db id))) +;; NB// #f => zeroth db with name=main.db +;; +(define (db:dbfile-path run-id) + (let* (;; (toppath (dbr:dbstruct-get-path dbstruct)) + (link-tree-path (configf:lookup *configdat* "setup" "linktree")) + (fname (if (eq? run-id 0) "main.db" (conc run-id ".db"))) + (dbdir (conc link-tree-path "/.db/"))) + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Couldn't create path to " dbdir) + (exit 1)) + (if (not (directory? dbdir))(create-directory dbdir #t))) + (conc dbdir fname))) + ;; This routine creates the db. It is only called if the db is not already opened ;; (define (db:open-rundb dbstruct run-id) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let* ((local (dbr:dbstruct-get-local dbstruct)) (rdb (if local (dbr:dbstruct-get-localdb dbstruct run-id) (dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem))) (if rdb rdb - (let* ((toppath (dbr:dbstruct-get-path dbstruct)) - (dbpath (conc toppath "/db/" run-id ".db")) + (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 (sqlite3:open-database dbpath)) (write-access (file-write-access? dbpath)) @@ -147,21 +161,22 @@ (db:sync-tables db:sync-tests-only db inmem) (dbr:dbstruct-set-refdb! dbstruct refdb) (db:sync-tables db:sync-tests-only db refdb) inmem)))))) -;; This routine creates the db. It is only called if the db is not already opened +;; This routine creates the db. It is only called if the db is not already ls opened ;; (define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let ((mdb (dbr:dbstruct-get-main dbstruct))) (if mdb mdb - (let* ((toppath (dbr:dbstruct-get-path dbstruct)) - (dbpath (let ((dbdir (conc *toppath* "/db"))) ;; use this opportunity to create our db dir - (if (not (directory-exists? dbdir)) - (create-direcory dbdir)) - (conc *toppath* "/db/main.db"))) + (let* (;; (toppath (dbr:dbstruct-get-path dbstruct)) + ;; (link-tree-path (configf:lookup *configdat* "setup" "linktree")) + (dbpath (db:dbfile-path 0)) ;; (let ((dbdir (conc *toppath* "/db"))) ;; use this opportunity to create our db dir + ;; (if (not (directory-exists? dbdir)) + ;; (create-direcory dbdir)) + ;; (conc *toppath* "/db/main.db"))) (dbexists (file-exists? dbpath)) (db (sqlite3:open-database dbpath)) (write-access (file-write-access? dbpath)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) @@ -176,11 +191,12 @@ db)))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; (define (db:setup run-id #!key (local #f)) - (let ((dbstruct (make-dbr:dbstruct path: *toppath* local: local))) + (let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) + (dbstruct (make-dbr:dbstruct path: dbdir local: local))) (db:get-db dbstruct #f) ;; force one call to main dbstruct)) ;; Open the classic megatest.db file in toppath ;; @@ -254,13 +270,12 @@ (sqlite3:finalize! rundb) (debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database"))))) (define (db:open-inmem-db) (let* ((db (sqlite3:open-database ":memory:")) - (handler (make-busy-timeout 3600))) + (handler (make-busy-timeout 3600))) (db:initialize-run-id-db db) - ;; (sdb:initialize db) ;; for future use (sqlite3:set-busy-handler! db handler) db)) ;; just tests, test_steps and test_data tables (define db:sync-tests-only @@ -476,12 +491,11 @@ (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") - (system (conc "rm -f " dbpath)) + (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:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));") (for-each (lambda (key) (sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -416,18 +416,39 @@ environ-patt: "env-override" given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") pathenvvar: "MT_RUN_AREA_HOME")) (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) - (if *toppath* - (let ((dbdir (conc *toppath* "/db"))) - (handle-exceptions - exn - (debug:print 0 "ERROR: failed to create the " dbdir " area for your database files") - (if (not (directory-exists? dbdir))(create-directory dbdir))) - (setenv "MT_RUN_AREA_HOME" *toppath*)) - (debug:print 0 "ERROR: failed to find the top path to your Megatest area.")))) + (let ((linktree (configf:lookup *configdat* "setup" "linktree"))) ;; link tree is critical + (if linktree + (if (not (file-exists? linktree)) + (begin + (handle-exceptions + exn + (begin + (debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree) + (exit 1)) + (create-directory linktree #t)))) + (begin + (debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config") + (exit 1))) + (if linktree + (let ((dbdir (conc linktree "/.db"))) + (handle-exceptions + exn + (debug:print 0 "ERROR: failed to create the " dbdir " area for your database files") + (if (not (directory-exists? dbdir))(create-directory dbdir))) + (setenv "MT_LINKTREE" linktree)) + (begin + (debug:print 0 "ERROR: linktree is required in your megatest.config [setup] section") + (exit 1))) + (if (and *toppath* + (directory-exists? *toppath*)) + (setenv "MT_RUN_AREA_HOME" *toppath*) + (begin + (debug:print 0 "ERROR: failed to find the top path to your Megatest area.") + (exit 1)))))) *toppath*) (define (get-best-disk confdat) (let* ((disks (hash-table-ref/default confdat "disks" #f)) (best #f) Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -82,15 +82,16 @@ ;; (define (server:run run-id) (let* ((curr-host (get-host-name)) (curr-ip (server:get-best-guess-address curr-host)) (target-host (configf:lookup *configdat* "server" "homehost" )) - (logfile (conc *toppath* "/db/" run-id ".log")) + (logfile (conc *toppath* "/logs/" run-id ".log")) (cmdln (conc (common:get-megatest-exe) " -server " (or target-host "-") " -run-id " run-id " >> " logfile " 2>&1 &"))) (debug:print 0 "INFO: Starting server (" cmdln ") as none running ...") (push-directory *toppath*) + (if (not (directory-exists? "logs"))(create-directory "logs")) ;; host.domain.tld match host? (if (and target-host ;; look at target host, is it host.domain.tld or ip address and does it ;; match current ip or hostname (not (string-match (conc "("curr-host "|" curr-host"\\..*)") target-host)) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -21,11 +21,12 @@ ;;====================================================================== ;; Tasks db ;;====================================================================== (define (tasks:open-db) - (let* ((dbpath (conc *toppath* "/db/monitor.db")) + (let* ((linktree (configf:lookup *configdat* "setup" "linktree")) + (dbpath (conc linktree "/.db/monitor.db")) (exists (file-exists? dbpath)) (write-access (file-write-access? dbpath)) (mdb (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) (handler (make-busy-timeout 36000))) (if (and exists @@ -411,11 +412,11 @@ ;; (define (tasks:start-monitor db mdb) (if (> (tasks:get-num-alive-monitors mdb) 2) ;; have two running, no need for more (debug:print-info 1 "Not starting monitor, already have more than two running") (let* ((megatestdb (conc *toppath* "/megatest.db")) - (monitordbf (conc *toppath* "/db/monitor.db")) + (monitordbf (conc (configf:lookup *configdat* "setup" "linktree") "/.db/monitor.db")) (last-db-update 0)) ;; (file-modification-time megatestdb))) (task:register-monitor mdb) (let loop ((count 0) (next-touch 0)) ;; next-touch is the time where we need to update last_update ;; if the db has been modified we'd best look at the task queue Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -168,11 +168,11 @@ clean : rm cleanprep kill : killall -v mtest main.sh dboard || true - rm -rf *run/db/* */megatest.db */logging.db */monitor.db fullrun/tmp/mt_*/* || true + rm -rf *run/db/* */megatest.db */logging.db */monitor.db fullrun/tmp/mt_*/* fullrun/tmp/mt_*/.db* || true killall -v mtest dboard || true hardkill : kill sleep 2;killall -v mtest main.sh dboard -9