me
/
guix
Archived
1
0
Fork 0

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
Ludovic Courtès 2014-09-08 22:26:05 +02:00
parent c2619e10ea
commit 70608adb4a
3 changed files with 56 additions and 61 deletions

View File

@ -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)))

View 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)

View File

@ -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))))