linux-initrd: Copy all the script's closure to the initrd.
* gnu/system/linux-initrd.scm (expression->initrd): Remove calls to 'imported-modules' and 'compiled-modules'. Use 'gexp->script' with EXP. Add the result to TO-COPY. Make /init a symlink to that script, and copy its closure into the "contents" directory. Add fake /proc/self/exe symlink. * gnu/build/linux-boot.scm (load-linux-module*): Add comment about mmap. * gnu/system/vm.scm (system-qemu-image/shared-store-script): Add "-m 256". This turns out to be needed for initrds containing things like e2fsck and several modules; with the default of 128 MiB, loading libahci.ko may fail with -1.master
parent
c2619e10ea
commit
70608adb4a
|
@ -221,6 +221,7 @@ networking values.) Return #t if INTERFACE is up, #f otherwise."
|
||||||
(define (load-linux-module* file)
|
(define (load-linux-module* file)
|
||||||
"Load Linux module from FILE, the name of a `.ko' file."
|
"Load Linux module from FILE, the name of a `.ko' file."
|
||||||
(define (slurp module)
|
(define (slurp module)
|
||||||
|
;; TODO: Use 'mmap' to reduce memory usage.
|
||||||
(call-with-input-file file get-bytevector-all))
|
(call-with-input-file file get-bytevector-all))
|
||||||
|
|
||||||
(load-linux-module (slurp file)))
|
(load-linux-module (slurp file)))
|
||||||
|
|
|
@ -68,69 +68,32 @@ initrd."
|
||||||
;; General Linux overview in `Documentation/early-userspace/README' and
|
;; General Linux overview in `Documentation/early-userspace/README' and
|
||||||
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
|
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
|
||||||
|
|
||||||
|
(mlet* %store-monad ((init (gexp->script "init" exp
|
||||||
|
#:modules modules
|
||||||
|
#:guile guile))
|
||||||
|
(to-copy -> (cons init to-copy))
|
||||||
|
(module-dir (flat-linux-module-directory linux
|
||||||
|
linux-modules)))
|
||||||
(define graph-files
|
(define graph-files
|
||||||
(unfold-right zero?
|
(unfold-right zero?
|
||||||
number->string
|
number->string
|
||||||
1-
|
1-
|
||||||
(length to-copy)))
|
(length to-copy)))
|
||||||
|
|
||||||
(mlet %store-monad ((source (imported-modules modules))
|
|
||||||
(compiled (compiled-modules modules))
|
|
||||||
(module-dir (flat-linux-module-directory linux
|
|
||||||
linux-modules)))
|
|
||||||
(define builder
|
(define builder
|
||||||
;; TODO: Move most of this code to (gnu build linux-initrd).
|
;; TODO: Move most of this code to (gnu build linux-initrd).
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (gnu build linux-initrd)
|
(use-modules (gnu build linux-initrd)
|
||||||
(guix build utils)
|
(guix build utils)
|
||||||
(guix build store-copy)
|
(guix build store-copy)
|
||||||
(ice-9 pretty-print)
|
|
||||||
(ice-9 popen)
|
|
||||||
(ice-9 match)
|
|
||||||
(ice-9 ftw)
|
|
||||||
(srfi srfi-26)
|
|
||||||
(system base compile)
|
(system base compile)
|
||||||
(rnrs bytevectors)
|
(rnrs bytevectors)
|
||||||
((system foreign) #:select (sizeof)))
|
((system foreign) #:select (sizeof)))
|
||||||
|
|
||||||
(let ((modules #$source)
|
|
||||||
(gos #$compiled)
|
|
||||||
(scm-dir (string-append "share/guile/" (effective-version)))
|
|
||||||
(go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
|
|
||||||
(effective-version)
|
|
||||||
(if (eq? (native-endianness) (endianness little))
|
|
||||||
"LE"
|
|
||||||
"BE")
|
|
||||||
(sizeof '*)
|
|
||||||
(effective-version))))
|
|
||||||
(mkdir #$output)
|
(mkdir #$output)
|
||||||
(mkdir "contents")
|
(mkdir "contents")
|
||||||
|
|
||||||
(with-directory-excursion "contents"
|
(with-directory-excursion "contents"
|
||||||
(copy-recursively #$guile ".")
|
|
||||||
(call-with-output-file "init"
|
|
||||||
(lambda (p)
|
|
||||||
(format p "#!/bin/guile -ds~%!#~%" #$guile)
|
|
||||||
(pretty-print '#$exp p)))
|
|
||||||
(chmod "init" #o555)
|
|
||||||
(chmod "bin/guile" #o555)
|
|
||||||
|
|
||||||
;; Copy Guile modules.
|
|
||||||
(chmod scm-dir #o777)
|
|
||||||
(copy-recursively modules scm-dir
|
|
||||||
#:follow-symlinks? #t)
|
|
||||||
(copy-recursively gos (string-append "lib/guile/"
|
|
||||||
(effective-version) "/ccache")
|
|
||||||
#:follow-symlinks? #t)
|
|
||||||
|
|
||||||
;; Compile `init'.
|
|
||||||
(mkdir-p go-dir)
|
|
||||||
(set! %load-path (cons modules %load-path))
|
|
||||||
(set! %load-compiled-path (cons gos %load-compiled-path))
|
|
||||||
(compile-file "init"
|
|
||||||
#:opts %auto-compilation-options
|
|
||||||
#:output-file (string-append go-dir "/init.go"))
|
|
||||||
|
|
||||||
;; Copy Linux modules.
|
;; Copy Linux modules.
|
||||||
(mkdir "modules")
|
(mkdir "modules")
|
||||||
(copy-recursively #$module-dir "modules")
|
(copy-recursively #$module-dir "modules")
|
||||||
|
@ -139,14 +102,43 @@ initrd."
|
||||||
(with-directory-excursion ".."
|
(with-directory-excursion ".."
|
||||||
(populate-store '#$graph-files "contents"))
|
(populate-store '#$graph-files "contents"))
|
||||||
|
|
||||||
|
;; Make '/init'.
|
||||||
|
(symlink #$init "init")
|
||||||
|
|
||||||
|
;; Compile it.
|
||||||
|
(let* ((init (readlink "init"))
|
||||||
|
(scm-dir (string-append "share/guile/" (effective-version)))
|
||||||
|
(go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
|
||||||
|
(effective-version)
|
||||||
|
(if (eq? (native-endianness) (endianness little))
|
||||||
|
"LE"
|
||||||
|
"BE")
|
||||||
|
(sizeof '*)
|
||||||
|
(effective-version)
|
||||||
|
(dirname init))))
|
||||||
|
(mkdir-p go-dir)
|
||||||
|
(compile-file init
|
||||||
|
#:opts %auto-compilation-options
|
||||||
|
#:output-file (string-append go-dir "/"
|
||||||
|
(basename init)
|
||||||
|
".go")))
|
||||||
|
|
||||||
|
;; This hack allows Guile to find out where it is. See
|
||||||
|
;; 'guile-relocatable.patch'.
|
||||||
|
(mkdir-p "proc/self")
|
||||||
|
(symlink (string-append #$guile "/bin/guile") "proc/self/exe")
|
||||||
|
(readlink "proc/self/exe")
|
||||||
|
|
||||||
;; Reset the timestamps of all the files that will make it in the
|
;; Reset the timestamps of all the files that will make it in the
|
||||||
;; initrd.
|
;; initrd.
|
||||||
(for-each (cut utime <> 0 0 0 0)
|
(for-each (lambda (file)
|
||||||
|
(unless (eq? 'symlink (stat:type (lstat file)))
|
||||||
|
(utime file 0 0 0 0)))
|
||||||
(find-files "." ".*"))
|
(find-files "." ".*"))
|
||||||
|
|
||||||
(write-cpio-archive (string-append #$output "/initrd") "."
|
(write-cpio-archive (string-append #$output "/initrd") "."
|
||||||
#:cpio (string-append #$cpio "/bin/cpio")
|
#:cpio (string-append #$cpio "/bin/cpio")
|
||||||
#:gzip (string-append #$gzip "/bin/gzip"))))))
|
#:gzip (string-append #$gzip "/bin/gzip")))))
|
||||||
|
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:modules '((guix build utils)
|
#:modules '((guix build utils)
|
||||||
|
|
|
@ -428,7 +428,9 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
|
||||||
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
|
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
|
||||||
-serial stdio \
|
-serial stdio \
|
||||||
-drive file=" #$image
|
-drive file=" #$image
|
||||||
",if=virtio,cache=writeback,werror=report,readonly\n")
|
",if=virtio,cache=writeback,werror=report,readonly \
|
||||||
|
-m 256
|
||||||
|
\n")
|
||||||
port)
|
port)
|
||||||
(chmod port #o555))))
|
(chmod port #o555))))
|
||||||
|
|
||||||
|
|
Reference in New Issue