[bug#75595,3/4] inferior: Store the bridge directory name in <inferior>.

Message ID 5175258f93e27140a2fcc0d1f23e396c682091da.1736977759.git.ludo@gnu.org
State New
Headers
Series 'guix container run' and isolated inferiors |

Commit Message

Ludovic Courtès Jan. 15, 2025, 10:14 p.m. UTC
  * 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(-)
  

Patch

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@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."