Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -362,12 +362,12 @@ (server-timeout (let ((tmo (configf:lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (string->number tmo)) (* 60 60 (string->number tmo)) ;; (* 3 24 60 60) ;; default to three days - ;; (* 60 1) ;; default to one minute - (* 60 60 25) ;; default to 25 hours + (* 60 1) ;; default to one minute + ;; (* 60 60 25) ;; default to 25 hours )))) (let loop ((count 0) (server-state 'available)) ;; Use this opportunity to sync the inmemdb to db (let ((start-time (current-milliseconds)) @@ -419,17 +419,18 @@ ;; no_traffic, no running tests, if server 0, no running servers ;; ;; (let ((wait-on-running (configf:lookup *configdat* "server" "wait-on-running"))) ;; wait on running tasks (if not true then exit on time out) ;; (if (and *server-run* - (or (> (+ last-access server-timeout) - (current-seconds)) - (and (eq? run-id 0) - (> (tasks:num-servers-non-zero-running tdb) 0)) - (and (not (eq? run-id 0)) ;; only makes sense in non-zero run-id servers - (> (db:get-count-tests-actually-running *inmemdb* run-id) 0)) - )) + ;; (or + (> (+ last-access server-timeout) + (current-seconds))) +;; (and (eq? run-id 0) +;; (> (tasks:num-servers-non-zero-running tdb) 0)) +;; (and (not (eq? run-id 0)) ;; only makes sense in non-zero run-id servers +;; (> (db:get-count-tests-actually-running *inmemdb* run-id) 0)) +;; )) (begin (debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access)) ;; ;; Consider implementing some smarts here to re-insert the record or kill self is ;; the db indicates so Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -633,11 +633,17 @@ (match-dat (string-search hostpid-rx param-key)) (hostname (cadr match-dat)) (pid (caddr match-dat))) (debug:print 0 "Sending SIGINT to process " pid " on host " hostname) (if (equal? (get-host-name) hostname) - (process-signal (string->number pid) signal/int) + (begin + (process-signal (string->number pid) signal/int) + (thread-sleep! 5) + (handle-exceptions + exn + #t + (process-signal (string->number pid) signal/kill))) ;; (call-with-environment-variables (let ((old-targethost (getenv "TARGETHOST"))) (set-environment-variable "TARGETHOST" hostname) (system (conc "nbfake " kill " " pid)) (if old-targethost (set-environment-variable "TARGETHOST" old-targethost))))))