inferior: Add 'open-inferior/container'.inferior-in-container

1 files changed, 65 insertions, 0 deletions

diff --git a/guix/inferior.scm b/guix/inferior.scm
index cf72454426..a5f773c147 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -40,6 +40,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 +57,7 @@
   #:use-module ((rnrs bytevectors) #:select (string->utf8))
   #:export (inferior?
             open-inferior
+            open-inferior/container
             port->inferior
             close-inferior
             inferior-eval
@@ -137,6 +141,67 @@ 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)))
+
+  (port->inferior (inferior-pipe/container store
+                                           guix-store-item
+                                           shared-directory
+                                           command)
+                  shared-directory
+                  close-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