[bug#34638,v2,4/4] inferior: Add 'open-inferior/container'.

Message ID 20190419140427.15183-4-mail@cbaines.net
State Accepted
Headers show
Series [bug#34638,v2,1/4] utils: Add #:base-directory to call-with-temporary-directory. | expand

Checks

Context Check Description
cbaines/applying patch success Successfully applied

Commit Message

Christopher Baines April 19, 2019, 2:04 p.m. UTC
---
 guix/inferior.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)

Comments

Ludovic Courtès March 26, 2020, 9:32 a.m. UTC | #1
Christopher Baines <mail@cbaines.net> skribis:

> ---
>  guix/inferior.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++
>  1 file changed, 76 insertions(+)

[...]

> +(define* (open-inferior/container store guix-store-item
> +                                  #:key
> +                                  (command "bin/guix")
> +                                  (share-host-network? #f)
> +                                  (extra-shared-directories '())
> +                                  (extra-environment-variables '()))

Please add a docstring.  Same comment as before regarding “extras”.  :-)

> +    (start-child-in-container
> +     (list (string-append guix-store-item "/bin/guix")
> +           ;; TODO I'm not sure why "repl" is duplicated in the following
> +           ;; command
> +           "repl" "repl" "-t" "machine")

This is the argv[0] issue mentioned earlier.

I think it’s not really feasible to write a test for this one, or at
least I don’t see how.

Otherwise LGTM, thanks!

Ludo’.

Patch

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 6d18ab90e9..8238c7fb38 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -19,6 +19,7 @@ 
 (define-module (guix inferior)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
   #:use-module ((guix utils)
                 #:select (%current-system
                           source-properties->location
@@ -40,6 +41,9 @@ 
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix base32)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu build linux-container)
+  #:use-module (guix build syscalls)
   #:use-module (gcrypt hash)
   #:autoload   (guix cache) (maybe-remove-expired-cache-entries)
   #:autoload   (guix ui) (show-what-to-build*)
@@ -54,6 +58,7 @@ 
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
   #:export (inferior?
             open-inferior
+            open-inferior/container
             port->inferior
             close-inferior
             inferior-eval
@@ -137,6 +142,77 @@  it's an old Guix."
                           ((@ (guix scripts repl) machine-repl))))))
         pipe)))
 
+(define* (open-inferior/container store guix-store-item
+                                  #:key
+                                  (command "bin/guix")
+                                  (share-host-network? #f)
+                                  (extra-shared-directories '())
+                                  (extra-environment-variables '()))
+  (define requisite-store-items
+    (requisites store (list guix-store-item)))
+
+  (define shared-directory
+    (mkdtemp! (string-append (or (getenv "TMPDIR") "/tmp")
+                             "/guix-inferior.XXXXXX")))
+
+  (define mappings
+    (append
+     (map (lambda (dir)
+            (file-system-mapping
+             (source dir)
+             (target dir)
+             (writable? #f)))
+          `(;; Share a directory, used in inferior-eval-with-store
+            ,shared-directory
+            ,@requisite-store-items
+            ,@extra-shared-directories))
+     (if share-host-network?
+         %network-file-mappings
+         '())))
+
+  (define mounts
+    (append %container-file-systems
+            (map file-system-mapping->bind-mount
+                 mappings)))
+
+  (define (inferior-pipe/container store
+                                   guix-store-item
+                                   shared-directory
+                                   command)
+    (start-child-in-container
+     (list (string-append guix-store-item "/bin/guix")
+           ;; TODO I'm not sure why "repl" is duplicated in the following
+           ;; command
+           "repl" "repl" "-t" "machine")
+     #:read? #t
+     #:write? #t
+     #:mounts mounts
+     #:namespaces (if share-host-network?
+                      (delq 'net %namespaces)
+                      %namespaces)
+     #:extra-environment-variables
+     `(;; Set HOME, so that the (guix profiles) module can be loaded, without it
+       ;; trying to read from /etc/passwd
+       "HOME=/tmp"
+       ,@extra-environment-variables)))
+
+  (let*-values
+      (((pipe pid)
+        (inferior-pipe/container store
+                                 guix-store-item
+                                 shared-directory
+                                 command))
+       ((close-inferior-pipe)
+        (lambda (pipe*)
+          (unless (eq? pipe pipe*)
+            (error "wrong pipe being closed"))
+          (close-port pipe)
+          (cdr (waitpid pid)))))
+
+      (port->inferior pipe
+                      shared-directory
+                      close-inferior-pipe)))
+
 (define* (port->inferior pipe shared-directory #:optional (close close-port))
   "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