[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 07/15] build: syscalls: Add pivot-root.
From: |
David Thompson |
Subject: |
[PATCH 07/15] build: syscalls: Add pivot-root. |
Date: |
Mon, 6 Jul 2015 09:16:36 -0400 |
From: David Thompson <address@hidden>
* guix/build/syscalls.scm (pivot-root): New procedure.
* tests/syscalls.scm: Test it.
---
guix/build/syscalls.scm | 15 +++++++++++++++
tests/syscalls.scm | 24 ++++++++++++++++++++++++
2 files changed, 39 insertions(+)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 827a79d..e319368 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -46,6 +46,7 @@
swapoff
processes
mkdtemp!
+ pivot-root
CLONE_NEWNS
CLONE_NEWUTS
@@ -326,6 +327,20 @@ reassociated with, or 0 if there is no such limitation."
(list fdes nstype (strerror err))
(list err)))))))
+(define pivot-root
+ (let* ((ptr (dynamic-func "pivot_root" (dynamic-link)))
+ (proc (pointer->procedure int ptr (list '* '*))))
+ (lambda (new-root put-old)
+ "Change the root file system to NEW-ROOT and move the current root file
+system to PUT-OLD."
+ (let ((ret (proc (string->pointer new-root)
+ (string->pointer put-old)))
+ (err (errno)))
+ (unless (zero? ret)
+ (throw 'system-error "pivot_root" "~S ~S: ~A"
+ (list new-root put-old (strerror err))
+ (list err)))))))
+
;;;
;;; Packed structures.
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 80d2788..e34d37d 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)
@@ -112,6 +113,29 @@
(equal? (readlink (user-namespace clone-pid))
(readlink (user-namespace fork-pid))))))))))
+(test-assert "pivot-root"
+ (match (pipe)
+ ((in . out)
+ (match (clone (logior CLONE_NEWUSER CLONE_NEWNS))
+ (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)
+ (read in))))))
+
(test-assert "all-network-interfaces"
(match (all-network-interfaces)
(((? string? names) ..1)
--
2.4.3
- [PATCH 03/15] build: syscalls: Add mkdtemp!, (continued)
- [PATCH 07/15] build: syscalls: Add pivot-root.,
David Thompson <=
[PATCH 06/15] build: syscalls: Add setns syscall wrapper., David Thompson, 2015/07/06
[PATCH 10/15] gnu: system: Move file-system->spec to (gnu system file-systems)., David Thompson, 2015/07/06
[PATCH 09/15] gnu: system: Move <file-system-mapping> into (gnu system file-systems)., David Thompson, 2015/07/06