~ruther/guix-local

74afca5dcfa6f321b5523e9bae8b1aff30e9c6af — Ludovic Courtès 9 years ago 6374633
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.
1 files changed, 28 insertions(+), 24 deletions(-)

M guix/scripts/offload.scm
M guix/scripts/offload.scm => guix/scripts/offload.scm +28 -24
@@ 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