From 45e501c051fe5e7f5116c44c44832af14b775527 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 7 Sep 2015 15:38:08 -0400
Subject: [PATCH] tests: Detect when user namespaces are disabled for
 unprivileged users.

* guix/tests.scm (%user-namespaces?): New variable.
* tests/containers.scm: Skip tests unless user can create user namespaces.
* tests/syscalls.scm: Likewise for clone, setns, and pivot-root tests.
---
 guix/tests.scm       | 13 ++++++++++++-
 tests/containers.scm |  3 ++-
 tests/syscalls.scm   | 10 ++++++----
 3 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/guix/tests.scm b/guix/tests.scm
index cd8eda2..4634323 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -41,7 +41,8 @@
             with-derivation-narinfo
             with-derivation-substitute
             dummy-package
-            dummy-origin))
+            dummy-origin
+            %user-namespaces?))
 
 ;;; Commentary:
 ;;;
@@ -259,6 +260,16 @@ default values, and with EXTRA-FIELDS set as specified."
           (method #f) (uri "http://www.example.com")
           (sha256 (base32 (make-string 52 #\x)))))
 
+;; User namespaces are only available on more recent versions of Linux, and
+;; some systems do not allow unprivileged users to create them.
+(define %user-namespaces?
+  (and (file-exists? "/proc/self/ns/user")
+       (or (zero? (getuid)) ; root is OK
+           (let ((config-file "/proc/sys/kernel/unprivileged_userns_clone"))
+             (if (file-exists? config-file)
+                 (string=? (call-with-input-file config-file read-string) "1")
+                 #t)))))
+
 ;; Local Variables:
 ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
 ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2)
diff --git a/tests/containers.scm b/tests/containers.scm
index 4783f8e..25e908b 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-containers)
+  #:use-module (guix tests)
   #:use-module (guix utils)
   #:use-module (guix build syscalls)
   #:use-module (gnu build linux-container)
@@ -28,7 +29,7 @@
 
 ;; 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")
+(unless (and %user-namespaces?
              (file-exists? "/proc/self/setgroups"))
   (exit 77))
 
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 86783b9..a58b41e 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -18,12 +18,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-syscalls)
+  #:use-module (guix tests)
   #:use-module (guix utils)
   #:use-module (guix build syscalls)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim))
 
 ;; Test the (guix build syscalls) module, although there's not much that can
 ;; actually be tested without being root.
@@ -80,7 +82,7 @@
 (define (user-namespace pid)
   (string-append "/proc/" (number->string pid) "/ns/user"))
 
-(unless (file-exists? (user-namespace (getpid)))
+(unless %user-namespaces?
   (test-skip 1))
 (test-assert "clone"
   (match (clone (logior CLONE_NEWUSER SIGCHLD))
@@ -93,7 +95,7 @@
             ((_ . status)
              (= 42 (status:exit-val status))))))))
 
-(unless (file-exists? (user-namespace (getpid)))
+(unless %user-namespaces?
   (test-skip 1))
 (test-assert "setns"
   (match (clone (logior CLONE_NEWUSER SIGCHLD))
@@ -122,7 +124,7 @@
              (waitpid fork-pid)
              result))))))))
 
-(unless (file-exists? (user-namespace (getpid)))
+(unless %user-namespaces?
   (test-skip 1))
 (test-assert "pivot-root"
   (match (pipe)
-- 
2.5.0