From 89bf140b10ae24755bf9d2b789b945d29ff11937 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 31 Aug 2013 14:52:12 +0200
Subject: [PATCH] gnu: linux-initrd: Make Guile modules accessible in the
 chroot.

* gnu/packages/linux-initrd.scm (qemu-initrd): Add (guix build utils) to
  #:modules, and use it.  Copy .scm and .go files to /root.
* guix/build/linux-initrd.scm (bind-mount): New procedure.
---
 gnu/packages/linux-initrd.scm | 25 +++++++++++++++++++++----
 guix/build/linux-initrd.scm   |  7 +++++++
 2 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
index 2ed52e60f0..f1e488ad69 100644
--- a/gnu/packages/linux-initrd.scm
+++ b/gnu/packages/linux-initrd.scm
@@ -242,6 +242,7 @@ (define-public qemu-initrd
                    (srfi srfi-26)
                    (ice-9 match)
                    ((system base compile) #:select (compile-file))
+                   (guix build utils)
                    (guix build linux-initrd))
 
       (display "Welcome, this is GNU's early boot Guile.\n")
@@ -278,8 +279,7 @@ (define-public qemu-initrd
         (mount-essential-file-systems #:root "/root")
 
         (mkdir "/root/xchg")
-        (mkdir "/root/nix")
-        (mkdir "/root/nix/store")
+        (mkdir-p "/root/nix/store")
 
         (mkdir "/root/dev")
         (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3))
@@ -289,6 +289,19 @@ (define-public qemu-initrd
         (mount-qemu-smb-share "/store" "/root/nix/store")
         (mount-qemu-smb-share "/xchg" "/root/xchg")
 
+        ;; Copy the directories that contain .scm and .go files so that the
+        ;; child process in the chroot can load modules (we would bind-mount
+        ;; them but for some reason that fails with EINVAL -- XXX).
+        (mkdir "/root/share")
+        (mkdir "/root/lib")
+        (mount "none" "/root/share" "tmpfs")
+        (mount "none" "/root/lib" "tmpfs")
+        (copy-recursively "/share" "/root/share"
+                          #:log (%make-void-port "w"))
+        (copy-recursively "/lib" "/root/lib"
+                          #:log (%make-void-port "w"))
+
+
         (if to-load
             (begin
               (format #t "loading boot file '~a'...\n" to-load)
@@ -298,7 +311,10 @@ (define-public qemu-initrd
               (match (primitive-fork)
                 (0
                  (chroot "/root")
-                 (load-compiled "/loader.go"))
+                 (load-compiled "/loader.go")
+
+                 ;; TODO: Remove /lib, /share, and /loader.go.
+                 )
                 (pid
                  (format #t "boot file loaded under PID ~a~%" pid)
                  (let ((status (waitpid pid)))
@@ -308,7 +324,8 @@ (define-public qemu-initrd
               (display "entering a warm and cozy REPL\n")
               ((@ (system repl repl) start-repl))))))
    #:name "qemu-initrd"
-   #:modules '((guix build linux-initrd))
+   #:modules '((guix build utils)
+               (guix build linux-initrd))
    #:linux linux-libre
    #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
 
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 274eef7ff3..81f9e46cfb 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -23,6 +23,7 @@ (define-module (guix build linux-initrd)
             linux-command-line
             configure-qemu-networking
             mount-qemu-smb-share
+            bind-mount
             load-linux-module*
             device-number))
 
@@ -92,6 +93,12 @@ (define (mount-qemu-smb-share share mount-point)
     (mount (string-append "//" server share) mount-point "cifs" 0
            (string->pointer "guest,sec=none"))))
 
+(define (bind-mount source target)
+  "Bind-mount SOURCE at TARGET."
+  (define MS_BIND 4096)                           ; from libc's <sys/mount.h>
+
+  (mount source target "" MS_BIND))
+
 (define (load-linux-module* file)
   "Load Linux module from FILE, the name of a `.ko' file."
   (define (slurp module)