From 463fb7d0c86fb9957c527272e6cec5ee23585366 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 Dec 2016 23:21:15 +0100 Subject: 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. --- guix/scripts/offload.scm | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 04983646eb..237a9638d3 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -493,27 +493,30 @@ be read." (define (machine-load machine) "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. - (let* ((session (open-ssh-session machine)) - (pipe (open-remote-pipe* session OPEN_READ + (match (false-if-exception (open-ssh-session machine)) + ((? session? session) + (let* ((pipe (open-remote-pipe* session OPEN_READ "cat" "/proc/loadavg")) - (line (read-line pipe))) - (close-port pipe) - - (if (eof-object? line) - +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded - (match (string-tokenize line) - ((one five fifteen . _) - (let* ((raw (string->number five)) - (jobs (build-machine-parallel-builds machine)) - (normalized (/ raw jobs))) - (format (current-error-port) "load on machine '~a' is ~s\ + (line (read-line pipe))) + (close-port pipe) + + (if (eof-object? line) + +inf.0 ;MACHINE does not respond, so assume it is infinitely loaded + (match (string-tokenize line) + ((one five fifteen . _) + (let* ((raw (string->number five)) + (jobs (build-machine-parallel-builds machine)) + (normalized (/ raw jobs))) + (format (current-error-port) "load on machine '~a' is ~s\ (normalized: ~s)~%" - (build-machine-name machine) raw normalized) - normalized)) - (_ - +inf.0))))) ;something's fishy about MACHINE, so avoid it + (build-machine-name machine) raw normalized) + normalized)) + (_ + +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) "Return the name of MACHINE's lock file for HINT." -- cgit v1.2.3