diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-12-01 23:21:15 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-12-01 23:35:11 +0100 |
commit | 463fb7d0c86fb9957c527272e6cec5ee23585366 (patch) | |
tree | 3cc87dc077476a8efd4b2a373b21344a3038b458 /guix/scripts | |
parent | 74afca5dcfa6f321b5523e9bae8b1aff30e9c6af (diff) | |
download | gnu-guix-463fb7d0c86fb9957c527272e6cec5ee23585366.tar gnu-guix-463fb7d0c86fb9957c527272e6cec5ee23585366.tar.gz |
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.
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/offload.scm | 39 |
1 files changed, 21 insertions, 18 deletions
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." |