From df3ce5c123929b690672cfc6adb3323a8033ec44 Mon Sep 17 00:00:00 2001
From: David Thompson <davet@gnu.org>
Date: Thu, 25 Jun 2015 20:17:46 -0400
Subject: build: syscalls: Add pivot-root.

* guix/build/syscalls.scm (pivot-root): New procedure.
* tests/syscalls.scm ("pivot-root"): New test.
---
 tests/syscalls.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'tests/syscalls.scm')

diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 9b8ac9e603..8598f747f1 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -18,6 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-syscalls)
+  #:use-module (guix utils)
   #:use-module (guix build syscalls)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -117,6 +118,34 @@
              (waitpid fork-pid)
              result))))))))
 
+(test-assert "pivot-root"
+  (match (pipe)
+    ((in . out)
+     (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
+       (0
+        (close in)
+        (call-with-temporary-directory
+         (lambda (root)
+           (let ((put-old (string-append root "/real-root")))
+             (mount "none" root "tmpfs")
+             (mkdir put-old)
+             (call-with-output-file (string-append root "/test")
+               (lambda (port)
+                 (display "testing\n" port)))
+             (pivot-root root put-old)
+             ;; The test file should now be located inside the root directory.
+             (write (file-exists? "/test") out)
+             (close out))))
+        (primitive-exit 0))
+       (pid
+        (close out)
+        (let ((result (read in)))
+          (close in)
+          (and (zero? (match (waitpid pid)
+                        ((_ . status)
+                         (status:exit-val status))))
+               (eq? #t result))))))))
+
 (test-assert "all-network-interfaces"
   (match (all-network-interfaces)
     (((? string? names) ..1)
-- 
cgit v1.2.3