* guix/scripts/offload.scm (host-key->type+key): Remove.
(open-ssh-session): Replace server authentication code with a call to
'authenticate-server*'.
* guix/ssh.scm (host-key->type+key, authenticate-server*): New
procedures.
---
guix/scripts/offload.scm | 30 ++----------------------------
guix/ssh.scm | 37 +++++++++++++++++++++++++++++++++++++
2 files changed, 39 insertions(+), 28 deletions(-)
Toggle diff (105 lines)
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 18473684eb..e81b6c25f2 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -149,19 +149,6 @@ ignoring it~%")
(leave (G_ "failed to load machine file '~a': ~s~%")
file args))))))
-(define (host-key->type+key host-key)
- "Destructure HOST-KEY, an OpenSSH host key string, and return two values:
-its key type as a symbol, and the actual base64-encoded string."
- (define (type->symbol type)
- (and (string-prefix? "ssh-" type)
- (string->symbol (string-drop type 4))))
-
- (match (string-tokenize host-key)
- ((type key x)
- (values (type->symbol type) key))
- ((type key)
- (values (type->symbol type) key))))
-
(define (private-key-from-file* file)
"Like 'private-key-from-file', but raise an error that 'with-error-handling'
can interpret meaningfully."
@@ -203,21 +190,8 @@ private key from '~a': ~a")
(build-machine-compression-level machine))))
(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 (G_ "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)))
+ ;; Make sure the server's key is what we expect.
+ (authenticate-server* session (build-machine-host-key machine))
(let ((auth (userauth-public-key! session private)))
(unless (eq? 'success auth)
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 5fd3c280e8..f34e71392b 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -37,6 +37,8 @@
#:use-module (ice-9 format)
#:use-module (ice-9 binary-ports)
#:export (open-ssh-session
+ authenticate-server*
+
remote-inferior
remote-daemon-channel
connect-to-remote-daemon
@@ -60,6 +62,41 @@
(define %compression
"zlib@openssh.com,zlib")
+(define (host-key->type+key host-key)
+ "Destructure HOST-KEY, an OpenSSH host key string, and return two values:
+its key type as a symbol, and the actual base64-encoded string."
+ (define (type->symbol type)
+ (and (string-prefix? "ssh-" type)
+ (string->symbol (string-drop type 4))))
+
+ (match (string-tokenize host-key)
+ ((type key x)
+ (values (type->symbol type) key))
+ ((type key)
+ (values (type->symbol type) key))))
+
+(define (authenticate-server* session key)
+ "Make sure the server for SESSION has the given KEY, where KEY is a string
+such as \"ssh-ed25519 AAAAC3Nz… root@example.org\". Raise an exception if the
+actual key does not match."
+ (let-values (((server) (get-server-public-key session))
+ ((type key) (host-key->type+key key)))
+ (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. XXX:
+ ;; Guile-SSH 0.10.1 doesn't know about ed25519 keys and 'get-key-type'
+ ;; returns #f in that case.
+ (raise (condition
+ (&message
+ (message (format #f (G_ "server at '~a' returned host key \
+'~a' of type '~a' instead of '~a' of type '~a'~%")
+ (session-get session 'host)
+ (public-key->string server)
+ (get-key-type server)
+ key type))))))))
+
(define* (open-ssh-session host #:key user port identity
(compression %compression)
(timeout 3600))
--
2.24.0