modified gnu/services/virtualization.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe -;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018, 2020 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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