aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi3
-rw-r--r--gnu/machine/ssh.scm33
-rw-r--r--guix/ssh.scm23
3 files changed, 52 insertions, 7 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index e5cec7ad25..d80f62970d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25586,6 +25586,9 @@ with an @code{environment} of @code{managed-host-environment-type}.
@item @code{system}
The Nix system type describing the architecture of the machine being deployed
to. This should look something like ``x86_64-linux''.
+@item @code{authorize?} (default: @code{#t})
+If true, the coordinator's signing key will be added to the remote's ACL
+keyring.
@item @code{port} (default: @code{22})
@item @code{user} (default: @code{"root"})
@item @code{identity} (default: @code{#f})
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 4b5d5fe3a2..ac3aa3e370 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -28,13 +28,16 @@
#:use-module (guix i18n)
#:use-module (guix modules)
#:use-module (guix monads)
+ #:use-module (guix pki)
#:use-module (guix records)
#:use-module (guix remote)
#:use-module (guix scripts system reconfigure)
#:use-module (guix ssh)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (gcrypt pk-crypto)
#:use-module (ice-9 match)
+ #:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@@ -48,6 +51,7 @@
machine-ssh-configuration-host-name
machine-ssh-configuration-build-locally?
+ machine-ssh-configuration-authorize?
machine-ssh-configuration-port
machine-ssh-configuration-user
machine-ssh-configuration-session))
@@ -70,17 +74,19 @@
make-machine-ssh-configuration
machine-ssh-configuration?
this-machine-ssh-configuration
- (host-name machine-ssh-configuration-host-name) ; string
- (system machine-ssh-configuration-system) ; string
- (build-locally? machine-ssh-configuration-build-locally?
+ (host-name machine-ssh-configuration-host-name) ; string
+ (system machine-ssh-configuration-system) ; string
+ (build-locally? machine-ssh-configuration-build-locally? ; boolean
(default #t))
- (port machine-ssh-configuration-port ; integer
+ (authorize? machine-ssh-configuration-authorize? ; boolean
+ (default #t))
+ (port machine-ssh-configuration-port ; integer
(default 22))
- (user machine-ssh-configuration-user ; string
+ (user machine-ssh-configuration-user ; string
(default "root"))
- (identity machine-ssh-configuration-identity ; path to a private key
+ (identity machine-ssh-configuration-identity ; path to a private key
(default #f))
- (session machine-ssh-configuration-session ; session
+ (session machine-ssh-configuration-session ; session
(default #f)))
(define (machine-ssh-session machine)
@@ -359,6 +365,19 @@ the 'should-roll-back' field set to SHOULD-ROLL-BACK?"
"Internal implementation of 'deploy-machine' for MACHINE instances with an
environment type of 'managed-host."
(maybe-raise-unsupported-configuration-error machine)
+ (when (machine-ssh-configuration-authorize?
+ (machine-configuration machine))
+ (unless (file-exists? %public-key-file)
+ (raise (condition
+ (&message
+ (message (format #f (G_ "no signing key '~a'. \
+have you run 'guix archive --generate-key?'")
+ %public-key-file))))))
+ (remote-authorize-signing-key (call-with-input-file %public-key-file
+ (lambda (port)
+ (string->canonical-sexp
+ (get-string-all port))))
+ (machine-ssh-session machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
(boot-parameters (machine-boot-parameters machine)))
(let* ((os (machine-operating-system machine))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 90311127a1..24834c6f68 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -21,6 +21,7 @@
#:use-module (guix inferior)
#:use-module (guix i18n)
#:use-module ((guix utils) #:select (&fix-hint))
+ #:use-module (gcrypt pk-crypto)
#:use-module (ssh session)
#:use-module (ssh auth)
#:use-module (ssh key)
@@ -40,6 +41,7 @@
remote-daemon-channel
connect-to-remote-daemon
remote-system
+ remote-authorize-signing-key
send-files
retrieve-files
retrieve-files*
@@ -300,6 +302,27 @@ the machine on the other end of SESSION."
(inferior-remote-eval '(begin (use-modules (guix utils)) (%current-system))
session))
+(define (remote-authorize-signing-key key session)
+ "Send KEY, a canonical sexp containing a public key, over SESSION and add it
+to the system ACL file if it has not yet been authorized."
+ (inferior-remote-eval
+ `(begin
+ (use-modules (guix build utils)
+ (guix pki)
+ (guix utils)
+ (gcrypt pk-crypto)
+ (srfi srfi-26))
+
+ (define acl (current-acl))
+ (define key (string->canonical-sexp ,(canonical-sexp->string key)))
+
+ (unless (authorized-key? key)
+ (let ((acl (public-keys->acl (cons key (acl->public-keys acl)))))
+ (mkdir-p (dirname %acl-file))
+ (with-atomic-file-output %acl-file
+ (cut write-acl acl <>)))))
+ session))
+
(define* (send-files local files remote
#:key
recursive?