From: Christopher Baines <mail@cbaines.net>
To: 34638@debbugs.gnu.org
Subject: [bug#34638] [PATCH v2 2/4] linux-container: Add 'start-child-in-container'.
Date: Fri, 19 Apr 2019 15:04:25 +0100 [thread overview]
Message-ID: <20190419140427.15183-2-mail@cbaines.net> (raw)
In-Reply-To: <20190419140427.15183-1-mail@cbaines.net>
This new procedure is similar to open-pipe* in (ice-9 popen), but using
run-container from (gnu build linux-container).
* gnu/build/linux-container.scm (start-child-in-container): New procedure.
---
gnu/build/linux-container.scm | 83 +++++++++++++++++++++++++++++++++++
1 file changed, 83 insertions(+)
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 3d7b52f098..88b00e00f6 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -32,6 +32,7 @@
setgroups-supported?
%namespaces
run-container
+ start-child-in-container
call-with-container
container-excursion
container-excursion*))
@@ -213,6 +214,88 @@ corresponds to the symbols in NAMESPACES."
('net CLONE_NEWNET))
namespaces)))
+(define* (start-child-in-container command
+ #:key read? write?
+ (root 'temporary)
+ (mounts '())
+ (namespaces %namespaces)
+ (host-uids 1)
+ (extra-environment-variables '()))
+ (define (with-root-directory f)
+ (if (eq? root 'temporary)
+ (call-with-temporary-directory f)
+ (f root)))
+
+ (define (make-rw-port read-port write-port)
+ (make-soft-port
+ (vector
+ (lambda (c) (write-char c write-port))
+ (lambda (s) (display s write-port))
+ (lambda () (force-output write-port))
+ (lambda () (read-char read-port))
+ (lambda () (close-port read-port) (close-port write-port)))
+ "r+"))
+
+ ;; car is the inport port, cdr is the output port. You write to the output
+ ;; port, and read from the input port.
+ (define child-to-parent-pipe
+ (if read?
+ (pipe)
+ #f))
+
+ (define parent-to-child-pipe
+ (if write?
+ (pipe)
+ #f))
+
+ (define (run-program)
+ (when read?
+ (match child-to-parent-pipe
+ ((input-port . output-port)
+ ;; close the output part of the child-to-parent-pipe, as this is used
+ ;; by the parent process
+ (close-port input-port)
+
+ ;; Make the input part of the child-to-parent-pipe the standard
+ ;; output of this process
+ (dup2 (fileno output-port) 1))))
+
+ (when write?
+ (match parent-to-child-pipe
+ ((input-port . output-port)
+ ;; close the input part of the parent-to-child-pipe, as this is used
+ ;; by the parent processs
+ (close-port output-port)
+
+ ;; Make the output part of the parent-to-child-pipe the standard
+ ;; input of this process
+ (dup2 (fileno input-port) 0))))
+
+ ;; TODO Maybe close all file descriptors, as start_child in Guile does?
+
+ (for-each putenv extra-environment-variables)
+
+ (apply execlp command))
+
+ (with-root-directory
+ (lambda (root)
+ (let ((pid (run-container root mounts namespaces host-uids run-program)))
+ ;; Catch SIGINT and kill the container process.
+ (sigaction SIGINT
+ (lambda (signum)
+ (false-if-exception
+ (kill pid SIGKILL))))
+
+ (let* ((read-port (and=> child-to-parent-pipe car))
+ (write-port (and=> parent-to-child-pipe cdr))
+
+ (port (or (and read-port write-port
+ (make-rw-port read-port write-port))
+ read-port
+ write-port)))
+
+ (values port pid))))))
+
(define* (run-container root mounts namespaces host-uids thunk
#:key (guest-uid 0) (guest-gid 0))
"Run THUNK in a new container process and return its PID. ROOT specifies
--
2.21.0
next prev parent reply other threads:[~2019-04-19 14:05 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-02-24 16:12 [bug#34638] [PATCH 0/4] Isolated inferiors Christopher Baines
2019-02-24 16:18 ` [bug#34638] [PATCH 1/4] utils: Add #:base-directory to call-with-temporary-directory Christopher Baines
2019-02-24 16:18 ` [bug#34638] [PATCH 2/4] linux-container: Add 'start-child-in-container' Christopher Baines
2019-03-14 18:17 ` Ludovic Courtès
2019-04-19 14:16 ` Christopher Baines
2019-02-24 16:18 ` [bug#34638] [PATCH 3/4] inferior: Add a shared-directory field to <inferior> Christopher Baines
2019-02-24 16:18 ` [bug#34638] [PATCH 4/4] inferior: Add 'open-inferior/container' Christopher Baines
2019-03-14 19:35 ` [bug#34638] [PATCH 0/4] Isolated inferiors Ludovic Courtès
2019-04-19 14:04 ` [bug#34638] [PATCH v2 1/4] utils: Add #:base-directory to call-with-temporary-directory Christopher Baines
2019-04-19 14:04 ` Christopher Baines [this message]
2020-03-26 9:28 ` [bug#34638] [PATCH v2 2/4] linux-container: Add 'start-child-in-container' Ludovic Courtès
2020-03-28 11:26 ` Christopher Baines
2020-03-28 12:20 ` Ludovic Courtès
2019-04-19 14:04 ` [bug#34638] [PATCH v2 3/4] inferior: Add a shared-directory field to <inferior> Christopher Baines
2020-03-26 9:30 ` Ludovic Courtès
2019-04-19 14:04 ` [bug#34638] [PATCH v2 4/4] inferior: Add 'open-inferior/container' Christopher Baines
2020-03-26 9:32 ` Ludovic Courtès
2020-03-26 9:22 ` [bug#34638] [PATCH v2 1/4] utils: Add #:base-directory to call-with-temporary-directory Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190419140427.15183-2-mail@cbaines.net \
--to=mail@cbaines.net \
--cc=34638@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).