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.")))
 
+
+;;;
+;;; 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.")))
+
 
 ;;;
 ;;; 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

