Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1961,16 +1961,19 @@
;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
+ (mutex-lock! *db-stats-mutex*)
(db:with-db
dbstruct
#f
#f
+
(lambda (db)
;; remove previous data
+
(let* ((stmt1 (sqlite3:prepare db "DELETE FROM run_stats WHERE run_id=? AND state=? AND status=?;"))
(stmt2 (sqlite3:prepare db "INSERT INTO run_stats (run_id,state,status,count) VALUES (?,?,?,?);"))
(res
(sqlite3:with-transaction
db
@@ -1980,10 +1983,11 @@
(sqlite3:execute stmt1 run-id (car dat)(cadr dat))
(apply sqlite3:execute stmt2 run-id dat))
stats)))))
(sqlite3:finalize! stmt1)
(sqlite3:finalize! stmt2)
+ (mutex-unlock! *db-stats-mutex*)
res))))
(define (db:get-main-run-stats dbstruct run-id)
(db:with-db
dbstruct
@@ -3171,42 +3175,46 @@
(db:test-get-testname testdat)
test-name))
(item-path (db:test-get-item-path testdat))
(tl-testdat (db:get-test-info dbstruct run-id test-name ""))
(tl-test-id (db:test-get-id tl-testdat)))
- (sqlite3:with-transaction
- db
- (lambda ()
- (db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
- (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
- (let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
- (running (length (filter (lambda (x)
- (member (dbr:counts-state x) *common:running-states*))
- state-status-counts)))
- (bad-not-started (length (filter (lambda (x)
- (and (equal? (dbr:counts-state x) "NOT_STARTED")
- (not (member (dbr:counts-status x)
- *common:not-started-ok-statuses*))))
- state-status-counts)))
- (all-curr-states (common:special-sort ;; worst -> best (sort of)
- (delete-duplicates
- (cons state (map dbr:counts-state state-status-counts)))
- *common:std-states* >))
- (all-curr-statuses (common:special-sort ;; worst -> best
- (delete-duplicates
- (cons status (map dbr:counts-status state-status-counts)))
- *common:std-statuses* >))
- (newstate (if (> running 0)
- "RUNNING"
- (if (> bad-not-started 0)
- "COMPLETED"
- (car all-curr-states))))
- (newstatus (if (> bad-not-started 0)
- "CHECK"
- (car all-curr-statuses))))
- ;; (print "Setting toplevel to: " newstate "/" newstatus)
- (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f)))))))
+ (mutex-lock! *db-stats-mutex*)
+ (let ((tr-res
+ (sqlite3:with-transaction
+ db
+ (lambda ()
+ (db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
+ (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
+ (let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
+ (running (length (filter (lambda (x)
+ (member (dbr:counts-state x) *common:running-states*))
+ state-status-counts)))
+ (bad-not-started (length (filter (lambda (x)
+ (and (equal? (dbr:counts-state x) "NOT_STARTED")
+ (not (member (dbr:counts-status x)
+ *common:not-started-ok-statuses*))))
+ state-status-counts)))
+ (all-curr-states (common:special-sort ;; worst -> best (sort of)
+ (delete-duplicates
+ (cons state (map dbr:counts-state state-status-counts)))
+ *common:std-states* >))
+ (all-curr-statuses (common:special-sort ;; worst -> best
+ (delete-duplicates
+ (cons status (map dbr:counts-status state-status-counts)))
+ *common:std-statuses* >))
+ (newstate (if (> running 0)
+ "RUNNING"
+ (if (> bad-not-started 0)
+ "COMPLETED"
+ (car all-curr-states))))
+ (newstatus (if (> bad-not-started 0)
+ "CHECK"
+ (car all-curr-statuses))))
+ ;; (print "Setting toplevel to: " newstate "/" newstatus)
+ (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f))))))
+ (mutex-unlock! *db-stats-mutex*))
+ trres)))
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)
;; call with state = #f to roll up with out accounting for state/status of this item
;;
Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -75,11 +75,11 @@
(set! *runremote* (make-remote))
(mutex-unlock! *rmt-mutex*)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 1")
(rmt:send-receive cmd rid params attemptnum: attemptnum))
;; ensure we have a homehost record
- ((not (pair? (remote-hh-dat *runremote*))) ;; have a homehost record?
+ ((not (pair? (remote-hh-dat *runremote*))) ;; not on homehost
(thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
(remote-hh-dat-set! *runremote* (common:get-homehost))
(mutex-unlock! *rmt-mutex*)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 2")
(rmt:send-receive cmd rid params attemptnum: attemptnum))
@@ -141,18 +141,20 @@
;; (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;) ;)
;;;;
;; if not on homehost ensure we have a connection to a live server
;; NOTE: we *have* a homehost record by now
- ((and (not (cdr (remote-hh-dat *runremote*))) ;; not on a homehost
- (not (remote-conndat *runremote*)) ;; and no connection
- (server:read-dotserver *toppath*)) ;; .server file exists
- ;; something caused the server entry in tdb to disappear, but the server is still running
- (server:remove-dotserver-file *toppath* ".*")
- (mutex-unlock! *rmt-mutex*)
- (debug:print-info 12 *default-log-port* "rmt:send-receive, case 20")
- (rmt:send-receive cmd rid params attemptnum: (add1 attemptnum)))
+
+ ;; ((and (not (cdr (remote-hh-dat *runremote*))) ;; not on a homehost
+ ;; (not (remote-conndat *runremote*)) ;; and no connection
+ ;; (server:read-dotserver *toppath*)) ;; .server file exists
+ ;; ;; something caused the server entry in tdb to disappear, but the server is still running
+ ;; (server:remove-dotserver-file *toppath* ".*")
+ ;; (mutex-unlock! *rmt-mutex*)
+ ;; (debug:print-info 12 *default-log-port* "rmt:send-receive, case 20")
+ ;; (rmt:send-receive cmd rid params attemptnum: (add1 attemptnum)))
+
((and (not (cdr (remote-hh-dat *runremote*))) ;; not on a homehost
(not (remote-conndat *runremote*))) ;; and no connection
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 6 hh-dat: " (remote-hh-dat *runremote*) " conndat: " (remote-conndat *runremote*))
(mutex-unlock! *rmt-mutex*)
(tasks:start-and-wait-for-server (tasks:open-db) 0 15)
@@ -178,11 +180,11 @@
(debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported")
(exit))))
(success (if (vector? dat) (vector-ref dat 0) #f))
(res (if (vector? dat) (vector-ref dat 1) #f)))
(if (vector? conninfo)(http-transport:server-dat-update-last-access conninfo)) ;; refresh access time
- (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " dat=" dat)
+ (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " dat=" dat " *runremote* = "*runremote*)
(if success
(case (remote-transport *runremote*)
((http) res)
(else
(debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " is unknown")
Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -448,14 +448,16 @@
(reverse res)))
;; no elegance here ...
;;
(define (tasks:kill-server hostname pid #!key (kill-switch ""))
+ (server:remove-dotserver-file *toppath* ".*")
(debug:print-info 0 *default-log-port* "Attempting to kill server process " pid " on host " hostname)
(setenv "TARGETHOST" hostname)
(setenv "TARGETHOST_LOGF" "server-kills.log")
(system (conc "nbfake kill "kill-switch" "pid))
+
(unsetenv "TARGETHOST_LOGF")
(unsetenv "TARGETHOST"))
;; look up a server by run-id and send it a kill, also delete the record for that server
;;
@@ -466,10 +468,11 @@
(let ((hostname (vector-ref sdat 6))
(pid (vector-ref sdat 5))
(server-id (vector-ref sdat 0)))
(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "killed")
(debug:print-info 0 *default-log-port* "Killing server " server-id " for run-id " run-id " on host " hostname " with pid " pid)
+ (server:remove-dotserver-file *toppath* ".*")
(tasks:kill-server hostname pid)
(tasks:server-delete-record (db:delay-if-busy tdbdat) server-id tag) )
(debug:print-info 0 *default-log-port* "No server found for run-id " run-id ", nothing to kill"))
;; (sqlite3:finalize! tdb)
))