diff options
| -rw-r--r-- | gnu/packages/linux-initrd.scm | 25 | ||||
| -rw-r--r-- | 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 @@ the Linux kernel.") (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 @@ the Linux kernel.") (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 @@ the Linux kernel.") (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 @@ the Linux kernel.") (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 @@ the Linux kernel.") (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 @@ linux-command-line configure-qemu-networking mount-qemu-smb-share + bind-mount load-linux-module* device-number)) @@ -92,6 +93,12 @@ Vanilla QEMU's `-smb' option just exports a /qemu share, whereas our (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) |