build: container: Add feature test predicates.

* gnu/build/linux-container.scm (user-namespace-supported?,
  unprivileged-user-namespace-supported?, setgroups-supported?): New
  procedures.
* tests/container.scm: Use predicates.
* tests/syscalls.scm: Likewise.
This commit is contained in:
David Thompson 2015-11-03 08:32:53 -05:00
parent 9ff7827a21
commit b7d48312bb
3 changed files with 32 additions and 6 deletions

View File

@ -19,16 +19,36 @@
(define-module (gnu build linux-container)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-98)
#:use-module (guix utils)
#:use-module (guix build utils)
#:use-module (guix build syscalls)
#:use-module ((gnu build file-systems) #:select (mount-file-system))
#:export (%namespaces
#:export (user-namespace-supported?
unprivileged-user-namespace-supported?
setgroups-supported?
%namespaces
run-container
call-with-container
container-excursion))
(define (user-namespace-supported?)
"Return #t if user namespaces are supported on this system."
(file-exists? "/proc/self/ns/user"))
(define (unprivileged-user-namespace-supported?)
"Return #t if user namespaces can be created by unprivileged users."
(let ((userns-file "/proc/sys/kernel/unprivileged_userns_clone"))
(if (file-exists? userns-file)
(string=? "1" (call-with-input-file userns-file read-string))
#t)))
(define (setgroups-supported?)
"Return #t if the setgroups proc file, introduced in Linux-libre 3.19,
exists."
(file-exists? "/proc/self/setgroups"))
(define %namespaces
'(mnt pid ipc uts user net))

View File

@ -28,8 +28,9 @@
;; Skip these tests unless user namespaces are available and the setgroups
;; file (introduced in Linux 3.19 to address a security issue) exists.
(unless (and (file-exists? "/proc/self/ns/user")
(file-exists? "/proc/self/setgroups"))
(unless (and (user-namespace-supported?)
(unprivileged-user-namespace-supported?)
(setgroups-supported?))
(exit 77))
(test-begin "containers")

View File

@ -20,6 +20,7 @@
(define-module (test-syscalls)
#:use-module (guix utils)
#:use-module (guix build syscalls)
#:use-module (gnu build linux-container)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
@ -80,7 +81,11 @@
(define (user-namespace pid)
(string-append "/proc/" (number->string pid) "/ns/user"))
(unless (file-exists? (user-namespace (getpid)))
(define perform-container-tests?
(and (user-namespace-supported?)
(unprivileged-user-namespace-supported?)))
(unless perform-container-tests?
(test-skip 1))
(test-assert "clone"
(match (clone (logior CLONE_NEWUSER SIGCHLD))
@ -93,7 +98,7 @@
((_ . status)
(= 42 (status:exit-val status))))))))
(unless (file-exists? (user-namespace (getpid)))
(unless perform-container-tests?
(test-skip 1))
(test-assert "setns"
(match (clone (logior CLONE_NEWUSER SIGCHLD))
@ -122,7 +127,7 @@
(waitpid fork-pid)
result))))))))
(unless (file-exists? (user-namespace (getpid)))
(unless perform-container-tests?
(test-skip 1))
(test-assert "pivot-root"
(match (pipe)