mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
11d5b505e5
commit
f331a667d3
2 changed files with 63 additions and 39 deletions
|
@ -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 @@ (define (wait-for-readable-fd port timeout)
|
||||||
('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 @@ (define (send-files sock)
|
||||||
(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 @@ (define (send-files sock)
|
||||||
;; 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 @@ (define (send-files sock)
|
||||||
(('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 @@ (define (send-files sock)
|
||||||
(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 @@ (define (delete-file* file)
|
||||||
(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 @@ (define (read-secrets port)
|
||||||
(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))
|
||||||
|
|
|
@ -996,7 +996,7 @@ (define qemu-guest-agent-service-type
|
||||||
;;; 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 @@ (define (secret-service-shepherd-services port)
|
||||||
"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 @@ (define secret-service-type
|
||||||
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 @@ (define (secret-service-operating-system os)
|
||||||
;; 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 @@ (define vm-command
|
||||||
(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 @@ (define vm-command
|
||||||
;; 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)
|
||||||
|
|
Loading…
Reference in a new issue