me/guix
Archived
1
0
Fork 0
Code Activity

offload: Gracefully report connection failures.

Browse source 
* guix/scripts/offload.scm (open-ssh-session): Check the return value of
'connect!'.  Call 'leave' when it's not 'ok.
This commit is contained in:
Ludovic Courtès 2016-12-01 23:20:18 +01:00
parent 6374633b92
commit 74afca5dcf
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
guix/scripts/offload.scm
View file

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