[bug#43650] [PATCH 6/8] services: hurd-vm: Initialize the guest's SSH/Guix keys at activation time.

[Ludovic Courtès]

* gnu/services/virtualization.scm (initialize-hurd-vm-substitutes)
(hurd-vm-activation): New procedures.
(hurd-vm-service-type)[extensions]: Add ACTIVATION-SERVICE-TYPE
extension.
* doc/guix.texi (Transparent Emulation with QEMU): Mention GNU/Hurd.
(The Hurd in a Virtual Machine): Explain which files are automatically
installed and mention offloading.
---
 doc/guix.texi                   | 33 ++++++++++++++--
 gnu/services/virtualization.scm | 67 ++++++++++++++++++++++++++++++++-
 2 files changed, 96 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 885f7fcf97..851afe843d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25342,6 +25342,8 @@ emulation of program binaries built for different 
architectures---e.g.,
 it allows you to transparently execute an ARMv7 program on an x86_64
 machine.  It achieves this by combining the @uref{https://www.qemu.org,
 QEMU} emulator and the @code{binfmt_misc} feature of the kernel Linux.
+This feature only allows you to emulate GNU/Linux on a different
+architecture, but see below for GNU/Hurd support.
 
 @defvr {Scheme Variable} qemu-binfmt-service-type
 This is the type of the QEMU/binfmt service for transparent emulation.
@@ -25544,10 +25546,11 @@ If the @file{/etc/childhurd} directory does not 
exist, the
 @code{secret-service} running in the Childhurd will be sent an empty
 list of secrets.
 
-Typical use to populate @file{"/etc/childhurd"} with a tree of
-non-volatile secrets, like so
+By default, the service automatically populates @file{/etc/childhurd}
+with the following non-volatile secrets, unless they already exist:
 
 @example
+/etc/childhurd/etc/guix/acl
 /etc/childhurd/etc/guix/signing-key.pub
 /etc/childhurd/etc/guix/signing-key.sec
 /etc/childhurd/etc/ssh/ssh_host_ed25519_key
@@ -25556,8 +25559,32 @@ non-volatile secrets, like so
 /etc/childhurd/etc/ssh/ssh_host_ecdsa_key.pub
 @end example
 
-to be sent to the Childhurd, including permissions.
+These files are automatically sent to the guest Hurd VM when it boots,
+including permissions.
 
+@cindex childhurd, offloading
+@cindex Hurd, offloading
+Having these files in place means that only a couple of things are
+missing to allow the host to offload @code{i586-gnu} builds to the
+childhurd:
+
+@enumerate
+@item
+Authorizing the childhurd's key on the host so that the host accepts
+build results coming from the childhurd, which can be done like so:
+
+@example
+guix archive --authorize < \
+  /etc/childhurd/etc/guix/signing-key.pub
+@end example
+
+@item
+Adding the childhurd to @file{/etc/guix/machines.scm} (@pxref{Daemon
+Offload Setup}).
+@end enumerate
+
+We're working towards making that happen automatically---get in touch
+with us at @email{guix-devel@@gnu.org} to discuss it!
 @end table
 @end deftp
 
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index b84203ad18..c639fa3741 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages package-management)
   #:use-module (gnu packages ssh)
   #:use-module (gnu packages virtualization)
   #:use-module (gnu services base)
@@ -992,13 +993,77 @@ is added to the OS specified in CONFIG."
          (shell (file-append shadow "/sbin/nologin"))
          (system? #t))))
 
+(define (initialize-hurd-vm-substitutes)
+  "Initialize the Hurd VM's key pair and ACL and store it on the host."
+  (define run
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 match))
+
+          (define host-key
+            "/etc/guix/signing-key.pub")
+
+          (define host-acl
+            "/etc/guix/acl")
+
+          (match (command-line)
+            ((_ guest-config-directory)
+             (setenv "GUIX_CONFIGURATION_DIRECTORY"
+                     guest-config-directory)
+             (invoke #+(file-append guix "/bin/guix") "archive"
+                     "--generate-key")
+
+             (when (file-exists? host-acl)
+               ;; Copy the host ACL.
+               (copy-file host-acl
+                          (string-append guest-config-directory
+                                         "/acl")))
+
+             (when (file-exists? host-key)
+               ;; Add the host key to the childhurd's ACL.
+               (let ((key (open-fdes host-key O_RDONLY)))
+                 (close-fdes 0)
+                 (dup2 key 0)
+                 (execl #+(file-append guix "/bin/guix")
+                        "guix" "archive" "--authorize"))))))))
+
+  (program-file "initialize-hurd-vm-substitutes" run))
+
+(define (hurd-vm-activation config)
+  "Return a gexp to activate the Hurd VM according to CONFIG."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define secret-directory
+          #$(hurd-vm-configuration-secret-root config))
+
+        (define ssh-directory
+          (string-append secret-directory "/etc/ssh"))
+
+        (define guix-directory
+          (string-append secret-directory "/etc/guix"))
+
+        (unless (file-exists? ssh-directory)
+          ;; Generate SSH host keys under SSH-DIRECTORY.
+          (mkdir-p ssh-directory)
+          (invoke #$(file-append openssh "/bin/ssh-keygen")
+                  "-A" "-f" secret-directory))
+
+        (unless (file-exists? guix-directory)
+          (invoke #$(initialize-hurd-vm-substitutes)
+                  guix-directory)))))
+
 (define hurd-vm-service-type
   (service-type
    (name 'hurd-vm)
    (extensions (list (service-extension shepherd-root-service-type
                                         hurd-vm-shepherd-service)
                      (service-extension account-service-type
-                                        (const %hurd-vm-accounts))))
+                                        (const %hurd-vm-accounts))
+                     (service-extension activation-service-type
+                                        hurd-vm-activation)))
    (default-value (hurd-vm-configuration))
    (description
     "Provide a virtual machine (VM) running GNU/Hurd, also known as a
-- 
2.28.0