[bug#75595,3/4] inferior: Store the bridge directory name in <inferior>.
Commit Message
* guix/inferior.scm (<inferior>)[bridge-directory]: New field.
(port->inferior): Add #:bridge-directory and honor it.
(close-inferior): Delete the bridge directory.
(allocate-temporary-directory, inferior-bridge-directory): New procedures.
(open-store-bridge!): Use it instead of ‘call-with-temporary-directory’.
Co-authored-by: Christopher Baines <mail@cbaines.net>
Change-Id: Ie469e3f272f29054cc50b1e1afb2784521c2e2e2
---
guix/inferior.scm | 68 ++++++++++++++++++++++++++++++++---------------
1 file changed, 46 insertions(+), 22 deletions(-)
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018-2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2025 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -36,6 +36,7 @@ (define-module (guix inferior)
&store-protocol-error))
#:use-module ((guix derivations)
#:select (read-derivation-from-file))
+ #:autoload (guix build syscalls) (mkdtemp!)
#:use-module (guix gexp)
#:use-module (guix search-paths)
#:use-module (guix profiles)
@@ -113,13 +114,15 @@ (define-module (guix inferior)
;; Inferior Guix process.
(define-record-type <inferior>
- (inferior pid socket close version packages table
- bridge-socket)
+ (inferior pid socket close version bridge-directory
+ packages table bridge-socket)
inferior?
(pid inferior-pid)
(socket inferior-socket)
(close inferior-close-socket) ;procedure
(version inferior-version) ;REPL protocol version
+ (bridge-directory %inferior-bridge-directory ;#f | file name
+ set-inferior-bridge-directory!)
(packages inferior-package-promise) ;promise of inferior packages
(table inferior-package-table) ;promise of vhash
@@ -233,6 +236,7 @@ (define* (port->inferior pipe #:optional (close close-port))
(match (read pipe)
(('repl-version 0 rest ...)
(letrec ((result (inferior 'pipe pipe close (cons 0 rest)
+ #f ;bridge directory
(delay (%inferior-packages result))
(delay (%inferior-package-table result))
#f)))
@@ -318,7 +322,14 @@ (define (close-inferior inferior)
;; Close and delete the store bridge, if any.
(when (inferior-bridge-socket inferior)
- (close-port (inferior-bridge-socket inferior)))))
+ (close-port (inferior-bridge-socket inferior)))
+
+ ;; Delete the store bridge socket directory.
+ (when (%inferior-bridge-directory inferior)
+ (false-if-exception
+ (delete-file (in-vicinity (%inferior-bridge-directory inferior)
+ "inferior")))
+ (rmdir (%inferior-bridge-directory inferior)))))
;; Non-self-quoting object of the inferior.
(define-record-type <inferior-object>
@@ -656,6 +667,20 @@ (define (proxy inferior store) ;adapted from (guix ssh)
(memq response-port reads))
(loop))))))
+(define (allocate-temporary-directory)
+ "Return the name of a fresh temporary directory."
+ (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+ (template (string-append directory "/guix-inferior.XXXXXX")))
+ (mkdtemp! template)))
+
+(define (inferior-bridge-directory inferior)
+ "Return the name of the directory shared between INFERIOR and its host to
+contain the \"store bridge\"."
+ (or (%inferior-bridge-directory inferior)
+ (let ((directory (allocate-temporary-directory)))
+ (set-inferior-bridge-directory! inferior directory)
+ directory)))
+
(define (open-store-bridge! inferior)
"Open a \"store bridge\" for INFERIOR--a named socket in /tmp that will be
used to proxy store RPCs from the inferior to the store of the calling
@@ -664,25 +689,24 @@ (define (open-store-bridge! inferior)
;; its store. This ensures the inferior uses the same store, with the same
;; options, the same per-session GC roots, etc.
;; FIXME: This strategy doesn't work for remote inferiors (SSH).
- (call-with-temporary-directory
- (lambda (directory)
- (chmod directory #o700)
- (let ((name (string-append directory "/inferior"))
- (socket (socket AF_UNIX SOCK_STREAM 0)))
- (bind socket AF_UNIX name)
- (listen socket 2)
+ (let ((directory (inferior-bridge-directory inferior)))
+ (chmod directory #o700)
+ (let ((name (string-append directory "/inferior"))
+ (socket (socket AF_UNIX SOCK_STREAM 0)))
+ (bind socket AF_UNIX name)
+ (listen socket 2)
- (send-inferior-request
- `(define %bridge-socket
- (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
- (connect socket AF_UNIX ,name)
- socket))
- inferior)
- (match (accept socket)
- ((client . address)
- (close-port socket)
- (set-inferior-bridge-socket! inferior client)))
- (read-inferior-response inferior)))))
+ (send-inferior-request
+ `(define %bridge-socket
+ (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+ (connect socket AF_UNIX ,name)
+ socket))
+ inferior)
+ (match (accept socket)
+ ((client . address)
+ (close-port socket)
+ (set-inferior-bridge-socket! inferior client)))
+ (read-inferior-response inferior))))
(define (ensure-store-bridge! inferior)
"Ensure INFERIOR has a connected bridge."