ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-26 12:39:36 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build: container: Add feature test predicates.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

22
gnu/build/linux-container.scm
View file

@ -19,16 +19,36 @@
(define-module (gnu build linux-container) (define-module (gnu build linux-container)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-98) #:use-module (srfi srfi-98)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module ((gnu build file-systems) #:select (mount-file-system)) #: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 run-container
call-with-container call-with-container
container-excursion)) 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 (define %namespaces
'(mnt pid ipc uts user net)) '(mnt pid ipc uts user net))

5
tests/containers.scm
View file

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

11
tests/syscalls.scm
View file

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