Subject: [PATCH 4/4] inferior: Allow running inferiors in a container.

From: Ludovic Courtès <[email-masked]>
Date: Wed, 15 Jan 2025 23:14:50 +0100

* guix/inferior.scm (container-command-wrapper): New procedures.
(open-bidirectional-pipe): Add #:isolated? and #:bridge-directory.
Call ‘container-command-wrapper’ when #:isolated? is true.  Adjust the
argument to ‘spawn’ and ‘execlp’ accordingly.
(inferior-pipe): Add #:isolated? and #:bridge-directory; pass them on
to ‘open-bidirectional-pipe’.
(port->inferior): Add #:bridge-directory and honor it.
(open-inferior): Add #:isolated? and honor it.  Call
‘allocate-temporary-directory’ when #:isolated? is true.

Change-Id: Ie0a56de59aac0611d478bda858ab75f48a0853ff
---
 guix/inferior.scm | 118 +++++++++++++++++++++++++++++++++-------------
 1 file changed, 84 insertions(+), 34 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index ead6148667..a74e9d8665 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -36,6 +36,7 @@ (define-module (guix inferior)
                           &store-protocol-error))
   #:use-module ((guix derivations)
                 #:select (read-derivation-from-file))
+  #:autoload   (guix describe) (current-profile)
   #:autoload   (guix build syscalls) (mkdtemp!)
   #:use-module (guix gexp)
   #:use-module (guix search-paths)
@@ -139,13 +140,37 @@ (define (write-inferior inferior port)
 
 (set-record-type-printer! <inferior> write-inferior)
 
-(define (open-bidirectional-pipe command . args)
+(define (container-command-wrapper command bridge-directory)
+  "Return a command (list of strings) wrapping COMMAND such that it is spawned
+in a new container that shared BRIDGE-DIRECTORY with the host."
+  (let ((guix (or (and=> (current-profile)
+                         (cut string-append <> "/bin/guix"))
+                  "guix")))
+    `(,guix "container" "run" "--bare" "--feature=guix" "--no-cwd"
+            ,(string-append "--expose=" bridge-directory)
+            "--"
+            ,@command)))
+
+(define* (open-bidirectional-pipe command args
+                                  #:key isolated? bridge-directory)
   "Open a bidirectional pipe to COMMAND invoked with ARGS and return it, as a
 regular file port (socket).
 
+When ISOLATED? is true, run COMMAND in a container that only shares
+BRIDGE-DIRECTORY with the host.
+
 This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
 regular file port that can be passed to 'select' ('open-pipe*' returns a
 custom binary port)."
+  (define wrap
+    ;; Optionally wrap the command so it is spawned via 'guix container run'.
+    ;; This is not as elegant as using 'call-with-container' directly, but the
+    ;; advantage is that it allows us to use 'posix_spawn' below, thus making
+    ;; it reliable in a multi-threaded context.
+    (if isolated?
+        (cut container-command-wrapper <> bridge-directory)
+        identity))
+
   ;; Make sure the sockets are close-on-exec; failing to do that, a second
   ;; inferior (for instance) would inherit the underlying file descriptor, and
   ;; thus (close-port PARENT) in the original process would have no effect:
@@ -156,12 +181,14 @@ (define (open-bidirectional-pipe command . args)
          (let* ((void (open-fdes "/dev/null" O_WRONLY))
                 (pid  (catch 'system-error
                         (lambda ()
-                          (spawn command (cons command args)
-                                 #:input child
-                                 #:output child
-                                 #:error (if (file-port? (current-error-port))
-                                             (current-error-port)
-                                             void)))
+                          (match (wrap (cons command args))
+                            ((and (command . _) args)
+                             (spawn command args
+                                    #:input child
+                                    #:output child
+                                    #:error (if (file-port? (current-error-port))
+                                                (current-error-port)
+                                                void)))))
                         (const #f))))         ;can't exec, for instance ENOENT
            (close-fdes void)
            (close-port child)
@@ -187,22 +214,31 @@ (define (open-bidirectional-pipe command . args)
                               2)))
                     (dup2 (open-fdes "/dev/null" O_WRONLY)
                           2))
-                (apply execlp command command args))
+                (match (wrap (cons command args))
+                  ((and (command . _) args)
+                   (apply execlp command args))))
               (lambda ()
                 (primitive-_exit 127))))
            (pid
             (close-port child)
             (values parent pid)))))))
 
-(define* (inferior-pipe directory command error-port)
+(define* (inferior-pipe directory command error-port
+                        #:key isolated? bridge-directory)
   "Return two values: an input/output pipe on the Guix instance in DIRECTORY
 and its PID.  This runs 'DIRECTORY/COMMAND repl' if it exists, or falls back
-to some other method if it's an old Guix."
-  (let ((pipe pid (with-error-to-port error-port
-                    (lambda ()
-                      (open-bidirectional-pipe
-                       (string-append directory "/" command)
-                       "repl" "-t" "machine")))))
+to some other method if it's an old Guix.
+
+When ISOLATED? is true, run COMMAND in a container that only shares
+BRIDGE-DIRECTORY with the host."
+  (let* ((bridge-directory (and isolated? bridge-directory))
+         (pipe pid (with-error-to-port error-port
+                     (lambda ()
+                       (open-bidirectional-pipe
+                        (string-append directory "/" command)
+                        '("repl" "-t" "machine")
+                        #:isolated? isolated?
+                        #:bridge-directory bridge-directory)))))
     (if (eof-object? (peek-char pipe))
         (begin
           (close-port pipe)
@@ -213,30 +249,33 @@ (define* (inferior-pipe directory command error-port)
             (lambda ()
               (open-bidirectional-pipe
                "guile"
-               "-L" (string-append directory "/share/guile/site/"
-                                   (effective-version))
-               "-C" (string-append directory "/share/guile/site/"
-                                   (effective-version))
-               "-C" (string-append directory "/lib/guile/"
-                                   (effective-version) "/site-ccache")
-               "-c"
-               (object->string
-                `(begin
-                   (primitive-load ,(search-path %load-path
-                                                 "guix/repl.scm"))
-                   ((@ (guix repl) machine-repl))))))))
+               (list "-L" (string-append directory "/share/guile/site/"
+                                         (effective-version))
+                     "-C" (string-append directory "/share/guile/site/"
+                                         (effective-version))
+                     "-C" (string-append directory "/lib/guile/"
+                                         (effective-version) "/site-ccache")
+                     "-c"
+                     (object->string
+                      `(begin
+                         (primitive-load ,(search-path %load-path
+                                                       "guix/repl.scm"))
+                         ((@ (guix repl) machine-repl)))))
+               #:isolated? isolated?
+               #:bridge-directory bridge-directory))))
         (values pipe pid))))
 
-(define* (port->inferior pipe #:optional (close close-port))
+(define* (port->inferior pipe #:optional (close close-port)
+                         #:key bridge-directory)
   "Given PIPE, an input/output port, return an inferior that talks over PIPE.
 PIPE is closed with CLOSE when 'close-inferior' is called on the returned
-inferior."
+inferior.  Associate the new inferior with BRIDGE-DIRECTORY."
   (setvbuf pipe 'line)
 
   (match (read pipe)
     (('repl-version 0 rest ...)
      (letrec ((result (inferior 'pipe pipe close (cons 0 rest)
-                                #f                ;bridge directory
+                                bridge-directory
                                 (delay (%inferior-packages result))
                                 (delay (%inferior-package-table result))
                                 #f)))
@@ -306,14 +345,25 @@ (define* (port->inferior pipe #:optional (close close-port))
 
 (define* (open-inferior directory
                         #:key (command "bin/guix")
-                        (error-port (%make-void-port "w")))
+                        (error-port (%make-void-port "w"))
+                        isolated?)
   "Open the inferior Guix in DIRECTORY, running 'DIRECTORY/COMMAND repl' or
-equivalent.  Return #f if the inferior could not be launched."
-  (let ((pipe pid (inferior-pipe directory command error-port)))
+equivalent.  Return #f if the inferior could not be launched.
+
+When ISOLATED? is true, run COMMAND in a container isolated from the host."
+  ;; When running the command in a container, allocate the directory that will
+  ;; contain the "bridge socket" upfront so it can be bind-mounted in the
+  ;; container.
+  (let* ((bridge-directory (and isolated?
+                                (allocate-temporary-directory)))
+         (pipe pid (inferior-pipe directory command error-port
+                                  #:isolated? isolated?
+                                  #:bridge-directory bridge-directory)))
     (port->inferior pipe
                     (lambda (port)
                       (close-port port)
-                      (waitpid pid)))))
+                      (waitpid pid))
+                    #:bridge-directory bridge-directory)))
 
 (define (close-inferior inferior)
   "Close INFERIOR."
-- 
2.47.1