[bug#43106] [PATCH v3 2/2] services: childhurd: Support installing secrets from the host.

["Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>]

* gnu/system/examples/bare-hurd.tmpl (%hurd-os)[services]: Add secret-service.
* gnu/services/virtualization.scm (%hurd-vm-operating-system): Likewise.
 (hurd-vm-shepherd-service): Use it to install secrets.
* doc/guix.texi (The Hurd in a Virtual Machine): Document it.
---
 doc/guix.texi                      | 21 ++++++++++
 gnu/services/virtualization.scm    | 63 ++++++++++++++++++++++++------
 gnu/system/examples/bare-hurd.tmpl | 20 +++++-----
 3 files changed, 84 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 6206a93857..8a6ab698e6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25119,6 +25119,7 @@ Return the name of @var{platform}---a string such as @code{"arm"}.
 
 @cindex @code{hurd}
 @cindex the Hurd
+@cindex childhurd
 
 Service @code{hurd-vm} provides support for running GNU/Hurd in a
 virtual machine (VM), a so-called ``Childhurd''.  The virtual machine is
@@ -25191,15 +25192,35 @@ By default, it produces
 @lisp
 '("--device" "rtl8139,netdev=net0"
   "--netdev" "user,id=net0\
+              ,hostfwd=tcp:127.0.0.1:<secrets-port>-:1004\
               ,hostfwd=tcp:127.0.0.1:<ssh-port>-:2222\
               ,hostfwd=tcp:127.0.0.1:<vnc-port>-:5900")
 @end lisp
 with forwarded ports
 @example
+<ssh-port>: @code{(+ 11004 (* 1000 @var{ID}))}
 <ssh-port>: @code{(+ 10022 (* 1000 @var{ID}))}
 <vnc-port>: @code{(+ 15900 (* 1000 @var{ID}))}
 @end example
 
+@item @code{secret-root} (default: @code{#f})
+If set, the root directory with out-of-band secrets to be installed into
+the childhurd once it runs.  Childhurds are volatile which means that on
+every startup, secrets such as the SSH host keys and Guix signing key
+are recreated.
+
+Typical use is setting @code{secret-root} to @code{"/etc/childhurd"}
+pointing at a tree of non-volatile secrets like so
+
+@example
+/etc/childhurd/etc/guix/signing-key.pub
+/etc/childhurd/etc/guix/signing-key.sec
+/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
+
 @end table
 @end deftp
 
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 6d6734dcd1..1fa74f815e 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -39,6 +39,7 @@
   #:use-module (gnu system)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
+  #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix records)
@@ -61,7 +62,10 @@
             hurd-vm-configuration-options
             hurd-vm-configuration-id
             hurd-vm-configuration-net-options
+            hurd-vm-configuration-secrets
+
             hurd-vm-disk-image
+            hurd-vm-port
             hurd-vm-net-options
             hurd-vm-service-type
 
@@ -846,6 +850,8 @@ can only be accessed by their host.")))
                  (target "/dev/vda")
                  (timeout 0)))
     (services (cons*
+               ;; Receive secret keys on port 1004, TCP.
+               (service secret-service-type 1004)
                (service openssh-service-type
                         (openssh-configuration
                          (openssh openssh-sans-x)
@@ -876,7 +882,9 @@ can only be accessed by their host.")))
                (default #f))
   (net-options hurd-vm-configuration-net-options        ;list of string
                (thunked)
-               (default (hurd-vm-net-options this-record))))
+               (default (hurd-vm-net-options this-record)))
+  (secret-root hurd-vm-configuration-secret-root        ;#f or string
+               (default #f)))
 
 (define (hurd-vm-disk-image config)
   "Return a disk-image for the Hurd according to CONFIG."
@@ -888,15 +896,27 @@ can only be accessed by their host.")))
       (size disk-size)
       (operating-system os)))))
 
-(define (hurd-vm-net-options config)
+(define (hurd-vm-port config base)
+  "Return the forwarded vm port for this childhurd config."
   (let ((id (or (hurd-vm-configuration-id config) 0)))
-    (define (qemu-vm-port base)
-      (number->string (+ base (* 1000 id))))
-    `("--device" "rtl8139,netdev=net0"
-      "--netdev" ,(string-append
-                   "user,id=net0"
-                   ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 10022) "-:2222"
-                   ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 15900) "-:5900"))))
+    (+ base (* 1000 id))))
+(define %hurd-vm-secrets-port 11004)
+(define %hurd-vm-ssh-port 10022)
+(define %hurd-vm-vnc-port 15900)
+
+(define (hurd-vm-net-options config)
+  `("--device" "rtl8139,netdev=net0"
+    "--netdev"
+    ,(string-append "user,id=net0"
+                    ",hostfwd=tcp:127.0.0.1:"
+                    (number->string (hurd-vm-port config %hurd-vm-secrets-port))
+                    "-:1004"
+                    ",hostfwd=tcp:127.0.0.1:"
+                    (number->string (hurd-vm-port config %hurd-vm-ssh-port))
+                    "-:2222"
+                    ",hostfwd=tcp:127.0.0.1:"
+                    (number->string (hurd-vm-port config %hurd-vm-vnc-port))
+                    "-:5900")))
 
 (define (hurd-vm-shepherd-service config)
   "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG."
@@ -927,8 +947,29 @@ can only be accessed by their host.")))
                             (string->symbol (number->string id)))
                       provisions)
                      provisions))
-      (requirement '(networking))
-      (start #~(make-forkexec-constructor #$vm-command))
+      (requirement '(loopback networking user-processes))
+      (start
+       (with-imported-modules
+           (source-module-closure '((gnu build secret-service)
+                                    (guix build utils)))
+         #~(let ((spawn (make-forkexec-constructor #$vm-command)))
+           (lambda _
+             (let ((pid (spawn))
+                   (port #$(hurd-vm-port config %hurd-vm-secrets-port))
+                   (root #$(hurd-vm-configuration-secret-root config)))
+               (and root (directory-exists? root)
+                    (catch #t
+                      (lambda _
+                        (secret-service-send-secrets port root))
+                      (lambda (keys . args)
+                        (format (current-error-port)
+                                "failed to send secrets: ~a ~s\n" key args)
+                        (kill pid)
+                        #f))
+                    pid))))))
+      (modules `((gnu build secret-service)
+                 (guix build utils)
+                 ,@%default-modules))
       (stop  #~(make-kill-destructor))))))
 
 (define hurd-vm-service-type
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 414a9379c8..2d00a7c8bb 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -41,14 +41,16 @@
     (host-name "guixygnu")
     (timezone "Europe/Amsterdam")
     (packages (cons openssh-sans-x %base-packages/hurd))
-    (services (cons (service openssh-service-type
-                             (openssh-configuration
-                              (openssh openssh-sans-x)
-                              (use-pam? #f)
-                              (port-number 2222)
-                              (permit-root-login #t)
-                              (allow-empty-passwords? #t)
-                              (password-authentication? #t)))
-               %base-services/hurd))))
+    (services (append (list (service openssh-service-type
+                                     (openssh-configuration
+                                      (openssh openssh-sans-x)
+                                      (use-pam? #f)
+                                      (port-number 2222)
+                                      (permit-root-login #t)
+                                      (allow-empty-passwords? #t)
+                                      (password-authentication? #t)))
+                            (service (@@ (gnu services virtualization)
+                                         secret-service-type) 5999))
+                      %base-services/hurd))))
 
 %hurd-os
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com