diff options
| -rw-r--r-- | gnu/build/linux-container.scm | 22 | ||||
| -rw-r--r-- | tests/containers.scm | 5 | ||||
| -rw-r--r-- | tests/syscalls.scm | 11 |
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, | ||
| 49 | exists." | ||
| 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) |
