summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/ssh.scm39
1 files changed, 27 insertions, 12 deletions
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 519c723155..291ce20b61 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -98,14 +98,20 @@ actual key does not match."
key type))))))))
(define* (open-ssh-session host #:key user port identity
+ host-key
(compression %compression)
(timeout 3600))
"Open an SSH session for HOST and return it. IDENTITY specifies the file
name of a private key to use for authenticating with the host. When USER,
PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
-specifies; otherwise use them. Install TIMEOUT as the maximum time in seconds
-after which a read or write operation on a channel of the returned session is
-considered as failing.
+specifies; otherwise use them.
+
+When HOST-KEY is true, it must be a string like \"ssh-ed25519 AAAAC3Nz…
+root@example.org\"; the server is authenticated and an error is raised if its
+host key is different from HOST-KEY.
+
+Install TIMEOUT as the maximum time in seconds after which a read or write
+operation on a channel of the returned session is considered as failing.
Throw an error on failure."
(let ((session (make-session #:user user
@@ -115,6 +121,11 @@ Throw an error on failure."
#:timeout 10 ;seconds
;; #:log-verbosity 'protocol
+ ;; Prevent libssh from reading
+ ;; ~/.ssh/known_hosts when the caller provides
+ ;; a HOST-KEY to match against.
+ #:knownhosts (and host-key "/dev/null")
+
;; We need lightweight compression when
;; exchanging full archives.
#:compression compression
@@ -125,16 +136,20 @@ Throw an error on failure."
(match (connect! session)
('ok
- ;; Authenticate against ~/.ssh/known_hosts.
- (match (authenticate-server session)
- ('ok #f)
- (reason
- (raise (condition
- (&message
- (message (format #f (G_ "failed to authenticate \
+ (if host-key
+ ;; Make sure the server's key is what we expect.
+ (authenticate-server* session host-key)
+
+ ;; Authenticate against ~/.ssh/known_hosts.
+ (match (authenticate-server session)
+ ('ok #f)
+ (reason
+ (raise (condition
+ (&message
+ (message (format #f (G_ "failed to authenticate \
server at '~a': ~a")
- (session-get session 'host)
- reason)))))))
+ (session-get session 'host)
+ reason))))))))
;; Use public key authentication, via the SSH agent if it's available.
(match (userauth-public-key/auto! session)