From 10b2834f82b7502dc2dc733d39d97f9ff2d07564 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 25 Dec 2018 17:03:37 +0100
Subject: offload: Adjust 'test' and 'status' to the latest changes.

This is a followup to ed7b44370f71126087eb953f36aad8dc4c44109f;
following that commit, 'guix offload test' and 'guix offload status'
would abort with a backtrace instead of clearly diagnosing a missing
'guix' command on the build machine.

* guix/scripts/offload.scm (assert-node-has-guix): Call 'leave' when
NODE is not an inferior.  Remove 'catch' blocks for 'node-repl-error'.
(check-machine-availability): Invoke 'assert-node-has-guix' first.
(check-machine-status): Print a warning when 'remote-inferior' returns #f.
---
 guix/scripts/offload.scm | 90 +++++++++++++++++++++++++-----------------------
 1 file changed, 46 insertions(+), 44 deletions(-)

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index b472d202a9..dcdccc80e0 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -624,35 +624,30 @@ If TIMEOUT is #f, simply evaluate EXP..."
            name (node-guile-version node)))))
 
 (define (assert-node-has-guix node name)
-  "Bail out if NODE lacks the (guix) module, or if its daemon is not running."
-  (catch 'node-repl-error
-    (lambda ()
-      (match (inferior-eval '(begin
-                               (use-modules (guix))
-                               (and add-text-to-store 'alright))
-                            node)
-        ('alright #t)
-        (_ (report-module-error name))))
-    (lambda (key . args)
-      (report-module-error name)))
-
-  (catch 'node-repl-error
-    (lambda ()
-      (match (inferior-eval '(begin
-                               (use-modules (guix))
-                               (with-store store
-                                 (add-text-to-store store "test"
-                                                    "Hello, build machine!")))
-                            node)
-        ((? string? str)
-         (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
-               name str))
-        (x
-         (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
-                name x))))
-    (lambda (key . args)
-      (leave (G_ "remote evaluation on '~a' failed:~{ ~s~}~%")
-             name args))))
+  "Bail out if NODE if #f or if we fail to use the (guix) module, or if its
+daemon is not running."
+  (unless (inferior? node)
+    (leave (G_ "failed to run 'guix repl' on '~a'~%") name))
+
+  (match (inferior-eval '(begin
+                           (use-modules (guix))
+                           (and add-text-to-store 'alright))
+                        node)
+    ('alright #t)
+    (_ (report-module-error name)))
+
+  (match (inferior-eval '(begin
+                           (use-modules (guix))
+                           (with-store store
+                             (add-text-to-store store "test"
+                                                "Hello, build machine!")))
+                        node)
+    ((? string? str)
+     (info (G_ "Guix is usable on '~a' (test returned ~s)~%")
+           name str))
+    (x
+     (leave (G_ "failed to talk to guix-daemon on '~a' (test returned ~s)~%")
+            name x))))
 
 (define %random-state
   (delay
@@ -706,8 +701,8 @@ machine."
            (sockets  (map build-machine-daemon-socket machines))
            (sessions (map open-ssh-session machines))
            (nodes    (map remote-inferior sessions)))
-      (for-each assert-node-repl nodes names)
       (for-each assert-node-has-guix nodes names)
+      (for-each assert-node-repl nodes names)
       (for-each assert-node-can-import sessions nodes names sockets)
       (for-each assert-node-can-export sessions nodes names sockets)
       (for-each close-inferior nodes)
@@ -727,21 +722,28 @@ machine."
     (info (G_ "getting status of ~a build machines defined in '~a'...~%")
           (length machines) machine-file)
     (for-each (lambda (machine)
-                (let* ((session (open-ssh-session machine))
-                       (inferior (remote-inferior session))
-                       (uts     (inferior-eval '(uname) inferior))
-                       (load    (node-load inferior))
-                       (free    (node-free-disk-space inferior)))
-                  (close-inferior inferior)
-                  (disconnect! session)
-                  (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
+                (define session
+                  (open-ssh-session machine))
+
+                (match (remote-inferior session)
+                  (#f
+                   (warning (G_ "failed to run 'guix repl' on machine '~a'~%")
+                            (build-machine-name machine)))
+                  ((? inferior? inferior)
+                   (let ((uts  (inferior-eval '(uname) inferior))
+                         (load (node-load inferior))
+                         (free (node-free-disk-space inferior)))
+                     (close-inferior inferior)
+                     (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
   host name: ~a~%  normalized load: ~a~%  free disk space: ~,2f MiB~%"
-                          (build-machine-name machine)
-                          (utsname:sysname uts) (utsname:release uts)
-                          (utsname:machine uts)
-                          (utsname:nodename uts)
-                          (normalized-load machine load)
-                          (/ free (expt 2 20) 1.))))
+                             (build-machine-name machine)
+                             (utsname:sysname uts) (utsname:release uts)
+                             (utsname:machine uts)
+                             (utsname:nodename uts)
+                             (normalized-load machine load)
+                             (/ free (expt 2 20) 1.)))))
+
+                (disconnect! session))
               machines)))
 
 
-- 
cgit 1.4.1