summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/linux-container.scm22
-rw-r--r--tests/containers.scm5
-rw-r--r--tests/syscalls.scm11
3 files changed, 32 insertions, 6 deletions
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 556422bc38f..eb5dbf94a31 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -19,16 +19,36 @@
19(define-module (gnu build linux-container) 19(define-module (gnu build linux-container)
20 #:use-module (ice-9 format) 20 #:use-module (ice-9 format)
21 #:use-module (ice-9 match) 21 #:use-module (ice-9 match)
22 #:use-module (ice-9 rdelim)
22 #:use-module (srfi srfi-98) 23 #:use-module (srfi srfi-98)
23 #:use-module (guix utils) 24 #:use-module (guix utils)
24 #:use-module (guix build utils) 25 #:use-module (guix build utils)
25 #:use-module (guix build syscalls) 26 #:use-module (guix build syscalls)
26 #:use-module ((gnu build file-systems) #:select (mount-file-system)) 27 #:use-module ((gnu build file-systems) #:select (mount-file-system))
27 #:export (%namespaces 28 #:export (user-namespace-supported?
29 unprivileged-user-namespace-supported?
30 setgroups-supported?
31 %namespaces
28 run-container 32 run-container
29 call-with-container 33 call-with-container
30 container-excursion)) 34 container-excursion))
31 35
36(define (user-namespace-supported?)
37 "Return #t if user namespaces are supported on this system."
38 (file-exists? "/proc/self/ns/user"))
39
40(define (unprivileged-user-namespace-supported?)
41 "Return #t if user namespaces can be created by unprivileged users."
42 (let ((userns-file "/proc/sys/kernel/unprivileged_userns_clone"))
43 (if (file-exists? userns-file)
44 (string=? "1" (call-with-input-file userns-file read-string))
45 #t)))
46
47(define (setgroups-supported?)
48 "Return #t if the setgroups proc file, introduced in Linux-libre 3.19,
49exists."
50 (file-exists? "/proc/self/setgroups"))
51
32(define %namespaces 52(define %namespaces
33 '(mnt pid ipc uts user net)) 53 '(mnt pid ipc uts user net))
34 54
diff --git a/tests/containers.scm b/tests/containers.scm
index 0ba81491baa..12982a64f7a 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -28,8 +28,9 @@
28 28
29;; Skip these tests unless user namespaces are available and the setgroups 29;; Skip these tests unless user namespaces are available and the setgroups
30;; file (introduced in Linux 3.19 to address a security issue) exists. 30;; file (introduced in Linux 3.19 to address a security issue) exists.
31(unless (and (file-exists? "/proc/self/ns/user") 31(unless (and (user-namespace-supported?)
32 (file-exists? "/proc/self/setgroups")) 32 (unprivileged-user-namespace-supported?)
33 (setgroups-supported?))
33 (exit 77)) 34 (exit 77))
34 35
35(test-begin "containers") 36(test-begin "containers")
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 86783b96c4b..a57a9ca9f9d 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -20,6 +20,7 @@
20(define-module (test-syscalls) 20(define-module (test-syscalls)
21 #:use-module (guix utils) 21 #:use-module (guix utils)
22 #:use-module (guix build syscalls) 22 #:use-module (guix build syscalls)
23 #:use-module (gnu build linux-container)
23 #:use-module (srfi srfi-1) 24 #:use-module (srfi srfi-1)
24 #:use-module (srfi srfi-26) 25 #:use-module (srfi srfi-26)
25 #:use-module (srfi srfi-64) 26 #:use-module (srfi srfi-64)
@@ -80,7 +81,11 @@
80(define (user-namespace pid) 81(define (user-namespace pid)
81 (string-append "/proc/" (number->string pid) "/ns/user")) 82 (string-append "/proc/" (number->string pid) "/ns/user"))
82 83
83(unless (file-exists? (user-namespace (getpid))) 84(define perform-container-tests?
85 (and (user-namespace-supported?)
86 (unprivileged-user-namespace-supported?)))
87
88(unless perform-container-tests?
84 (test-skip 1)) 89 (test-skip 1))
85(test-assert "clone" 90(test-assert "clone"
86 (match (clone (logior CLONE_NEWUSER SIGCHLD)) 91 (match (clone (logior CLONE_NEWUSER SIGCHLD))
@@ -93,7 +98,7 @@
93 ((_ . status) 98 ((_ . status)
94 (= 42 (status:exit-val status)))))))) 99 (= 42 (status:exit-val status))))))))
95 100
96(unless (file-exists? (user-namespace (getpid))) 101(unless perform-container-tests?
97 (test-skip 1)) 102 (test-skip 1))
98(test-assert "setns" 103(test-assert "setns"
99 (match (clone (logior CLONE_NEWUSER SIGCHLD)) 104 (match (clone (logior CLONE_NEWUSER SIGCHLD))
@@ -122,7 +127,7 @@
122 (waitpid fork-pid) 127 (waitpid fork-pid)
123 result)))))))) 128 result))))))))
124 129
125(unless (file-exists? (user-namespace (getpid))) 130(unless perform-container-tests?
126 (test-skip 1)) 131 (test-skip 1))
127(test-assert "pivot-root" 132(test-assert "pivot-root"
128 (match (pipe) 133 (match (pipe)