05/06: offload: Gracefully report connection failures.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 74afca5dcfa6f321b5523e9bae8b1aff30e9c6af
Author: Ludovic Courtès <address@hidden>
Date:   Thu Dec 1 23:20:18 2016 +0100

    offload: Gracefully report connection failures.
    
    * guix/scripts/offload.scm (open-ssh-session): Check the return value of
    'connect!'.  Call 'leave' when it's not 'ok.
---
 guix/scripts/offload.scm |   52 +++++++++++++++++++++++++---------------------
 1 file changed, 28 insertions(+), 24 deletions(-)

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 4f6de0b..0498364 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -177,31 +177,35 @@ private key from '~a': ~a")
                                ;; exchanging full archives.
                                #:compression "zlib"
                                #:compression-level 3)))
-    (connect! session)
-
-    ;; Authenticate the server.  XXX: Guile-SSH 0.10.1 doesn't know about
-    ;; ed25519 keys and 'get-key-type' returns #f in that case.
-    (let-values (((server)   (get-server-public-key session))
-                 ((type key) (host-key->type+key
-                              (build-machine-host-key machine))))
-      (unless (and (or (not (get-key-type server))
-                       (eq? (get-key-type server) type))
-                   (string=? (public-key->string server) key))
-        ;; Key mismatch: something's wrong.  XXX: It could be that the server
-        ;; provided its Ed25519 key when we where expecting its RSA key.
-        (leave (_ "server at '~a' returned host key '~a' of type '~a' \
+    (match (connect! session)
+      ('ok
+       ;; Authenticate the server.  XXX: Guile-SSH 0.10.1 doesn't know about
+       ;; ed25519 keys and 'get-key-type' returns #f in that case.
+       (let-values (((server)   (get-server-public-key session))
+                    ((type key) (host-key->type+key
+                                 (build-machine-host-key machine))))
+         (unless (and (or (not (get-key-type server))
+                          (eq? (get-key-type server) type))
+                      (string=? (public-key->string server) key))
+           ;; Key mismatch: something's wrong.  XXX: It could be that the 
server
+           ;; provided its Ed25519 key when we where expecting its RSA key.
+           (leave (_ "server at '~a' returned host key '~a' of type '~a' \
 instead of '~a' of type '~a'~%")
-               (build-machine-name machine)
-               (public-key->string server) (get-key-type server)
-               key type)))
-
-    (let ((auth (userauth-public-key! session private)))
-      (unless (eq? 'success auth)
-        (disconnect! session)
-        (leave (_ "SSH public key authentication failed for '~a': ~a~%")
-               (build-machine-name machine) (get-error session))))
-
-    session))
+                  (build-machine-name machine)
+                  (public-key->string server) (get-key-type server)
+                  key type)))
+
+       (let ((auth (userauth-public-key! session private)))
+         (unless (eq? 'success auth)
+           (disconnect! session)
+           (leave (_ "SSH public key authentication failed for '~a': ~a~%")
+                  (build-machine-name machine) (get-error session))))
+
+       session)
+      (x
+       ;; Connection failed or timeout expired.
+       (leave (_ "failed to connect to '~a': ~a~%")
+              (build-machine-name machine) (get-error session))))))
 
 (define* (connect-to-remote-daemon session
                                    #:optional