container: Gracefully report mount errors in the child process.

Fixes <http://bugs.gnu.org/23306>.

* gnu/build/linux-container.scm (run-container): Use 'socketpair'
instead of 'pipe'.  Rename 'in' to 'child' and 'out' to 'parent'.  Send
a 'ready message or an exception argument list from the child to the
parent; adjust the parent accordingly.
* tests/containers.scm ("call-with-container, mnt namespace, wrong bind
mount"): New test.
* tests/guix-environment-container.sh: Add test with
--expose=/does-not-exist.
This commit is contained in:
Ludovic Courtès 2016-05-30 22:44:58 +02:00
parent 4c14d4eaa7
commit c06f6db7a4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 52 additions and 12 deletions

View file

@ -205,35 +205,53 @@ (define (run-container root mounts namespaces host-uids thunk)
;; 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)
(catch #t
(lambda ()
(mount-file-systems root mounts
#:mount-/proc? (memq 'pid namespaces)
#:mount-/sys? (memq 'net 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))

View file

@ -79,6 +79,18 @@ (define (assert-exit x)
(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 '()

View file

@ -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)