[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#34638] [PATCH 4/4] inferior: Add 'open-inferior/container'.
From: |
Christopher Baines |
Subject: |
[bug#34638] [PATCH 4/4] inferior: Add 'open-inferior/container'. |
Date: |
Sun, 24 Feb 2019 16:18:55 +0000 |
---
guix/inferior.scm | 65 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 65 insertions(+)
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
--
2.20.1