services: hurd-vm: Implement zero-configuration offloading.

This allows for zero-configuration offloading to a childhurd.

* gnu/services/virtualization.scm (operating-system-with-offloading-account):
New procedure.
(<hurd-vm-configuration>)[offloading?]: New field.
(hurd-vm-disk-image): Define ‘transform’ and use it.
(hurd-vm-activation): Generate SSH key for user ‘offloading’ and add
authorize it via /etc/childhurd/etc/ssh/authorized_keys.d.
(hurd-vm-configuration-offloading-ssh-key)
(hurd-vm-guix-extension): New procedures.
(hurd-vm-service-type): Add GUIX-SERVICE-TYPE extension.
* gnu/tests/virtualization.scm (run-childhurd-test)[import-module?]: New
procedure.
[os]: Add (gnu build install) and its closure to #:import-modules.
[test]: Add “copy-on-write store” and “offloading” tests.
* doc/guix.texi (Virtualization Services): Document it.

3 files changed, 169 insertions, 32 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index e03840aa16..8c5697589f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35722,6 +35722,15 @@ guix shell tigervnc-client -- vncviewer localhost:5900
 The default configuration (see @code{hurd-vm-configuration} below)
 spawns a secure shell (SSH) server in your GNU/Hurd system, which QEMU
 (the virtual machine emulator) redirects to port 10222 on the host.
+By default, the service enables @dfn{offloading} such that the host
+@code{guix-daemon} automatically offloads GNU/Hurd builds to the
+childhurd (@pxref{Daemon Offload Setup}).  This is what happens when
+running a command like the following one, where @code{i586-gnu} is the
+system type of 32-bit GNU/Hurd:
+
+@example
+guix build emacs-minimal -s i586-gnu
+@end example
 
 The childhurd is volatile and stateless: it starts with a fresh root
 file system every time you restart it.  By default though, all the files
@@ -35855,6 +35864,41 @@ with forwarded ports:
 @var{vnc-port}: @code{(+ 15900 (* 1000 @var{ID}))}
 @end example
 
+@cindex childhurd, offloading
+@cindex Hurd, offloading
+@item @code{offloading?} (default: @code{#t})
+Whether to automatically set up offloading of builds to the childhurd.
+
+When enabled, this lets you run GNU/Hurd builds on the host and have
+them transparently offloaded to the VM, for instance when running a
+command like this:
+
+@example
+guix build coreutils -s i586-gnu
+@end example
+
+This option automatically sets up offloading like so:
+
+@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
+(@pxref{Invoking guix archive, @command{guix archive --authorize}}, for
+more on that).
+
+@item
+Creating a user account called @code{offloading} dedicated to offloading
+in the childhurd.
+
+@item
+Creating an SSH key pair on the host and making it an authorized key of
+the @code{offloading} account in the childhurd.
+
+@item
+Adding the childhurd to @file{/etc/guix/machines.scm} (@pxref{Daemon
+Offload Setup}).
+@end enumerate
+
 @item @code{secret-root} (default: @file{/etc/childhurd})
 The root directory with out-of-band secrets to be installed into the
 childhurd once it runs.  Childhurds are volatile which means that on
@@ -35872,38 +35916,13 @@ with the following non-volatile secrets, unless they already exist:
 /etc/childhurd/etc/guix/acl
 /etc/childhurd/etc/guix/signing-key.pub
 /etc/childhurd/etc/guix/signing-key.sec
+/etc/childhurd/etc/ssh/authorized_keys.d/offloading
 /etc/childhurd/etc/ssh/ssh_host_ed25519_key
 /etc/childhurd/etc/ssh/ssh_host_ecdsa_key
 /etc/childhurd/etc/ssh/ssh_host_ed25519_key.pub
 /etc/childhurd/etc/ssh/ssh_host_ecdsa_key.pub
 @end example
 
-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 930c2ce702..076eca7ea2 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -27,6 +27,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages gdb)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:use-module (gnu packages package-management)
@@ -52,6 +53,7 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:autoload   (guix self) (make-config.scm)
+  #:autoload   (guix platform) (platform-system)
 
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
@@ -1063,6 +1065,26 @@ that will be listening to receive secret keys on port 1004, TCP."
 ;;; The Hurd in VM service: a Childhurd.
 ;;;
 
+(define (operating-system-with-offloading-account os)
+  (define accounts
+    (list (user-group
+           (name "offloading")
+           (system? #t))
+          (user-account
+           (name "offloading")
+           (group "offloading")
+           (system? #t)
+           (comment "Offloading privilege separation user")
+           (home-directory "/var/run/offloading")
+           (shell (file-append bash-minimal "/bin/sh")))))
+
+  (operating-system
+    (inherit os)
+    (services (cons (simple-service 'offloading-account
+                                    account-service-type
+                                    accounts)
+                    (operating-system-user-services os)))))
+
 (define %hurd-vm-operating-system
   (operating-system
     (inherit %hurd-default-operating-system)
@@ -1115,14 +1137,21 @@ that will be listening to receive secret keys on port 1004, TCP."
   (net-options hurd-vm-configuration-net-options        ;list of string
                (thunked)
                (default (hurd-vm-net-options this-record)))
+  (offloading? hurd-vm-configuration-offloading?        ;Boolean
+               (default #t))
   (secret-root hurd-vm-configuration-secret-root        ;string
                (default "/etc/childhurd")))
 
 (define (hurd-vm-disk-image config)
   "Return a disk-image for the Hurd according to CONFIG.  The secret-service
 is added to the OS specified in CONFIG."
-  (let* ((os        (secret-service-operating-system
-                     (hurd-vm-configuration-os config)))
+  (define transform
+    (compose secret-service-operating-system
+             (if (hurd-vm-configuration-offloading? config)
+                 operating-system-with-offloading-account
+                 identity)))
+
+  (let* ((os        (transform (hurd-vm-configuration-os config)))
          (disk-size (hurd-vm-configuration-disk-size config))
          (type      (lookup-image-type-by-name 'hurd-qcow2))
          (os->image (image-type-constructor type)))
@@ -1331,18 +1360,71 @@ an argument) on the host."
         (define guix-directory
           (string-append secret-directory "/etc/guix"))
 
+        (define offloading-ssh-key
+          #$(hurd-vm-configuration-offloading-ssh-key config))
+
         (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 (or (not #$(hurd-vm-configuration-offloading? config))
+                    (file-exists? offloading-ssh-key))
+          ;; Generate a user SSH key pair for the host to use when offloading
+          ;; to the guest.
+          (mkdir-p (dirname offloading-ssh-key))
+          (invoke #$(file-append openssh "/bin/ssh-keygen")
+                  "-t" "ed25519" "-N" ""
+                  "-f" offloading-ssh-key)
+
+          ;; Authorize it in the guest for user 'offloading'.
+          (let ((authorizations
+                 (string-append ssh-directory
+                                "/authorized_keys.d/offloading")))
+            (mkdir-p (dirname authorizations))
+            (copy-file (string-append offloading-ssh-key ".pub")
+                       authorizations)
+            (chmod (dirname authorizations) #o555)))
+
         (unless (file-exists? guix-directory)
           (invoke #$(initialize-hurd-vm-substitutes)
                   guix-directory))
 
-        ;; Authorize the archive signing key from GUIX-DIRECTORY in the host.
-        (invoke #$(authorize-guest-substitutes-on-host) guix-directory))))
+        (when #$(hurd-vm-configuration-offloading? config)
+          ;; Authorize the archive signing key from GUIX-DIRECTORY in the host.
+          (invoke #$(authorize-guest-substitutes-on-host) guix-directory)))))
+
+(define (hurd-vm-configuration-offloading-ssh-key config)
+  "Return the name of the file containing the SSH key of user 'offloading'."
+  (string-append "/etc/guix/offload/ssh/childhurd"
+                 (or (and=> (hurd-vm-configuration-id config)
+                            number->string)
+                     "")))
+
+(define (hurd-vm-guix-extension config)
+  "When offloading is enabled, add this childhurd to the list of offlading
+machines in /etc/guix/machines.scm."
+  (if (hurd-vm-configuration-offloading? config)
+      (let* ((image (hurd-vm-configuration-image config))
+             (platform (image-platform image))
+             (system (platform-system platform))
+             (vm-ssh-key (string-append
+                          (hurd-vm-configuration-secret-root config)
+                          "/etc/ssh/ssh_host_ed25519_key.pub"))
+             (host-ssh-key (hurd-vm-configuration-offloading-ssh-key config)))
+        (guix-extension
+         (build-machines
+          (list #~(build-machine
+                   (name "localhost")
+                   (port #$(hurd-vm-port config %hurd-vm-ssh-port))
+                   (systems '(#$system))
+                   (host-key (call-with-input-file #$vm-ssh-key
+                               (@ (ice-9 textual-ports)
+                                  get-string-all)))
+                   (user "offloading")
+                   (private-key #$host-ssh-key))))))
+      (guix-extension)))
 
 (define hurd-vm-service-type
   (service-type
@@ -1351,6 +1433,8 @@ an argument) on the host."
                                         hurd-vm-shepherd-service)
                      (service-extension account-service-type
                                         (const %hurd-vm-accounts))
+                     (service-extension guix-service-type
+                                        hurd-vm-guix-extension)
                      (service-extension activation-service-type
                                         hurd-vm-activation)))
    (default-value (hurd-vm-configuration))
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
index 599e58edf0..b79164737b 100644
--- a/gnu/tests/virtualization.scm
+++ b/gnu/tests/virtualization.scm
@@ -38,6 +38,7 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix store)
+  #:use-module (guix modules)
   #:export (%test-libvirt
             %test-qemu-guest-agent
             %test-childhurd))
@@ -244,11 +245,19 @@
                                   (permit-root-login #t)))))))))))
 
 (define (run-childhurd-test)
+  (define (import-module? module)
+    ;; This module is optional and depends on Guile-Gcrypt, do skip it.
+    (and (guix-module-name? module)
+         (not (equal? module '(guix store deduplication)))))
+
   (define os
     (marionette-operating-system
      %childhurd-os
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
+     #:imported-modules (source-module-closure
+                         '((gnu services herd)
+                           (guix combinators)
+                           (gnu build install))
+                         #:select? import-module?)))
 
   (define vm
     (virtual-machine
@@ -373,6 +382,31 @@
                                    (pk 'drv (string-trim-right drv)))
                    drv)))
 
+          (test-assert "copy-on-write store"
+            ;; Set up a writable store.  The root partition is already an
+            ;; overlayfs, which is not suitable as the bottom part of this
+            ;; additional overlayfs; thus, create a tmpfs for the backing
+            ;; store.
+            ;; TODO: Remove this when <virtual-machine> creates a writable
+            ;; store.
+            (marionette-eval
+             '(begin
+                (use-modules (gnu build install)
+                             (guix build syscalls))
+
+                (mkdir "/run/writable-store")
+                (mount "none" "/run/writable-store" "tmpfs")
+                (mount-cow-store "/run/writable-store" "/backing-store")
+                (system* "df" "-hT"))
+             marionette))
+
+          (test-equal "offloading"
+            0
+            (marionette-eval
+             '(and (file-exists? "/etc/guix/machines.scm")
+                   (system* "guix" "offload" "test"))
+             marionette))
+
           (test-end))))
 
   (gexp->derivation "childhurd-test" test))