Overview
| Comment: | Added testsuite name tagging of servers, bumped version to v1.6004, move sending of kill to inside the error handling |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
7faccb94b16f99d8f7c0efc021504864 |
| User & Date: | mrwellan on 2014-10-20 15:00:38 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-10-20
| ||
| 15:13 | Gracefully deal with cases where the tasks line does not have the host/pid of the running task check-in: e44ac6ce65 user: mrwellan tags: v1.60 | |
| 15:00 | Added testsuite name tagging of servers, bumped version to v1.6004, move sending of kill to inside the error handling check-in: 7faccb94b1 user: mrwellan tags: v1.60 | |
| 00:23 | Added capture and display of top script pid check-in: 4911da85d8 user: matt tags: v1.60 | |
Changes
Modified common.scm from [79e5c51a63] to [fc985150d7].
| ︙ | ︙ | |||
181 182 183 184 185 186 187 188 189 190 191 192 193 194 |
(define (get-with-default val default)
(let ((val (args:get-arg val)))
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
;;======================================================================
;; Misc utils
;;======================================================================
;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
(define (common:hms-string->seconds tstr)
| > > > > | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
(define (get-with-default val default)
(let ((val (args:get-arg val)))
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "server" "testsuite" )
(pathname-file *toppath*)))
;;======================================================================
;; Misc utils
;;======================================================================
;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
(define (common:hms-string->seconds tstr)
|
| ︙ | ︙ |
Modified megatest-version.scm from [b5b5f125e2] to [83c6d6cd66].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6004) |
Modified server.scm from [033734a741] to [749eb4a6f5].
| ︙ | ︙ | |||
81 82 83 84 85 86 87 88 89 90 91 92 | ;; if the run-id is zero and the target-host is set ;; try running on that host ;; (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* "/logs/" run-id ".log")) (cmdln (conc (common:get-megatest-exe) " -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes") (conc " -daemonize -log " logfile) "") | > | | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
;; if the run-id is zero and the target-host is set
;; try running on that host
;;
(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" ))
(testsuite (common:get-testsuite-name))
(logfile (conc *toppath* "/logs/" run-id ".log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")
" -debug 4 testsuite:" testsuite))) ;; (conc " >> " 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
|
| ︙ | ︙ |
Modified tasks.scm from [903bab69fd] to [041b4741e2].
| ︙ | ︙ | |||
632 633 634 635 636 637 638 |
(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
| < < > > > | > > | 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 |
(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
(handle-exceptions
exn
(begin
(debug:print 0 "Kill of process " pid " on host " hostname " failed.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
#t)
(process-signal (string->number pid) signal/int)
(thread-sleep! 5)
(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)))
|
| ︙ | ︙ |