me
/
guix
Archived
1
0
Fork 0
Code

ssh: Add 'authenticate-server*' and use it for offloading. 

* 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.
master
Ludovic Courtès 2019-12-03 21:28:23 +01:00
parent d75540473f
commit 114dcb429a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 39 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
guix/scripts/offload.scm
View File

@ -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)

37
guix/ssh.scm
View File

@ -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))