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
This commit is contained in:
Ludovic Courtès
parent
11d5b505e5
commit
f331a667d3
|
|
@ -1,5 +1,5 @@
|
|||
;;; 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>
|
||||
;;;
|
||||
;;; 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)
|
||||
('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)
|
||||
(handshake-timeout 180))
|
||||
"Copy all files under SECRET-ROOT using TCP to secret-service listening at
|
||||
local PORT. If connect fails, sleep 1s and retry RETRY times; once connected,
|
||||
wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
|
||||
#f on failure."
|
||||
"Copy all files under SECRET-ROOT by connecting to secret-service listening
|
||||
at ADDRESS, an address as returned by 'make-socket-address'. If connection
|
||||
fails, sleep 1s and retry RETRY times; once connected, wait for at most
|
||||
HANDSHAKE-TIMEOUT seconds for handshake to complete. Return #f on failure."
|
||||
(define (file->file+size+mode file-name)
|
||||
(let ((stat (stat file-name))
|
||||
(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))))
|
||||
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))
|
||||
(addr (make-socket-address AF_INET INADDR_LOOPBACK port))
|
||||
(sleep (if (resolve-module '(fibers) #f)
|
||||
(module-ref (resolve-interface '(fibers)) 'sleep)
|
||||
sleep)))
|
||||
|
|
@ -129,7 +144,7 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
|
|||
;; forward port inside the guest.
|
||||
(let loop ((retry retry))
|
||||
(catch 'system-error
|
||||
(cute connect sock addr)
|
||||
(cute connect sock address)
|
||||
(lambda (key . args)
|
||||
(when (zero? retry)
|
||||
(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 ...))
|
||||
(log "sending files from ~s...~%" secret-root)
|
||||
(send-files sock)
|
||||
(log "done sending files to port ~a~%" port)
|
||||
(log "done sending files to ~a~%"
|
||||
(socket-address->string address))
|
||||
(close-port sock)
|
||||
secret-root)
|
||||
(x
|
||||
|
|
@ -155,7 +171,8 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
|
|||
(close-port sock)
|
||||
#f))
|
||||
(begin ;timeout
|
||||
(log "timeout while sending files to ~a~%" port)
|
||||
(log "timeout while sending files to ~a~%"
|
||||
(socket-address->string address))
|
||||
(close-port sock)
|
||||
#f))))
|
||||
|
||||
|
|
@ -168,19 +185,20 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
|
|||
(unless (= ENOENT (system-error-errno args))
|
||||
(apply throw args)))))
|
||||
|
||||
(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. Return the list of files installed on success,
|
||||
and #f otherwise."
|
||||
(define (secret-service-receive-secrets address)
|
||||
"Listen to ADDRESS, an address returned by 'make-socket-address', and wait
|
||||
for a secret service client to send secrets. Write them to the file system.
|
||||
Return the list of files installed on success, and #f otherwise."
|
||||
|
||||
(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.
|
||||
(define (wait-for-client address)
|
||||
;; Wait for a connection on ADDRESS. Note: virtio-serial ports are safer
|
||||
;; than TCP connections but they are (presumably) unsupported on GNU/Hurd.
|
||||
(let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0)))
|
||||
(bind sock AF_INET INADDR_ANY port)
|
||||
(bind sock address)
|
||||
(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 (accept sock)
|
||||
|
|
@ -244,7 +262,7 @@ and #f otherwise."
|
|||
(log "invalid secrets received~%")
|
||||
#f)))
|
||||
|
||||
(let* ((port (wait-for-client port))
|
||||
(let* ((port (wait-for-client address))
|
||||
(result (and=> port read-secrets)))
|
||||
(when port
|
||||
(close-port port))
|
||||
|
|
|
|||
|
|
@ -996,7 +996,7 @@ specified, the QEMU default path is used."))
|
|||
;;; 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,
|
||||
over TCP. Reboot upon failure."
|
||||
;; 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...~%")
|
||||
(force-output (current-error-port))
|
||||
|
||||
(let ((sent (secret-service-receive-secrets #$port)))
|
||||
(let ((sent (secret-service-receive-secrets #$address)))
|
||||
(unless sent
|
||||
(sleep 3)
|
||||
(reboot))))))
|
||||
|
|
@ -1039,9 +1039,13 @@ 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)
|
||||
(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,
|
||||
that will be listening to receive secret keys on port 1004, TCP."
|
||||
that will be listening to receive secret keys on ADDRESS."
|
||||
(operating-system
|
||||
(inherit os)
|
||||
(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
|
||||
;; those keys are going to be overwritten by secrets received from the
|
||||
;; host anyway.
|
||||
(cons (service secret-service-type 1004)
|
||||
(cons (service secret-service-type address)
|
||||
(modify-services (operating-system-user-services os)
|
||||
(openssh-service-type
|
||||
config => (openssh-configuration
|
||||
|
|
@ -1243,24 +1247,26 @@ is added to the OS specified in CONFIG."
|
|||
(source-module-closure '((gnu build secret-service)
|
||||
(guix build utils)))
|
||||
#~(lambda ()
|
||||
(let ((pid (fork+exec-command #$vm-command
|
||||
#:user "childhurd"
|
||||
;; XXX TODO: use "childhurd" after
|
||||
;; updating Shepherd
|
||||
#:group "kvm"
|
||||
#:environment-variables
|
||||
;; QEMU tries to write to /var/tmp
|
||||
;; by default.
|
||||
'("TMPDIR=/tmp")))
|
||||
(port #$(hurd-vm-port config %hurd-vm-secrets-port))
|
||||
(root #$(hurd-vm-configuration-secret-root config)))
|
||||
(let* ((pid (fork+exec-command #$vm-command
|
||||
#:user "childhurd"
|
||||
;; XXX TODO: use "childhurd" after
|
||||
;; updating Shepherd
|
||||
#:group "kvm"
|
||||
#:environment-variables
|
||||
;; QEMU tries to write to /var/tmp
|
||||
;; by default.
|
||||
'("TMPDIR=/tmp")))
|
||||
(port #$(hurd-vm-port config %hurd-vm-secrets-port))
|
||||
(root #$(hurd-vm-configuration-secret-root config))
|
||||
(address (make-socket-address AF_INET INADDR_LOOPBACK
|
||||
port)))
|
||||
(catch #t
|
||||
(lambda _
|
||||
;; XXX: 'secret-service-send-secrets' won't complete until
|
||||
;; the guest has booted and its secret service server is
|
||||
;; running, which could take 20+ seconds during which PID 1
|
||||
;; is stuck waiting.
|
||||
(if (secret-service-send-secrets port root)
|
||||
(if (secret-service-send-secrets address root)
|
||||
pid
|
||||
(begin
|
||||
(kill (- pid) SIGTERM)
|
||||
|
|
|
|||
Loading…
Reference in New Issue