Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Wed, 15 Jan 2025 22:14:02 UTC
Severity: normal
Tags: patch
Message #14 received at 75595 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 75595 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <mail <at> cbaines.net> Subject: [PATCH 3/4] inferior: Store the bridge directory name in <inferior>. Date: Wed, 15 Jan 2025 23:14:49 +0100
* 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 <at> cbaines.net>
Change-Id: Ie469e3f272f29054cc50b1e1afb2784521c2e2e2
---
guix/inferior.scm | 68 ++++++++++++++++++++++++++++++++---------------
1 file changed, 46 insertions(+), 22 deletions(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 8066cce2fc..ead6148667 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018-2024 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2018-2025 Ludovic Courtès <ludo <at> 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."
--
2.47.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.