aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/inferior.scm76
1 files changed, 76 insertions, 0 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm
index fc348c427a..668ebabeb0 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 (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module ((guix utils)
@@ -43,6 +44,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
file-expiration-time)
@@ -58,6 +62,7 @@
#:use-module ((rnrs bytevectors) #:select (string->utf8))
#:export (inferior?
open-inferior
+ open-inferior/container
port->inferior
close-inferior
inferior-eval
@@ -150,6 +155,77 @@ it's an old Guix."
((@ (guix 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