[bug#43106] [PATCH] DRAFT services: childhurd: Support for setting secrets.

[bug#43106] [PATCH] DRAFT services: childhurd: Support for setting secrets.

[Jan (janneke) Nieuwenhuizen]

TODO: This seems to work...but it can keep the shepherd from finishing for
quite some time (half a minute)...not sure what to do here, WDYT?

A great way to play with it is by doing something like

--8<---------------cut here---------------start------------->8---
sudo -E ./pre-inst-env guile -c '(use-modules (gnu build childhurd)) (hurd-vm-copy-secrets 10022 "/etc/childhurd")'
--8<---------------cut here---------------end--------------->8---

* gnu/build/childhurd.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* gnu/services/virtualization.scm (hurd-vm-shepherd-service): Use it to set
secrets.
(hurd-vm-port): New function.
(hurd-vm-net-options): Use it.
* doc/guix.texi (The Hurd in a Virtual Machine): Document it.
---
 doc/guix.texi                   | 19 ++++++++
 gnu/build/childhurd.scm         | 77 +++++++++++++++++++++++++++++++++
 gnu/local.mk                    |  1 +
 gnu/services/virtualization.scm | 52 +++++++++++++++++-----
 4 files changed, 138 insertions(+), 11 deletions(-)
 create mode 100644 gnu/build/childhurd.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 0b79a49814..334ee5e05c 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
@@ -25200,6 +25201,24 @@ with forwarded ports
 <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 injected 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/build/childhurd.scm b/gnu/build/childhurd.scm
new file mode 100644
index 0000000000..87c5cc0cd0
--- /dev/null
+++ b/gnu/build/childhurd.scm
@@ -0,0 +1,77 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build childhurd)
+  #:use-module (ice-9 rdelim)
+  #:use-module (guix build utils)
+
+  ;; #:use-module (ssh auth)
+  ;; #:use-module (ssh channel)
+  ;; #:use-module (ssh session)
+  ;; #:use-module (ssh sftp)
+
+  #:autoload (ssh auth) (userauth-password!)
+  #:autoload (ssh channel) (make-channel
+                            channel-open-session channel-request-exec
+                            channel-get-exit-status)
+  #:autoload (ssh session) (make-session connect! disconnect!)
+  #:autoload (ssh sftp) (make-sftp-session
+                         call-with-remote-output-file sftp-chmod)
+
+  #:export (hurd-vm-copy-secrets))
+
+;;; Commentary:
+;;;
+;;; Utility procedures for a childhurd.
+;;;
+;;; Code:
+
+(define* (hurd-vm-copy-secrets port secret-root #:key (retry 20))
+  "Copy all files under SECRET-ROOT using ssh to childhurd at local PORT."
+  (format (current-error-port) "hurd-vm-copy-secrets\n")
+  (let ((session (make-session #:host "127.0.0.1" #:port port
+                               #:user "root")))
+    (let loop ((result (connect! session)) (retry retry))
+      (unless (equal? result 'ok)
+        (format (current-error-port) "Waiting for childhurd...\n")
+        (when (zero? retry)
+          (error "Could not connect childhurd" session result))
+        (sleep 1)
+        (disconnect! session)
+        (loop (connect! session) (1- retry))))
+    (let ((result (userauth-password! session "")))
+      (unless (equal? result 'success)
+        (error "Could not set userauth-password" session result)))
+    (let ((sftp-session (make-sftp-session session)))
+      (define (copy-file source)
+        (let ((text (with-input-from-file source read-string))
+              (mode (stat:mode (stat source)))
+              (target (substring source (string-length secret-root))))
+          (call-with-remote-output-file sftp-session target
+                                        ;;(cute display text <>)
+                                        (lambda (port) (display text port)))
+          (sftp-chmod sftp-session target mode)))
+      (for-each copy-file (find-files secret-root))
+      (let ((channel (make-channel session)))
+        (channel-open-session channel)
+        (channel-request-exec channel "herd restart sshd")
+        (unless (zero? (channel-get-exit-status channel))
+          (error "Failed to restart sshd"))))
+    (disconnect! session)))
+
+;;; childhurd.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index d956e52d97..f872f1ba77 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -648,6 +648,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/accounts.scm			\
   %D%/build/activation.scm			\
   %D%/build/bootloader.scm			\
+  %D%/build/childhurd.scm			\
   %D%/build/cross-toolchain.scm			\
   %D%/build/image.scm				\
   %D%/build/file-systems.scm			\
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index b93ed70099..f496c06764 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
 
@@ -849,7 +853,9 @@ functionality of the kernel Linux.")))
                (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."
@@ -861,15 +867,23 @@ functionality of the kernel Linux.")))
       (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-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-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."
@@ -900,8 +914,24 @@ functionality of the kernel Linux.")))
                             (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 childhurd)
+                                                       (guix build utils)))
+        (with-extensions (list guile-ssh)
+          #~(let ((spawn (make-forkexec-constructor #$vm-command)))
+              (use-modules (gnu build childhurd))
+              (lambda _
+                (let ((pid (spawn))
+                      (port #$(hurd-vm-port config %hurd-vm-ssh-port))
+                      (root #$(hurd-vm-configuration-secret-root config)))
+                  (when (and root (directory-exists? root))
+                    (catch #t
+                      (lambda _
+                        (hurd-vm-copy-secrets port root))
+                      (lambda (key . args)
+                        (format (current-error-port) "childhurd: ~a ~s\n" key args))))
+                  pid))))))
       (stop  #~(make-kill-destructor))))))
 
 (define hurd-vm-service-type
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#43106] [PATCH] DRAFT services: childhurd: Support for setting secrets.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 4754 bytes --]

Hi!

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> TODO: This seems to work...but it can keep the shepherd from finishing for
> quite some time (half a minute)...not sure what to do here, WDYT?
>
> A great way to play with it is by doing something like
>
> sudo -E ./pre-inst-env guile -c '(use-modules (gnu build childhurd)) (hurd-vm-copy-secrets 10022 "/etc/childhurd")'
>
> * gnu/build/childhurd.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * gnu/services/virtualization.scm (hurd-vm-shepherd-service): Use it to set
> secrets.
> (hurd-vm-port): New function.
> (hurd-vm-net-options): Use it.
> * doc/guix.texi (The Hurd in a Virtual Machine): Document it.

Nice, thanks for working on it!

> +@item @code{secret-root} (default: @code{#f})
> +If set, the root directory with out-of-band secrets to be injected 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

Would it make sense to have a list of source/target pairs instead of a
directory:

  (("/etc/childhurd/pubkey" . "/etc/guix/signing-key.pub")
   …)

?


[...]

> +(define-module (gnu build childhurd)
> +  #:use-module (ice-9 rdelim)
> +  #:use-module (guix build utils)
> +
> +  ;; #:use-module (ssh auth)
> +  ;; #:use-module (ssh channel)
> +  ;; #:use-module (ssh session)
> +  ;; #:use-module (ssh sftp)
> +
> +  #:autoload (ssh auth) (userauth-password!)

You could add the file to MODULES_NOT_COMPILED in gnu/local.mk to avoid
the autoload dance.

> +(define* (hurd-vm-copy-secrets port secret-root #:key (retry 20))
> +  "Copy all files under SECRET-ROOT using ssh to childhurd at local PORT."
> +  (format (current-error-port) "hurd-vm-copy-secrets\n")
> +  (let ((session (make-session #:host "127.0.0.1" #:port port
> +                               #:user "root")))

I just realized that we have a bootstrapping issue here: we have to
explicitly skip SSH host authentication because we haven’t installed the
host keys yet.

The boot sequence of the guest is actually: generate SSH host keys,
start sshd, receive host keys over SFTP.

[...]

> -      (start #~(make-forkexec-constructor #$vm-command))
> +      (requirement '(loopback networking user-processes))
> +      (start
> +       (with-imported-modules (source-module-closure '((gnu build childhurd)
> +                                                       (guix build utils)))
> +        (with-extensions (list guile-ssh)
> +          #~(let ((spawn (make-forkexec-constructor #$vm-command)))
> +              (use-modules (gnu build childhurd))

We should use the ‘modules’ field of <shepherd-service> instead of a
non-top-level ‘use-modules’.

> +              (lambda _
> +                (let ((pid (spawn))
> +                      (port #$(hurd-vm-port config %hurd-vm-ssh-port))
> +                      (root #$(hurd-vm-configuration-secret-root config)))
> +                  (when (and root (directory-exists? root))
> +                    (catch #t
> +                      (lambda _
> +                        (hurd-vm-copy-secrets port root))
> +                      (lambda (key . args)
> +                        (format (current-error-port) "childhurd: ~a ~s\n" key args))))

To avoid race conditions, we probably have to wait until PORT becomes
available, no?  Also, the VM boots even if we’ve failed to inject the
secrets, right?

As discussed on IRC, attached is my attempt at addressing this problem:
the guest would run an activation snippet early on to receive secret
files over raw unauthenticated TCP, blocking until it has received them.
What’s missing from this patch is the host side that actually connects
to the guest and sends this file.

I think it has the advantage of failing in case the secrets haven’t been
installed and it avoids the SSH host key bootstrapping issue.  (It has
at least the disadvantage of not being fully implemented.  :-))  Also,
longer term, it would allow us to not force password-less root
authentication in the VM.

I’m tempted to go the raw TCP way; WDYT?  We can pair-hack on it if you
feel like it!

Thanks,
Ludo’.


[-- Attachment #2: Type: text/x-patch, Size: 5886 bytes --]

modified   gnu/services/virtualization.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -804,6 +804,93 @@ given QEMU package."
 compiled for other architectures using QEMU and the @code{binfmt_misc}
 functionality of the kernel Linux.")))
 
+\f
+;;;
+;;; Secrets for guest VMs.
+;;;
+
+(define (secret-service-activation port)
+  "Return an activation snippet that fetches sensitive material at PORT, over
+TCP."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils)
+                     (rnrs io ports)
+                     (rnrs bytevectors)
+                     (ice-9 match))
+
+        (define (wait-for-client port)
+          ;; Wait for a TCP connection on PORT.  Note: We cannot use the
+          ;; virtio-serial ports, which would be safer, because they are
+          ;; (presumably) unsupported on GNU/Hurd.
+          (let ((sock (socket AF_INET SOCK_STREAM 0)))
+            (bind sock AF_INET INADDR_ANY port)
+            (listen sock 1)
+            (format (current-error-port)
+                    "waiting for secrets on port ~a...~%"
+                    port)
+            (match (accept sock)
+              ((client . address)
+               (format (current-error-port) "client connection from ~a~%"
+                       (inet-ntop (sockaddr:fam address)
+                                  (sockaddr:addr address)))
+               (close-port sock)
+               client))))
+
+        ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size'
+        ;; parameter.
+        (define (dump in out size)
+          ;; Copy SIZE bytes from IN to OUT.
+          (define buf-size 65536)
+          (define buf (make-bytevector buf-size))
+
+          (let loop ((left size))
+            (if (<= left 0)
+                0
+                (let ((read (get-bytevector-n! in buf 0 (min left buf-size))))
+                  (if (eof-object? read)
+                      left
+                      (begin
+                        (put-bytevector out buf 0 read)
+                        (loop (- left read))))))))
+
+        (define (read-secrets port)
+          ;; Read secret files from PORT and install them.
+          (match (false-if-exception (read port))
+            (('secrets ('version 0)
+                       ('files ((files sizes modes) ...)))
+             (for-each (lambda (file size mode)
+                         (format (current-error-port)
+                                 "installing file '~a' (~a bytes)...~%"
+                                 file size)
+                         (mkdir-p (dirname file))
+                         (call-with-output-file file
+                           (lambda (output)
+                             (dump port output size)
+                             (chmod file mode))))
+                       files sizes modes))
+            (_
+             (format (current-error-port)
+                     "invalid secrets received~%")
+             (sleep 3)
+             (reboot))))
+
+        (let ((port (wait-for-client #$port)))
+          (read-secrets port)
+          (close-port port))))
+
+  (computed-file "secret-service-client" install-secrets))
+
+(define secret-service-type
+  (service-type
+   (name 'secret-service)
+   (extensions (list (service-extension activation-service-type
+                                        secret-service-activation)))
+   (description
+    "This service fetches secret key and other sensitive material over TCP at
+boot time.  This service is meant to be used by virtual machines (VMs) that
+can only be accessed by their host.")))
+
 \f
 ;;;
 ;;; The Hurd in VM service: a Childhurd.
@@ -819,6 +906,8 @@ functionality of the kernel Linux.")))
                  (target "/dev/vda")
                  (timeout 0)))
     (services (cons*
+               ;; Receive secret keys on port 5900, TCP.
+               (service secret-service-type 5900)
                (service openssh-service-type
                         (openssh-configuration
                          (openssh openssh-sans-x)
modified   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)))
+                      %base-services/hurd))))
 
 %hurd-os

[bug#43106] [PATCH] DRAFT services: childhurd: Support for setting secrets.

[Jan Nieuwenhuizen]

[-- Attachment #1: Type: text/plain, Size: 5443 bytes --]

Ludovic Courtès writes:

Hi!

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>>
>> +@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
>
> Would it make sense to have a list of source/target pairs instead of a
> directory:
>
>   (("/etc/childhurd/pubkey" . "/etc/guix/signing-key.pub")
>    …)
>
> ?

We could do that...I'm not opposed to it and in fact I thought about
something like this but then opted for the file system root idea because
I didn't see the need for adding this extra indirection.  If you think
it's a good idea, sure.  Postponed that for now, though.

>> +  ;; #:use-module (ssh auth)
>> +  ;; #:use-module (ssh channel)
>> +  ;; #:use-module (ssh session)
>> +  ;; #:use-module (ssh sftp)
>> +
>> +  #:autoload (ssh auth) (userauth-password!)
>
> You could add the file to MODULES_NOT_COMPILED in gnu/local.mk to avoid
> the autoload dance.

Ah, right, thanks, good to know.  Following another path now, so I'm
leaving this for a bit.

>> +(define* (hurd-vm-copy-secrets port secret-root #:key (retry 20))
>> +  "Copy all files under SECRET-ROOT using ssh to childhurd at local PORT."
>> +  (format (current-error-port) "hurd-vm-copy-secrets\n")
>> +  (let ((session (make-session #:host "127.0.0.1" #:port port
>> +                               #:user "root")))
>
> I just realized that we have a bootstrapping issue here: we have to
> explicitly skip SSH host authentication because we haven’t installed the
> host keys yet.

Right!  Hmm...

> The boot sequence of the guest is actually: generate SSH host keys,
> start sshd, receive host keys over SFTP.
>
> [...]
>
>> -      (start #~(make-forkexec-constructor #$vm-command))
>> +      (requirement '(loopback networking user-processes))
>> +      (start
>> +       (with-imported-modules (source-module-closure '((gnu build childhurd)
>> +                                                       (guix build utils)))
>> +        (with-extensions (list guile-ssh)
>> +          #~(let ((spawn (make-forkexec-constructor #$vm-command)))
>> +              (use-modules (gnu build childhurd))
>
> We should use the ‘modules’ field of <shepherd-service> instead of a
> non-top-level ‘use-modules’.

OK, done.

>> +              (lambda _
>> +                (let ((pid (spawn))
>> +                      (port #$(hurd-vm-port config %hurd-vm-ssh-port))
>> +                      (root #$(hurd-vm-configuration-secret-root config)))
>> +                  (when (and root (directory-exists? root))
>> +                    (catch #t
>> +                      (lambda _
>> +                        (hurd-vm-copy-secrets port root))
>> +                      (lambda (key . args)
>> +                        (format (current-error-port) "childhurd: ~a ~s\n" key args))))
>
> To avoid race conditions, we probably have to wait until PORT becomes
> available, no?  Also, the VM boots even if we’ve failed to inject the
> secrets, right?

Yes on both...that's a problem.

> As discussed on IRC, attached is my attempt at addressing this problem:
> the guest would run an activation snippet early on to receive secret
> files over raw unauthenticated TCP, blocking until it has received them.
> What’s missing from this patch is the host side that actually connects
> to the guest and sends this file.

Okay.

> I think it has the advantage of failing in case the secrets haven’t been
> installed and it avoids the SSH host key bootstrapping issue.  (It has
> at least the disadvantage of not being fully implemented.  :-))  Also,
> longer term, it would allow us to not force password-less root
> authentication in the VM.
>
> I’m tempted to go the raw TCP way; WDYT?  We can pair-hack on it if you
> feel like it!

That would be great.  I'm attaching a new iteration of our combined
work

Using client.scm:

--8<---------------cut here---------------start------------->8---
(use-modules (gnu build secret-service))

(hurd-vm-secret-service-copy-secrets 5999 "/home/janneke/var/geert/childhurd")
--8<---------------cut here---------------end--------------->8---

and (cutting the body of secret-service-activation to) server.scm:

--8<---------------cut here---------------start------------->8---
(use-modules (ice-9 match)
             (guix build utils)
             (rnrs bytevectors)
             (ice-9 binary-ports))

[...]
(define (wait-for-client port)
(let ((port (wait-for-client 5999)))
  (read-secrets port)
  (close-port port))
--8<---------------cut here---------------end--------------->8---

this actually copies files...However, the secret-service does not build:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix system disk-image gnu/system/examples/bare-hurd.tmpl
guix system: error: reference to invalid output 'out' of derivation '/gnu/store/189x9ph3piyihbs6asnjkinc5qqwfw1h-secret-service-client.drv'
[1]22:40:08 janneke@dundal:~/src/guix/master [env]
--8<---------------cut here---------------end--------------->8---

...it seems we're missing something obvious.

Thanks,
Janneke


[-- Attachment #2: v2-0001-DRAFT-services-Add-secret-service-type.patch --]
[-- Type: text/x-patch, Size: 16933 bytes --]

From 7c2523a6b25ec28539d3476bdc57d29db85bcbae Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Sat, 29 Aug 2020 23:14:59 +0200
Subject: [PATCH v2] DRAFT services: Add secret-service-type.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=UTF-8

TODO:

$ ./pre-inst-env guix system disk-image gnu/system/examples/bare-hurd.tmpl
guix system: error: reference to invalid output 'out' of derivation '/gnu/store/189x9ph3piyihbs6asnjkinc5qqwfw1h-secret-service-client.drv'

* split in two?
* switch ownership/co-authorship?

co-authored-by: Ludovic Courtès <ludo@gnu.org>

* gnu/build/secret-service.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* gnu/services/virtualization.scm (hurd-vm-shepherd-service): Use it to copy
secrets.
(hurd-vm-port): New function.
(hurd-vm-net-options): Use it.
(secret-service-activation): New procedure.
(secret-service-type): New variable.
(%hurd-vm-operating-system): Add it.
* gnu/system/examples/bare-hurd.tmpl (%hurd-os): Add it.
* doc/guix.texi (The Hurd in a Virtual Machine): Document it.
---
 doc/guix.texi                      |  19 ++++
 gnu/build/secret-service.scm       |  68 +++++++++++++
 gnu/local.mk                       |   1 +
 gnu/services/virtualization.scm    | 151 ++++++++++++++++++++++++++---
 gnu/system/examples/bare-hurd.tmpl |  20 ++--
 5 files changed, 238 insertions(+), 21 deletions(-)
 create mode 100644 gnu/build/secret-service.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 6206a93857..f8e03242b2 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
@@ -25200,6 +25201,24 @@ with forwarded ports
 <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 injected 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/build/secret-service.scm b/gnu/build/secret-service.scm
new file mode 100644
index 0000000000..fc817f8c5c
--- /dev/null
+++ b/gnu/build/secret-service.scm
@@ -0,0 +1,68 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build secret-service)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 rdelim)
+  #:use-module (guix build utils)
+
+  #:export (hurd-vm-secret-service-copy-secrets))
+
+;;; Commentary:
+;;;
+;;; Utility procedures for copying secrets into a VM.
+;;;
+;;; Code:
+
+(define* (hurd-vm-secret-service-copy-secrets port secret-root #:key (retry 20))
+  "Copy all files under SECRET-ROOT using TCP to secret-service listening at
+local PORT."
+
+  (define (file->file+size+mode file-name)
+    (let ((stat (stat file-name))
+          (target (substring file-name (string-length secret-root))))
+      (list target (stat:size stat) (stat:mode stat))))
+
+  (format (current-error-port) "hurd-vm-secret-service-copy-secrets\n")
+
+  (let ((sock (socket AF_INET SOCK_STREAM 0))
+        (addr (make-socket-address AF_INET INADDR_LOOPBACK port)))
+    ;; connect to wait for port
+    (let loop ((retry retry))
+      (if (zero? retry)
+          (error "connecting to childhurd failed")
+          (catch 'system-error
+            (lambda _
+              (connect sock addr))
+            (lambda (key . args)
+              (format (current-error-port) "connect failed: ~a ~s\n" key args)
+              (sleep 1)
+              (loop (1- retry))))))
+    (format (current-error-port) "connected!\n")
+    ;; copy tree
+    (let* ((files (find-files secret-root))
+           (files-sizes-modes (map file->file+size+mode files))
+           (secrets `(secrets
+                      (version 0)
+                      (files ,files-sizes-modes))))
+      (write secrets sock)
+      (for-each (compose (cute display <> sock)
+                         (cute with-input-from-file <> read-string))
+                files))))
+
+;;; secret-service.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 8854698178..1d8022fd11 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -659,6 +659,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-initrd.scm			\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
+  %D%/build/secret-service.scm			\
   %D%/build/vm.scm				\
 						\
   %D%/tests.scm					\
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index b93ed70099..aa9b06f74b 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -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)
@@ -48,6 +49,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 match)
 
   #:export (%hurd-vm-operating-system
@@ -61,7 +63,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
 
@@ -804,6 +809,94 @@ given QEMU package."
 compiled for other architectures using QEMU and the @code{binfmt_misc}
 functionality of the kernel Linux.")))
 
+\f
+;;;
+;;; Secrets for guest VMs.
+;;;
+
+(define (secret-service-activation port)
+  "Return an activation snippet that fetches sensitive material at PORT, over
+TCP."
+  (define install-secrets
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (rnrs io ports)
+                       (rnrs bytevectors)
+                       (ice-9 match))
+
+          (define (wait-for-client port)
+            ;; Wait for a TCP connection on PORT.  Note: We cannot use the
+            ;; virtio-serial ports, which would be safer, because they are
+            ;; (presumably) unsupported on GNU/Hurd.
+            (let ((sock (socket AF_INET SOCK_STREAM 0)))
+              (bind sock AF_INET INADDR_ANY port)
+              (listen sock 1)
+              (format (current-error-port)
+                      "waiting for secrets on port ~a...~%"
+                      port)
+              (match (accept sock)
+                ((client . address)
+                 (format (current-error-port) "client connection from ~a~%"
+                         (inet-ntop (sockaddr:fam address)
+                                    (sockaddr:addr address)))
+                 (close-port sock)
+                 client))))
+
+          ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size'
+          ;; parameter.
+          (define (dump in out size)
+            ;; Copy SIZE bytes from IN to OUT.
+            (define buf-size 65536)
+            (define buf (make-bytevector buf-size))
+
+            (let loop ((left size))
+              (if (<= left 0)
+                  0
+                  (let ((read (get-bytevector-n! in buf 0 (min left buf-size))))
+                    (if (eof-object? read)
+                        left
+                        (begin
+                          (put-bytevector out buf 0 read)
+                          (loop (- left read))))))))
+
+          (define (read-secrets port)
+            ;; Read secret files from PORT and install them.
+            (match (false-if-exception (read port))
+              (('secrets ('version 0)
+                         ('files ((files sizes modes) ...)))
+               (for-each (lambda (file size mode)
+                           (format (current-error-port)
+                                   "installing file '~a' (~a bytes)...~%"
+                                   file size)
+                           (mkdir-p (dirname file))
+                           (call-with-output-file file
+                             (lambda (output)
+                               (dump port output size)
+                               (chmod file mode))))
+                         files sizes modes))
+              (_
+               (format (current-error-port)
+                       "invalid secrets received~%")
+               (sleep 3)
+               (reboot))))
+
+          (let ((port (wait-for-client #$port)))
+            (read-secrets port)
+            (close-port port)))))
+
+  (computed-file "secret-service-client" install-secrets))
+
+(define secret-service-type
+  (service-type
+   (name 'secret-service)
+   (extensions (list (service-extension activation-service-type
+                                        secret-service-activation)))
+   (description
+    "This service fetches secret key and other sensitive material over TCP at
+boot time.  This service is meant to be used by virtual machines (VMs) that
+can only be accessed by their host.")))
+
 \f
 ;;;
 ;;; The Hurd in VM service: a Childhurd.
@@ -819,6 +912,8 @@ functionality of the kernel Linux.")))
                  (target "/dev/vda")
                  (timeout 0)))
     (services (cons*
+               ;; Receive secret keys on port 5999, TCP.
+               (service secret-service-type 5999)
                (service openssh-service-type
                         (openssh-configuration
                          (openssh openssh-sans-x)
@@ -849,7 +944,9 @@ functionality of the kernel Linux.")))
                (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."
@@ -861,15 +958,27 @@ functionality of the kernel Linux.")))
       (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 15999)
+(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))
+                    "-:5999"
+                    ",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."
@@ -900,8 +1009,26 @@ functionality of the kernel Linux.")))
                             (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)))
+        (with-extensions (list guile-ssh)
+          #~(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)))
+                  (when (and root (directory-exists? root))
+                    (catch #t
+                      (lambda _
+                        (hurd-vm-secret-service-copy-secrets port root))
+                      (lambda (key . args)
+                        (format (current-error-port) "childhurd: ~a ~s\n" key args))))
+                  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


[-- Attachment #3: Type: text/plain, Size: 152 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#43106] [PATCH v3 0/2] Secret services for the Childhurd

[Jan (janneke) Nieuwenhuizen]

Jan Nieuwenhuizen writes:

Hello,

As discussed on IRC, version 3 follows.

> Ludovic Courtès writes:
>> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>>>
>>> +@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
>>
>> Would it make sense to have a list of source/target pairs instead of a
>> directory:
>>
>>   (("/etc/childhurd/pubkey" . "/etc/guix/signing-key.pub")
>>    …)
>>
>> ?
>
> We could do that...I'm not opposed to it and in fact I thought about
> something like this but then opted for the file system root idea because
> I didn't see the need for adding this extra indirection.  If you think
> it's a good idea, sure.  Postponed that for now, though.

[this still open]

Also, I think 5900 is a bad idea, qemu opens a server there.  We could
use ports 2222 (forwarded to 12222), as SSH only starts later -- but
hmm.  As this is all running as root anyway, I opted for 1004 (MI5).

Greetings,
Janneke

Jan (janneke) Nieuwenhuizen (2):
  services: Add secret-service-type.
  services: childhurd: Support installing secrets from the host.

 doc/guix.texi                      |  21 +++++
 gnu/build/secret-service.scm       | 138 +++++++++++++++++++++++++++++
 gnu/local.mk                       |   1 +
 gnu/services/virtualization.scm    |  92 ++++++++++++++++---
 gnu/system/examples/bare-hurd.tmpl |  20 +++--
 5 files changed, 251 insertions(+), 21 deletions(-)
 create mode 100644 gnu/build/secret-service.scm

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#43106] [PATCH v3 1/2] services: Add secret-service-type.

[Jan (janneke) Nieuwenhuizen]

This adds a "secret-service" that can be added to a Childhurd VM to receive
out-of-band secrets (keys) sent from the host.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>

* gnu/services/virtualization.scm (secret-service-activation): New procedure.
(secret-service-type): New variable.
* gnu/build/secret-service.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/build/secret-service.scm    | 138 ++++++++++++++++++++++++++++++++
 gnu/local.mk                    |   1 +
 gnu/services/virtualization.scm |  29 ++++++-
 3 files changed, 167 insertions(+), 1 deletion(-)
 create mode 100644 gnu/build/secret-service.scm

diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
new file mode 100644
index 0000000000..aa88f8c209
--- /dev/null
+++ b/gnu/build/secret-service.scm
@@ -0,0 +1,138 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build secret-service)
+  #:use-module (guix build utils)
+
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+
+  #:export (secret-service-receive-secrets
+            secret-service-send-secrets))
+
+;;; Commentary:
+;;;
+;;; Utility procedures for copying secrets into a VM.
+;;;
+;;; Code:
+
+(define* (secret-service-send-secrets port secret-root #:key (retry 60))
+  "Copy all files under SECRET-ROOT using TCP to secret-service listening at
+local PORT."
+
+  (define (file->file+size+mode file-name)
+    (let ((stat (stat file-name))
+          (target (substring file-name (string-length secret-root))))
+      (list target (stat:size stat) (stat:mode stat))))
+
+  (format (current-error-port) "secret-service-send-secrets\n")
+
+  (let ((sock (socket AF_INET SOCK_STREAM 0))
+        (addr (make-socket-address AF_INET INADDR_LOOPBACK port)))
+    ;; connect to wait for port
+    (let loop ((retry retry))
+      (if (zero? retry)
+          (error "connecting to childhurd failed")
+          (catch 'system-error
+            (lambda _
+              (connect sock addr))
+            (lambda (key . args)
+              (format (current-error-port) "connect failed: ~a ~s\n" key args)
+              (sleep 1)
+              (loop (1- retry))))))
+    (format (current-error-port) "connected!\n")
+    ;; copy tree
+    (let* ((files (if secret-root (find-files secret-root) '()))
+           (files-sizes-modes (map file->file+size+mode files))
+           (secrets `(secrets
+                      (version 0)
+                      (files ,files-sizes-modes))))
+      (write secrets sock)
+      (for-each (compose (cute display <> sock)
+                         (cute with-input-from-file <> read-string))
+                files))))
+
+(define (secret-service-receive-secrets port)
+  "Listen to local PORT and wait for a secret service client to send secrets.
+Write them to the file system."
+
+  (define (wait-for-client port)
+    ;; Wait for a TCP connection on PORT.  Note: We cannot use the
+    ;; virtio-serial ports, which would be safer, because they are
+    ;; (presumably) unsupported on GNU/Hurd.
+    (let ((sock (socket AF_INET SOCK_STREAM 0)))
+      (bind sock AF_INET INADDR_ANY port)
+      (listen sock 1)
+      (format (current-error-port)
+              "waiting for secrets on port ~a...~%"
+              port)
+      (match (accept sock)
+        ((client . address)
+         (format (current-error-port) "client connection from ~a~%"
+                 (inet-ntop (sockaddr:fam address)
+                            (sockaddr:addr address)))
+         (close-port sock)
+         client))))
+
+  ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size'
+  ;; parameter.
+  (define (dump in out size)
+    ;; Copy SIZE bytes from IN to OUT.
+    (define buf-size 65536)
+    (define buf (make-bytevector buf-size))
+
+    (let loop ((left size))
+      (if (<= left 0)
+          0
+          (let ((read (get-bytevector-n! in buf 0 (min left buf-size))))
+            (if (eof-object? read)
+                left
+                (begin
+                  (put-bytevector out buf 0 read)
+                  (loop (- left read))))))))
+
+  (define (read-secrets port)
+    ;; Read secret files from PORT and install them.
+    (match (false-if-exception (read port))
+      (('secrets ('version 0)
+                 ('files ((files sizes modes) ...)))
+       (for-each (lambda (file size mode)
+                   (format (current-error-port)
+                           "installing file '~a' (~a bytes)...~%"
+                           file size)
+                   (mkdir-p (dirname file))
+                   (call-with-output-file file
+                     (lambda (output)
+                       (dump port output size)
+                       (chmod file mode))))
+                 files sizes modes))
+      (_
+       (format (current-error-port)
+               "invalid secrets received~%")
+       #f)))
+
+  (let* ((port (wait-for-client port))
+         (result (read-secrets port)))
+    (close-port port)
+    result))
+
+;;; secret-service.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 8854698178..1d8022fd11 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -659,6 +659,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-initrd.scm			\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
+  %D%/build/secret-service.scm			\
   %D%/build/vm.scm				\
 						\
   %D%/tests.scm					\
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index b93ed70099..6d6734dcd1 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -804,6 +804,33 @@ given QEMU package."
 compiled for other architectures using QEMU and the @code{binfmt_misc}
 functionality of the kernel Linux.")))
 
+\f
+;;;
+;;; Secrets for guest VMs.
+;;;
+
+(define (secret-service-activation port)
+  "Return an activation snippet that fetches sensitive material at local PORT,
+over TCP.  Reboot upon failure."
+  (with-imported-modules '((gnu build secret-service)
+                           (guix build utils))
+    #~(begin
+        (use-modules (gnu build secret-service))
+        (let ((sent (secret-service-receive-secrets #$port)))
+          (unless sent
+            (sleep 3)
+            (reboot))))))
+
+(define secret-service-type
+  (service-type
+   (name 'secret-service)
+   (extensions (list (service-extension activation-service-type
+                                        secret-service-activation)))
+   (description
+    "This service fetches secret key and other sensitive material over TCP at
+boot time.  This service is meant to be used by virtual machines (VMs) that
+can only be accessed by their host.")))
+
 \f
 ;;;
 ;;; The Hurd in VM service: a Childhurd.
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#43106] [PATCH v3 1/2] services: Add secret-service-type.

[Ludovic Courtès]

Hi!

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> This adds a "secret-service" that can be added to a Childhurd VM to receive
> out-of-band secrets (keys) sent from the host.
>
> Co-authored-by: Ludovic Courtès <ludo@gnu.org>
>
> * gnu/services/virtualization.scm (secret-service-activation): New procedure.
> (secret-service-type): New variable.
> * gnu/build/secret-service.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Very nice!  Minor suggestions:

> +  (format (current-error-port) "secret-service-send-secrets\n")

Perhaps write “sending secrets to ~a:~a...~%” or similar.

> +  (let ((sock (socket AF_INET SOCK_STREAM 0))
> +        (addr (make-socket-address AF_INET INADDR_LOOPBACK port)))
> +    ;; connect to wait for port
> +    (let loop ((retry retry))
> +      (if (zero? retry)
> +          (error "connecting to childhurd failed")

s/childhurd/secret server/

> +          (catch 'system-error
> +            (lambda _
> +              (connect sock addr))
> +            (lambda (key . args)
> +              (format (current-error-port) "connect failed: ~a ~s\n" key args)

Perhaps remove print “retrying connection” (or similar), and re-throw
the exception when RETRY is zero, so that it goes through as is (and
thus you can remove the call to ‘error’ above.)

> +    ;; copy tree
> +    (let* ((files (if secret-root (find-files secret-root) '()))
> +           (files-sizes-modes (map file->file+size+mode files))
> +           (secrets `(secrets
> +                      (version 0)
> +                      (files ,files-sizes-modes))))
> +      (write secrets sock)
> +      (for-each (compose (cute display <> sock)
> +                         (cute with-input-from-file <> read-string))

Instead of loading it all in memory, we can use ‘dump-port’ from (guix
build utils) here.

That’s it!

Ludo’.

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

[Jan (janneke) Nieuwenhuizen]

* 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

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

[Jan Nieuwenhuizen]

Jan (janneke) Nieuwenhuizen writes:

> * 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.

[..]

> 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

[..]
> +                        (kill pid)

Oops; (kill pid SIGTERM) or something

> 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 @@

[..]

> +                            (service (@@ (gnu services virtualization)
> +                                         secret-service-type) 5999))

Oops, should be 1004.

Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

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

[Ludovic Courtès]

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> * 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.

Yay, minor issues, but overall LGTM!\

>      (services (cons*
> +               ;; Receive secret keys on port 1004, TCP.
> +               (service secret-service-type 1004)


[...]

> +      (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))

Perhaps ‘hurd-vm-service-type’ should unconditionally extend (via
‘service-extension’) ‘secret-service-type’, just to ensure that Hurd VMs
always include the secret service.

In any case, we should assume that the VM is always running the secret
service server, and thus call ‘secret-service-send-secrets’
unconditionally (‘secret-service-send-secrets’ does (find-files root),
which returns the empty list when ROOT doesn’t exist, I think.)

> +                      (lambda (keys . args)

Should be “key” (singular).

> +                        (format (current-error-port)
> +                                "failed to send secrets: ~a ~s\n" key args)
> +                        (kill pid)

(kill (- pid)) to kill the whole process group (just in case).

I’d remove the ‘format’ call and just re-throw the exception: shepherd
should report it correctly.

[...]

> +                            (service (@@ (gnu services virtualization)
> +                                         secret-service-type) 5999))

This is useful for testing but I wouldn’t commit it (in particular
because the example would no longer work for people who’re just spawning
the VM and not trying to feed it secrets over TCP).

That’s it, thanks a lot!

Ludo’.

[bug#43106] [PATCH v3 0/2] Secret services for the Childhurd

[Ludovic Courtès]

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> Also, I think 5900 is a bad idea, qemu opens a server there. 

Oops, my bad!

> We could use ports 2222 (forwarded to 12222), as SSH only starts later
> -- but hmm.  As this is all running as root anyway, I opted for 1004
> (MI5).

Did you mean MI6?  But then, why 1004?  Just because we can’t use 007?

Curious!

Ludo’.

[bug#43106] [PATCH v3 0/2] Secret services for the Childhurd

[Jan Nieuwenhuizen]

Ludovic Courtès writes:

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>
>> Also, I think 5900 is a bad idea, qemu opens a server there. 
>
> Oops, my bad!
>
>> We could use ports 2222 (forwarded to 12222), as SSH only starts later
>> -- but hmm.  As this is all running as root anyway, I opted for 1004
>> (MI5).
>
> Did you mean MI6?

Hmm, (checks the interwebs) yeah, Mi6.  Then the joke is really
too far-fetched, because

> But then, why 1004?

I was thinking MI5 ~> MIV => (roman numerals) 1004.  But that doesn't
really work with "6" :-(

> Just because we can’t use 007?

Yeah, that too.  Also, how to pick an arbitrary number?  Anyway, it's'
1004 now, feel free to suggest something else :-)

Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

[bug#43106] [PATCH v3 0/2] Secret services for the Childhurd

[Ludovic Courtès]

Jan Nieuwenhuizen <janneke@gnu.org> skribis:

> Ludovic Courtès writes:
>
>> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>>
>>> Also, I think 5900 is a bad idea, qemu opens a server there. 
>>
>> Oops, my bad!
>>
>>> We could use ports 2222 (forwarded to 12222), as SSH only starts later
>>> -- but hmm.  As this is all running as root anyway, I opted for 1004
>>> (MI5).
>>
>> Did you mean MI6?
>
> Hmm, (checks the interwebs) yeah, Mi6.  Then the joke is really
> too far-fetched, because
>
>> But then, why 1004?
>
> I was thinking MI5 ~> MIV => (roman numerals) 1004.  But that doesn't
> really work with "6" :-(

Oooh, brilliant!

>> Just because we can’t use 007?
>
> Yeah, that too.  Also, how to pick an arbitrary number?  Anyway, it's'
> 1004 now, feel free to suggest something else :-)

1004 is perfect, we have a good story to back it up!  (And it’s not in
/etc/services, which makes it even better.)

Ludo’.

[bug#43106] [PATCH v3 1/2] services: Add secret-service-type.

[Jan Nieuwenhuizen]

Ludovic Courtès writes:

Hello,

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>
>> This adds a "secret-service" that can be added to a Childhurd VM to receive
>> out-of-band secrets (keys) sent from the host.
>>
>> Co-authored-by: Ludovic Courtès <ludo@gnu.org>
>>
>> * gnu/services/virtualization.scm (secret-service-activation): New procedure.
>> (secret-service-type): New variable.
>> * gnu/build/secret-service.scm: New file.
>> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
>
> Very nice!  Minor suggestions:

Great!

>> +  (format (current-error-port) "secret-service-send-secrets\n")
>
> Perhaps write “sending secrets to ~a:~a...~%” or similar.

Ok.

>> +  (let ((sock (socket AF_INET SOCK_STREAM 0))
>> +        (addr (make-socket-address AF_INET INADDR_LOOPBACK port)))
>> +    ;; connect to wait for port
>> +    (let loop ((retry retry))
>> +      (if (zero? retry)
>> +          (error "connecting to childhurd failed")
>
> s/childhurd/secret server/

Ah, sure.

>> +          (catch 'system-error
>> +            (lambda _
>> +              (connect sock addr))
>> +            (lambda (key . args)
>> +              (format (current-error-port) "connect failed: ~a ~s\n" key args)
>
> Perhaps remove print “retrying connection” (or similar), and re-throw
> the exception when RETRY is zero, so that it goes through as is (and
> thus you can remove the call to ‘error’ above.)

Ah yes, changed it to

      (catch 'system-error
        (cut connect sock addr)
        (lambda (key . args)
          (when (zero? retry)
            (apply throw key args))
          (format (current-error-port) "retrying connection~%")
          (sleep 1)
          (loop (1- retry)))))

>> +    ;; copy tree
>> +    (let* ((files (if secret-root (find-files secret-root) '()))
>> +           (files-sizes-modes (map file->file+size+mode files))
>> +           (secrets `(secrets
>> +                      (version 0)
>> +                      (files ,files-sizes-modes))))
>> +      (write secrets sock)
>> +      (for-each (compose (cute display <> sock)
>> +                         (cute with-input-from-file <> read-string))
>
> Instead of loading it all in memory, we can use ‘dump-port’ from (guix
> build utils) here.

Nice, changed to

      (for-each (compose (cute dump-port <> sock)
                         (cute open-input-file <>))
                files))))

> That’s it!

Thanks for your suggestions,
Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

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

[Jan Nieuwenhuizen]

Ludovic Courtès writes:

> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:
>
>> * 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.
>
> Yay, minor issues, but overall LGTM!

\o/

>>      (services (cons*
>> +               ;; Receive secret keys on port 1004, TCP.
>> +               (service secret-service-type 1004)
>
>
> [...]
>
>> +      (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))

> In any case, we should assume that the VM is always running the secret
> service server, and thus call ‘secret-service-send-secrets’
> unconditionally (‘secret-service-send-secrets’ does (find-files root),
> which returns the empty list when ROOT doesn’t exist,

Yeah I was struggling a bit with this; the hurd-vm-service and the
childhurd must agree on the usage of secret-service.  That's why I came
up with this root-dir #f switch...but it's certainly simpler if we say
that it must always be there.  Let's see if we can get away with that!

So, I removed the root-dir checks and we always call
'secret-service-send-secrets', and changed the default from #f to

  (secret-root hurd-vm-configuration-secret-root        ;string
               (default "/etc/childhurd")))

where "/etc/childhurd" does not need to exist.

> Perhaps ‘hurd-vm-service-type’ should unconditionally extend (via
> ‘service-extension’) ‘secret-service-type’, just to ensure that Hurd VMs
> always include the secret service.

Eh, hurd-vm-service lives in the host, the secret-services lives in the
client; am I missing something?  ;-)

We could add a check for secret-service, possibly here

    (define (hurd-vm-disk-image config)
      "Return a disk-image for the Hurd according to CONFIG."
      (let ((os (hurd-vm-configuration-os config))
            (disk-size (hurd-vm-configuration-disk-size config)))
        (system-image
         (image
          (inherit hurd-disk-image)
          (size disk-size)
          (operating-system os)))))

and/or insert if it it's missing...seems a bit over the top to me?

> I think.)

Yes, it does, but then the default cannot be #f, it must be a string.
I'm picking "/etc/childurd" as a default that need not exist.

>> +                      (lambda (keys . args)
>
> Should be “key” (singular).

Oops :-)

>> +                        (format (current-error-port)
>> +                                "failed to send secrets: ~a ~s\n" key args)
>> +                        (kill pid)
>
> (kill (- pid)) to kill the whole process group (just in case).
>
> I’d remove the ‘format’ call and just re-throw the exception: shepherd
> should report it correctly.

Done!  Changed to unconditionally run

               (catch #t
                 (lambda _
                   (secret-service-send-secrets port root))
                 (lambda (key . args)
                   (kill (- pid) SIGTERM)
                   (apply throw key args)))
               pid)))))

>> +                            (service (@@ (gnu services virtualization)
>> +                                         secret-service-type) 5999))
>
> This is useful for testing but I wouldn’t commit it (in particular
> because the example would no longer work for people who’re just spawning
> the VM and not trying to feed it secrets over TCP).

Right, removed.

> That’s it, thanks a lot!

You too!
Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

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

[Jan Nieuwenhuizen]

Jan Nieuwenhuizen writes:

> Ludovic Courtès writes:
>
>> "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> Eh, hurd-vm-service lives in the host, the secret-services lives in the
> client; am I missing something?  ;-)
>
> We could add a check for secret-service, possibly here
[..]

After aligning on IRC we decided this can be done later; pushed to
master as 01cefb7a570d846476ff5cb05d3b1e3511db5d81, closing.

Janneke

-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

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

[Ludovic Courtès]

Hi!

Jan Nieuwenhuizen <janneke@gnu.org> skribis:

> Ludovic Courtès writes:

[...]

>> Perhaps ‘hurd-vm-service-type’ should unconditionally extend (via
>> ‘service-extension’) ‘secret-service-type’, just to ensure that Hurd VMs
>> always include the secret service.
>
> Eh, hurd-vm-service lives in the host, the secret-services lives in the
> client; am I missing something?  ;-)

Ah no, it’s me.  :-)

> We could add a check for secret-service, possibly here
>
>     (define (hurd-vm-disk-image config)
>       "Return a disk-image for the Hurd according to CONFIG."
>       (let ((os (hurd-vm-configuration-os config))
>             (disk-size (hurd-vm-configuration-disk-size config)))
>         (system-image
>          (image
>           (inherit hurd-disk-image)
>           (size disk-size)
>           (operating-system os)))))
>
> and/or insert if it it's missing...seems a bit over the top to me?

Yes, exactly.  We could pass ‘os’ through
‘secret-service-operating-system’, where:

  (define (secret-service-operating-system os)
    (operating-system
      (inherit os)
      (services (cons (service secret-service-type)
                      (operating-system-user-services os)))))

(A similar pattern is found in ‘virtualized-operating-system’ and
‘containerized-operating-system’.)

Thanks for these patches!

Ludo’.

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

[Jan Nieuwenhuizen]

[-- Attachment #1: Type: text/plain, Size: 1243 bytes --]

Ludovic Courtès writes:

Hello!

> Jan Nieuwenhuizen <janneke@gnu.org> skribis:
>
>> Ludovic Courtès writes:
>
> [...]
>
>> We could add a check for secret-service, possibly here
>>
>>     (define (hurd-vm-disk-image config)
>>       "Return a disk-image for the Hurd according to CONFIG."
>>       (let ((os (hurd-vm-configuration-os config))
>>             (disk-size (hurd-vm-configuration-disk-size config)))
>>         (system-image
>>          (image
>>           (inherit hurd-disk-image)
>>           (size disk-size)
>>           (operating-system os)))))
>>
>> and/or insert if it it's missing...seems a bit over the top to me?
>
> Yes, exactly.  We could pass ‘os’ through
> ‘secret-service-operating-system’, where:
>
>   (define (secret-service-operating-system os)
>     (operating-system
>       (inherit os)
>       (services (cons (service secret-service-type)
>                       (operating-system-user-services os)))))
>
> (A similar pattern is found in ‘virtualized-operating-system’ and
> ‘containerized-operating-system’.)

Right, that's nice.  I've added this (attached commit) to master.

> Thanks for these patches!

Happy; thanks for helping!
Janneke


[-- Attachment #2: 0001-services-hurd-vm-Have-Childhurd-always-include-the-s.patch --]
[-- Type: text/x-patch, Size: 2724 bytes --]

From f07f479fc7417574c7bcb7ab3b70becda72eae25 Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Wed, 2 Sep 2020 07:13:15 +0200
Subject: [PATCH] services: hurd-vm: Have Childhurd always include the
 secret-service.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=UTF-8

* gnu/services/virtualization.scm (secret-service-operating-system): New
procedure.
(hurd-vm-disk-image): Use it to ensure a Childhurd always includes the
secret-service.
(%hurd-vm-operating-system): Remove secret-service.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/services/virtualization.scm | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 75fe203e15..20e104f48c 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -835,6 +835,14 @@ over TCP.  Reboot upon failure."
 boot time.  This service is meant to be used by virtual machines (VMs) that
 can only be accessed by their host.")))
 
+(define (secret-service-operating-system os)
+  "Return an operating system based on OS that includes the secret-service,
+that will be listening to receive secret keys on port 1004, TCP."
+  (operating-system
+    (inherit os)
+    (services (cons (service secret-service-type 1004)
+                    (operating-system-user-services os)))))
+
 \f
 ;;;
 ;;; The Hurd in VM service: a Childhurd.
@@ -850,8 +858,6 @@ 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)
@@ -887,8 +893,9 @@ can only be accessed by their host.")))
                (default "/etc/childhurd")))
 
 (define (hurd-vm-disk-image config)
-  "Return a disk-image for the Hurd according to CONFIG."
-  (let ((os (hurd-vm-configuration-os 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)))
         (disk-size (hurd-vm-configuration-disk-size config)))
     (system-image
      (image
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com


[-- Attachment #3: Type: text/plain, Size: 152 bytes --]


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com