[bug#36956] [PATCH] machine: Automatically authorize the coordinator's signing key.

[Jakob L. Kreuze]

* guix/ssh.scm (remote-authorize-signing-key): New variable.
* gnu/machine/ssh.scm (deploy-managed-host): Authorize coordinator's
signing key before any invocations of 'remote-eval'.
* guix/scripts/deploy.scm (guix-deploy): Display an error if a signing
key does not exist.
* doc/guix.texi (Invoking guix deploy): Remove section describing manual
signing key authorization.
---
 doc/guix.texi           | 16 ----------------
 gnu/machine/ssh.scm     |  7 +++++++
 guix/scripts/deploy.scm |  7 +++++++
 guix/ssh.scm            | 23 +++++++++++++++++++++++
 4 files changed, 37 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 734206a4b2..64ca44d494 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25530,22 +25530,6 @@ complex deployment may involve, for example, starting 
virtual machines through
 a Virtual Private Server (VPS) provider.  In such a case, a different
 @var{environment} type would be used.
 
-Do note that you first need to generate a key pair on the coordinator machine
-to allow the daemon to export signed archives of files from the store
-(@pxref{Invoking guix archive}).
-
-@example
-# guix archive --generate-key
-@end example
-
-@noindent
-Each target machine must authorize the key of the master machine so that it
-accepts store items it receives from the coordinator:
-
-@example
-# guix archive --authorize < coordinator-public-key.txt
-@end example
-
 @deftp {Data Type} machine
 This is the data type representing a single machine in a heterogeneous Guix
 deployment.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 1f16d9a5ea..90deff19a8 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)
@@ -329,6 +332,10 @@ 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)
+  (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/scripts/deploy.scm b/guix/scripts/deploy.scm
index 6a67985c8b..075c74d395 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -20,6 +20,7 @@
 (define-module (guix scripts deploy)
   #:use-module (gnu machine)
   #:use-module (guix discovery)
+  #:use-module (guix pki)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix store)
@@ -83,6 +84,12 @@ Perform the deployment specified by FILE.\n"))
 (define (guix-deploy . args)
   (define (handle-argument arg result)
     (alist-cons 'file arg result))
+
+  (unless (file-exists? %public-key-file)
+    (leave (G_ "no signing key '~a'
+have you run 'guix archive --generate-key?'~%")
+           %public-key-file))
+
   (let* ((opts (parse-command-line args %options (list %default-options)
                                    #:argument-handler handle-argument))
          (file (assq-ref opts 'file))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 9b5ca68894..5186c646ca 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*
@@ -289,6 +291,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?
-- 
2.22.0

signature.asc
Description: PGP signature