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.
---
 guix/build/syscalls.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'guix/build')

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3f0a0c92f8..dcca5fc339 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -46,6 +46,7 @@
             swapoff
             processes
             mkdtemp!
+            pivot-root
 
             CLONE_NEWNS
             CLONE_NEWUTS
@@ -329,6 +330,20 @@ 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.
-- 
cgit v1.2.3