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
@@ -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
new file mode 100644
@@ -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
@@ -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 \
@@ -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.")))
+
+;;;
+;;; 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.")))
+
;;;
;;; 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
@@ -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