me
/
guix
Archived
1
0
Fork 0
Code

services: secret-service: Make the endpoint configurable. 

Until now, the secret service had a hard-coded TCP endpoint on port
1004.  This change lets users specify arbitrary socket addresses.

* gnu/build/secret-service.scm (socket-address->string): New procedure,
taken from Shepherd.
(secret-service-send-secrets): Replace ‘port’ by ‘address’ and adjust
accordingly.
(secret-service-receive-secrets): Likewise.
* gnu/services/virtualization.scm (secret-service-shepherd-services):
Likewise.
(secret-service-operating-system): Add optional ‘address’ parameter and
honor it.  Adjust ‘start’ method accordingly.

Change-Id: I87a9514f1c170dca756ce76083d7182c6ebf6578
master
Ludovic Courtès 2023-12-20 10:36:25 +01:00
parent 11d5b505e5
commit f331a667d3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 63 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
gnu/build/secret-service.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -93,13 +93,28 @@ Return #t in the former case and #f in the latter case."
('readable #t) ('readable #t)
('timeout #f))))))) ('timeout #f)))))))
(define* (secret-service-send-secrets port secret-root (define (socket-address->string address)
"Return a human-readable representation of ADDRESS, an object as returned by
'make-socket-address'."
(let ((family (sockaddr:fam address)))
(cond ((= AF_INET family)
(string-append (inet-ntop AF_INET (sockaddr:addr address))
":" (number->string (sockaddr:port address))))
((= AF_INET6 family)
(string-append "[" (inet-ntop AF_INET6 (sockaddr:addr address)) "]"
":" (number->string (sockaddr:port address))))
((= AF_UNIX family)
(sockaddr:path address))
(else
(object->string address)))))
(define* (secret-service-send-secrets address secret-root
#:key (retry 60) #:key (retry 60)
(handshake-timeout 180)) (handshake-timeout 180))
"Copy all files under SECRET-ROOT using TCP to secret-service listening at "Copy all files under SECRET-ROOT by connecting to secret-service listening
local PORT. If connect fails, sleep 1s and retry RETRY times; once connected, at ADDRESS, an address as returned by 'make-socket-address'. If connection
wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return fails, sleep 1s and retry RETRY times; once connected, wait for at most
#f on failure." HANDSHAKE-TIMEOUT seconds for handshake to complete. Return #f on failure."
(define (file->file+size+mode file-name) (define (file->file+size+mode file-name)
(let ((stat (stat file-name)) (let ((stat (stat file-name))
(target (substring file-name (string-length secret-root)))) (target (substring file-name (string-length secret-root))))
@ -118,9 +133,9 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(dump-port input sock)))) (dump-port input sock))))
files))) files)))
(log "sending secrets to ~a~%" port) (log "sending secrets to ~a~%" (socket-address->string address))
(let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0)) (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK port))
(sleep (if (resolve-module '(fibers) #f) (sleep (if (resolve-module '(fibers) #f)
(module-ref (resolve-interface '(fibers)) 'sleep) (module-ref (resolve-interface '(fibers)) 'sleep)
sleep))) sleep)))
@ -129,7 +144,7 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
;; forward port inside the guest. ;; forward port inside the guest.
(let loop ((retry retry)) (let loop ((retry retry))
(catch 'system-error (catch 'system-error
(cute connect sock addr) (cute connect sock address)
(lambda (key . args) (lambda (key . args)
(when (zero? retry) (when (zero? retry)
(apply throw key args)) (apply throw key args))
@ -147,7 +162,8 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(('secret-service-server ('version version ...)) (('secret-service-server ('version version ...))
(log "sending files from ~s...~%" secret-root) (log "sending files from ~s...~%" secret-root)
(send-files sock) (send-files sock)
(log "done sending files to port ~a~%" port) (log "done sending files to ~a~%"
(socket-address->string address))
(close-port sock) (close-port sock)
secret-root) secret-root)
(x (x
@ -155,7 +171,8 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(close-port sock) (close-port sock)
#f)) #f))
(begin ;timeout (begin ;timeout
(log "timeout while sending files to ~a~%" port) (log "timeout while sending files to ~a~%"
(socket-address->string address))
(close-port sock) (close-port sock)
#f)))) #f))))
@ -168,19 +185,20 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(unless (= ENOENT (system-error-errno args)) (unless (= ENOENT (system-error-errno args))
(apply throw args))))) (apply throw args)))))
(define (secret-service-receive-secrets port) (define (secret-service-receive-secrets address)
"Listen to local PORT and wait for a secret service client to send secrets. "Listen to ADDRESS, an address returned by 'make-socket-address', and wait
Write them to the file system. Return the list of files installed on success, for a secret service client to send secrets. Write them to the file system.
and #f otherwise." Return the list of files installed on success, and #f otherwise."
(define (wait-for-client port) (define (wait-for-client address)
;; Wait for a TCP connection on PORT. Note: We cannot use the ;; Wait for a connection on ADDRESS. Note: virtio-serial ports are safer
;; virtio-serial ports, which would be safer, because they are ;; than TCP connections but they are (presumably) unsupported on GNU/Hurd.
;; (presumably) unsupported on GNU/Hurd.
(let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0))) (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0)))
(bind sock AF_INET INADDR_ANY port) (bind sock address)
(listen sock 1) (listen sock 1)
(log "waiting for secrets on port ~a...~%" port) (log "waiting for secrets on ~a...~%"
(socket-address->string address))
(match (select (list sock) '() '() 60) (match (select (list sock) '() '() 60)
(((_) () ()) (((_) () ())
(match (accept sock) (match (accept sock)
@ -244,7 +262,7 @@ and #f otherwise."
(log "invalid secrets received~%") (log "invalid secrets received~%")
#f))) #f)))
(let* ((port (wait-for-client port)) (let* ((port (wait-for-client address))
(result (and=> port read-secrets))) (result (and=> port read-secrets)))
(when port (when port
(close-port port)) (close-port port))

22
gnu/services/virtualization.scm
View File

@ -996,7 +996,7 @@ specified, the QEMU default path is used."))
;;; Secrets for guest VMs. ;;; Secrets for guest VMs.
;;; ;;;
(define (secret-service-shepherd-services port) (define (secret-service-shepherd-services address)
"Return a Shepherd service that fetches sensitive material at local PORT, "Return a Shepherd service that fetches sensitive material at local PORT,
over TCP. Reboot upon failure." over TCP. Reboot upon failure."
;; This is a Shepherd service, rather than an activation snippet, to make ;; This is a Shepherd service, rather than an activation snippet, to make
@ -1018,7 +1018,7 @@ over TCP. Reboot upon failure."
"receiving secrets from the host...~%") "receiving secrets from the host...~%")
(force-output (current-error-port)) (force-output (current-error-port))
(let ((sent (secret-service-receive-secrets #$port))) (let ((sent (secret-service-receive-secrets #$address)))
(unless sent (unless sent
(sleep 3) (sleep 3)
(reboot)))))) (reboot))))))
@ -1039,9 +1039,13 @@ over TCP. Reboot upon failure."
boot time. This service is meant to be used by virtual machines (VMs) that boot time. This service is meant to be used by virtual machines (VMs) that
can only be accessed by their host."))) can only be accessed by their host.")))
(define (secret-service-operating-system os) (define* (secret-service-operating-system os
#:optional
(address
#~(make-socket-address
AF_INET INADDR_ANY 1004)))
"Return an operating system based on OS that includes the secret-service, "Return an operating system based on OS that includes the secret-service,
that will be listening to receive secret keys on port 1004, TCP." that will be listening to receive secret keys on ADDRESS."
(operating-system (operating-system
(inherit os) (inherit os)
(services (services
@ -1049,7 +1053,7 @@ that will be listening to receive secret keys on port 1004, TCP."
;; activation: that requires entropy and thus takes time during boot, and ;; activation: that requires entropy and thus takes time during boot, and
;; those keys are going to be overwritten by secrets received from the ;; those keys are going to be overwritten by secrets received from the
;; host anyway. ;; host anyway.
(cons (service secret-service-type 1004) (cons (service secret-service-type address)
(modify-services (operating-system-user-services os) (modify-services (operating-system-user-services os)
(openssh-service-type (openssh-service-type
config => (openssh-configuration config => (openssh-configuration
@ -1243,7 +1247,7 @@ is added to the OS specified in CONFIG."
(source-module-closure '((gnu build secret-service) (source-module-closure '((gnu build secret-service)
(guix build utils))) (guix build utils)))
#~(lambda () #~(lambda ()
(let ((pid (fork+exec-command #$vm-command (let* ((pid (fork+exec-command #$vm-command
#:user "childhurd" #:user "childhurd"
;; XXX TODO: use "childhurd" after ;; XXX TODO: use "childhurd" after
;; updating Shepherd ;; updating Shepherd
@ -1253,14 +1257,16 @@ is added to the OS specified in CONFIG."
;; by default. ;; by default.
'("TMPDIR=/tmp"))) '("TMPDIR=/tmp")))
(port #$(hurd-vm-port config %hurd-vm-secrets-port)) (port #$(hurd-vm-port config %hurd-vm-secrets-port))
(root #$(hurd-vm-configuration-secret-root config))) (root #$(hurd-vm-configuration-secret-root config))
(address (make-socket-address AF_INET INADDR_LOOPBACK
port)))
(catch #t (catch #t
(lambda _ (lambda _
;; XXX: 'secret-service-send-secrets' won't complete until ;; XXX: 'secret-service-send-secrets' won't complete until
;; the guest has booted and its secret service server is ;; the guest has booted and its secret service server is
;; running, which could take 20+ seconds during which PID 1 ;; running, which could take 20+ seconds during which PID 1
;; is stuck waiting. ;; is stuck waiting.
(if (secret-service-send-secrets port root) (if (secret-service-send-secrets address root)
pid pid
(begin (begin
(kill (- pid) SIGTERM) (kill (- pid) SIGTERM)