ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: secret-service: Make the endpoint configurable.

Browse source 
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 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
;;; 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 @@ (define (wait-for-readable-fd port timeout)
('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 @@ (define (send-files sock)
(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 @@ (define (send-files sock)
;; 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 @@ (define (send-files sock)
(('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 @@ (define (send-files sock)
(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 @@ (define (delete-file* file)
(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 @@ (define (read-secrets port)
(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))

22
gnu/services/virtualization.scm
View file

@ -996,7 +996,7 @@ (define qemu-guest-agent-service-type
;;; 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 @@ (define (secret-service-shepherd-services port)
"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 @@ (define secret-service-type
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 @@ (define (secret-service-operating-system os)
;; 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,7 +1247,7 @@ (define vm-command
(source-module-closure '((gnu build secret-service)
(guix build utils)))
#~(lambda ()
(let ((pid (fork+exec-command #$vm-command
(let* ((pid (fork+exec-command #$vm-command
#:user "childhurd"
;; XXX TODO: use "childhurd" after
;; updating Shepherd
@ -1253,14 +1257,16 @@ (define vm-command
;; by default.
'("TMPDIR=/tmp")))
(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
(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)