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:
parent
9ff7827a21
commit
b7d48312bb
@ -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))
|
||||
|
||||
|
@ -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")
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user