diff options
| -rw-r--r-- | gnu/build/linux-container.scm | 42 | ||||
| -rw-r--r-- | tests/containers.scm | 12 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 10 |
3 files changed, 52 insertions, 12 deletions
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index 562d50bcc7..91996d06ca 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -205,35 +205,53 @@ host user identifiers to map into the user namespace." ;; The parent process must initialize the user namespace for the child ;; before it can boot. To negotiate this, a pipe is used such that the ;; child process blocks until the parent writes to it. - (match (pipe) - ((in . out) + (match (socketpair PF_UNIX SOCK_STREAM 0) + ((child . parent) (let ((flags (namespaces->bit-mask namespaces))) (match (clone flags) (0 (call-with-clean-exit (lambda () - (close out) + (close-port parent) ;; Wait for parent to set things up. - (match (read in) + (match (read child) ('ready - (close in) (purify-environment) (when (memq 'mnt namespaces) - (mount-file-systems root mounts - #:mount-/proc? (memq 'pid namespaces) - #:mount-/sys? (memq 'net namespaces))) + (catch #t + (lambda () + (mount-file-systems root mounts + #:mount-/proc? (memq 'pid namespaces) + #:mount-/sys? (memq 'net + namespaces))) + (lambda args + ;; Forward the exception to the parent process. + (write args child) + (primitive-exit 3)))) ;; TODO: Manage capabilities. + (write 'ready child) + (close-port child) (thunk)) (_ ;parent died or something (primitive-exit 2)))))) (pid + (close-port child) (when (memq 'user namespaces) (initialize-user-namespace pid host-uids)) ;; TODO: Initialize cgroups. - (close in) - (write 'ready out) - (close out) - pid)))))) + (write 'ready parent) + (newline parent) + + ;; Check whether the child process' setup phase succeeded. + (let ((message (read parent))) + (close-port parent) + (match message + ('ready ;success + pid) + (((? symbol? key) args ...) ;exception + (apply throw key args)) + (_ ;unexpected termination + #f))))))))) (define* (call-with-container mounts thunk #:key (namespaces %namespaces) (host-uids 1)) diff --git a/tests/containers.scm b/tests/containers.scm index c11cdd1ce5..5a0f9937bb 100644 --- a/tests/containers.scm +++ b/tests/containers.scm @@ -79,6 +79,18 @@ (assert-exit (file-exists? "/testing"))) #:namespaces '(user mnt)))) +(test-equal "call-with-container, mnt namespace, wrong bind mount" + `(system-error ,ENOENT) + ;; An exception should be raised; see <http://bugs.gnu.org/23306>. + (catch 'system-error + (lambda () + (call-with-container '(("/does-not-exist" device "/foo" + "none" (bind-mount) #f #f)) + (const #t) + #:namespaces '(user mnt))) + (lambda args + (list 'system-error (system-error-errno args))))) + (test-assert "call-with-container, all namespaces" (zero? (call-with-container '() diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 0a7ea481fc..5ea6c49263 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -44,6 +44,16 @@ else test $? = 42 fi +# Make sure file-not-found errors in mounts are reported. +if guix environment --container --ad-hoc --bootstrap guile-bootstrap \ + --expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error" +then + false +else + grep "/does-not-exist" "$tmpdir/error" + grep "[Nn]o such file" "$tmpdir/error" +fi + # Make sure that the right directories are mapped. mount_test_code=" (use-modules (ice-9 rdelim) |