06/14: build: syscalls: Add pivot-root.

[David Thompson]

davexunit pushed a commit to branch wip-container
in repository guix.

commit 44cdb7c2a26ce9d2bf32e137432b0c4d7c3169dd
Author: David Thompson <address@hidden>
Date:   Thu Jun 25 20:17:46 2015 -0400

    build: syscalls: Add pivot-root.
    
    * guix/build/syscalls.scm (pivot-root): New procedure.
---
 guix/build/syscalls.scm |   15 +++++++++++++++
 1 files changed, 15 insertions(+), 0 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index d877a12..f325837 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -45,6 +45,7 @@
             swapon
             swapoff
             processes
+            pivot-root
 
             CLONE_NEWNS
             CLONE_NEWUTS
@@ -276,6 +277,20 @@ user-land process."
                     (scandir "/proc"))
         <))
 
+(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)))))))
+
 ;; Linux clone flags, from linux/sched.h
 (define CLONE_NEWNS   #x00020000)
 (define CLONE_NEWUTS  #x04000000)