TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
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.
#: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)))
(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))))
(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))
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