| Message ID | 20190419140427.15183-2-mail@cbaines.net |
|---|---|
| State | Accepted |
| Headers | show |
| Series | [bug#34638,v2,1/4] utils: Add #:base-directory to call-with-temporary-directory. | expand |
| Context | Check | Description |
|---|---|---|
| cbaines/applying patch | success | Successfully applied |
Christopher Baines <mail@cbaines.net> skribis: > 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. [...] > +(define* (start-child-in-container command > + #:key read? write? > + (root 'temporary) > + (mounts '()) > + (namespaces %namespaces) > + (host-uids 1) > + (extra-environment-variables '())) Please add a docstring. :-) I’d change (extra-environment-variables '()) to: (environment-variables (environ)) I always find it too hard to reason about “extra” thing; it’s just more convenient as an interface to specify the whole thing rather than a list of “extras”. > + (apply execlp command)) To provide a correct argv[0] by default, you should probably change it to: (match command ((program arguments ...) (execlp program program arguments))) (That’ll also address a comment of yours in one of the subsequent patches.) Could you add a test to ‘tests/containers.scm’? Thanks, Ludo’.
Ludovic Courtès <ludo@gnu.org> writes: > Christopher Baines <mail@cbaines.net> skribis: > >> 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. > > [...] > >> +(define* (start-child-in-container command >> + #:key read? write? >> + (root 'temporary) >> + (mounts '()) >> + (namespaces %namespaces) >> + (host-uids 1) >> + (extra-environment-variables '())) > > Please add a docstring. :-) > > I’d change (extra-environment-variables '()) to: > > (environment-variables (environ)) > > I always find it too hard to reason about “extra” thing; it’s just more > convenient as an interface to specify the whole thing rather than a list > of “extras”. I had a go at this, but I think trying to copy the environment variables from the host Guix to the inferior one caused problems, at least this backtrace appears when calling open-inferior/container and I'm guessing it comes from the inferior guix. I think calling it environment-variables and having it be '() is OK, the only change I can see being made elsewhere is that open-inferior/container adds HOME=/tmp, and that's just to avoid issues with (guix profiles). Does that make sense? Backtrace: 6 (apply-smob/1 #<catch-closure 7f77e0a889a0>) In ice-9/boot-9.scm: 705:2 5 (call-with-prompt ("prompt") #<procedure 7f77e0a9f560 at ice-9/eval.scm:330:13 ()> #<procedure default-prompt-handler (k proc)>) In ice-9/eval.scm: 619:8 4 (_ #(#(#<directory (guile-user) 7f77e0717140>))) 293:34 3 (_ #(#(#<directory (guile-user) 7f77e0717140>) ("/gnu/store/ain1rvg7vrrcr85v0fgpyjm8k2sflxpz-guix-1.0.1-15.0984481/bin/.guix-real" "repl" "-t" "machi?"))) 159:9 2 (_ #(#(#<directory (guile-user) 7f77e0717140>) ("/gnu/store/ain1rvg7vrrcr85v0fgpyjm8k2sflxpz-guix-1.0.1-15.0984481/bin/.guix-real" "repl" "-t" "machi?"))) In ice-9/boot-9.scm: 2803:6 1 (resolve-interface _ #:select _ #:hide _ #:prefix _ #:renamer _ #:version _) In unknown file: 0 (scm-error misc-error #f "~A ~S" ("no code for module" (guix ui)) #f)
Hi! Christopher Baines <mail@cbaines.net> skribis: > Ludovic Courtès <ludo@gnu.org> writes: > >> Christopher Baines <mail@cbaines.net> skribis: >> >>> 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. >> >> [...] >> >>> +(define* (start-child-in-container command >>> + #:key read? write? >>> + (root 'temporary) >>> + (mounts '()) >>> + (namespaces %namespaces) >>> + (host-uids 1) >>> + (extra-environment-variables '())) >> >> Please add a docstring. :-) >> >> I’d change (extra-environment-variables '()) to: >> >> (environment-variables (environ)) >> >> I always find it too hard to reason about “extra” thing; it’s just more >> convenient as an interface to specify the whole thing rather than a list >> of “extras”. > > I had a go at this, but I think trying to copy the environment variables > from the host Guix to the inferior one caused problems, at least this > backtrace appears when calling open-inferior/container and I'm guessing > it comes from the inferior guix. > > I think calling it environment-variables and having it be '() is OK, the > only change I can see being made elsewhere is that > open-inferior/container adds HOME=/tmp, and that's just to avoid issues > with (guix profiles). > > Does that make sense? Ah yes, defaulting to the empty list is even better. Thanks, Ludo’.
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