guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

06/06: offload: Do not abort when a machine is unreachable.


From: Ludovic Courtès
Subject: 06/06: offload: Do not abort when a machine is unreachable.
Date: Thu, 1 Dec 2016 22:35:32 +0000 (UTC)

civodul pushed a commit to branch master
in repository guix.

commit 463fb7d0c86fb9957c527272e6cec5ee23585366
Author: Ludovic Courtès <address@hidden>
Date:   Thu Dec 1 23:21:15 2016 +0100

    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(-)

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 0498364..237a963 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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]