Overview
| Comment: | Changed default server run time to 60 seconds. Removed wait on RUNNING for servers - caused more hassle than benefit |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
9818a847b5e0030ba3e2c0fb76bd1ed2 |
| User & Date: | matt on 2014-10-17 00:19:24 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-10-19
| ||
| 19:59 | first pass attempt to do a better job on lazy loading of config files check-in: 01d8fffe0f user: mrwellan tags: v1.60 | |
|
2014-10-18
| ||
| 23:48 | Merged v1.60 into trunk check-in: 56761f4e0a user: matt tags: trunk | |
|
2014-10-17
| ||
| 00:19 | Changed default server run time to 60 seconds. Removed wait on RUNNING for servers - caused more hassle than benefit check-in: 9818a847b5 user: matt tags: v1.60 | |
|
2014-10-16
| ||
| 23:58 | Added kill of -runtests processes if -remove-runs is called with test patt of % check-in: 36d5293a01 user: matt tags: v1.60 | |
Changes
Modified http-transport.scm from [6e6db43f0a] to [9b05b6d402].
| ︙ | ︙ | |||
360 361 362 363 364 365 366 |
(last-access 0)
(tdb (tasks:open-db))
(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
| | | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 |
(last-access 0)
(tdb (tasks:open-db))
(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
))))
(let loop ((count 0)
(server-state 'available))
;; Use this opportunity to sync the inmemdb to db
(let ((start-time (current-milliseconds))
(sync-time #f)
(rem-time #f))
|
| ︙ | ︙ | |||
417 418 419 420 421 422 423 |
;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
;;
;; 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*
| > | | | | | | | | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 |
;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
;;
;; 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))
;; ))
(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
;;
;; (if (tasks:server-am-i-the-server? tdb run-id)
|
| ︙ | ︙ |
Modified tasks.scm from [3f21ed396f] to [903bab69fd].
| ︙ | ︙ | |||
631 632 633 634 635 636 637 |
(lambda (record)
(let* ((param-key (list-ref record 8))
(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)
| > | > > > > > | 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 |
(lambda (record)
(let* ((param-key (list-ref record 8))
(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)
(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))))))
records)))
|
| ︙ | ︙ |