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:
parent
74afca5dcf
commit
463fb7d0c8
|
@ -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."
|
||||||
|
|
Loading…
Reference in New Issue