offload: Do not abort when a machine is unreachable.

* guix/scripts/offload.scm (machine-load): Wrap 'open-ssh-session' call
in 'false-if-exception'; return +inf.0 if it returns #f.
This commit is contained in:
Ludovic Courtès 2016-12-01 23:21:15 +01:00
parent 74afca5dcf
commit 463fb7d0c8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 20 additions and 17 deletions

View File

@ -493,27 +493,30 @@ be read."
(define (machine-load machine) (define (machine-load machine)
"Return the load of MACHINE, divided by the number of parallel builds "Return the load of MACHINE, divided by the number of parallel builds
allowed on MACHINE." allowed on MACHINE. Return + if MACHINE is unreachable."
;; Note: This procedure is costly since it creates a new SSH session. ;; Note: This procedure is costly since it creates a new SSH session.
(let* ((session (open-ssh-session machine)) (match (false-if-exception (open-ssh-session machine))
(pipe (open-remote-pipe* session OPEN_READ ((? session? session)
(let* ((pipe (open-remote-pipe* session OPEN_READ
"cat" "/proc/loadavg")) "cat" "/proc/loadavg"))
(line (read-line pipe))) (line (read-line pipe)))
(close-port pipe) (close-port pipe)
(if (eof-object? line) (if (eof-object? line)
+inf.0 ;MACHINE does not respond, so assume it is infinitely loaded +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded
(match (string-tokenize line) (match (string-tokenize line)
((one five fifteen . _) ((one five fifteen . _)
(let* ((raw (string->number five)) (let* ((raw (string->number five))
(jobs (build-machine-parallel-builds machine)) (jobs (build-machine-parallel-builds machine))
(normalized (/ raw jobs))) (normalized (/ raw jobs)))
(format (current-error-port) "load on machine '~a' is ~s\ (format (current-error-port) "load on machine '~a' is ~s\
(normalized: ~s)~%" (normalized: ~s)~%"
(build-machine-name machine) raw normalized) (build-machine-name machine) raw normalized)
normalized)) normalized))
(_ (_
+inf.0))))) ;something's fishy about MACHINE, so avoid it +inf.0))))) ;something's fishy about MACHINE, so avoid it
(_
+inf.0))) ;failed to connect to MACHINE, so avoid it
(define (machine-lock-file machine hint) (define (machine-lock-file machine hint)
"Return the name of MACHINE's lock file for HINT." "Return the name of MACHINE's lock file for HINT."