ssh: 'open-ssh-session' can be passed the expected host key.
* guix/ssh.scm (open-ssh-session): Add #:host-key parameter. Pass #:knownhosts to 'make-session'. When HOST-KEY is true, call 'authenticate-server*' instead of 'authenticate-server'.
This commit is contained in:
parent
f5c180180e
commit
2b8682841d
39
guix/ssh.scm
39
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)
|
||||
|
Loading…
Reference in New Issue
Block a user