#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:export (expression->initrd
base-initrd))
(gzip gzip)
(name "guile-initrd")
(system (%current-system))
- (modules '())
- (to-copy '())
- (linux #f)
- (linux-modules '()))
+ (modules '()))
"Return a derivation that builds a Linux initrd (a gzipped cpio archive)
-containing GUILE and that evaluates EXP, a G-expression, upon booting.
+containing GUILE and that evaluates EXP, a G-expression, upon booting. All
+the derivations referenced by EXP are automatically copied to the initrd.
-LINUX-MODULES is a list of '.ko' file names to be copied from LINUX into the
-initrd. TO-COPY is a list of additional derivations or packages to copy to
-the initrd. MODULES is a list of Guile module names to be embedded in the
-initrd."
+MODULES is a list of Guile module names to be embedded in the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `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
- (unfold-right zero?
- number->string
- 1-
- (length to-copy)))
-
+ (mlet %store-monad ((init (gexp->script "init" exp
+ #:modules modules
+ #:guile guile)))
(define builder
- ;; TODO: Move most of this code to (gnu build linux-initrd).
#~(begin
- (use-modules (gnu build linux-initrd)
- (guix build utils)
- (guix build store-copy)
- (system base compile)
- (rnrs bytevectors)
- ((system foreign) #:select (sizeof)))
+ (use-modules (gnu build linux-initrd))
(mkdir #$output)
- (mkdir "contents")
-
- (with-directory-excursion "contents"
- ;; Copy Linux modules.
- (mkdir "modules")
- (copy-recursively #$module-dir "modules")
-
- ;; Populate the initrd's store.
- (with-directory-excursion ".."
- (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
- ;; initrd.
- (for-each (lambda (file)
- (unless (eq? 'symlink (stat:type (lstat file)))
- (utime file 0 0 0 0)))
- (find-files "." ".*"))
-
- (write-cpio-archive (string-append #$output "/initrd") "."
- #:cpio (string-append #$cpio "/bin/cpio")
- #:gzip (string-append #$gzip "/bin/gzip")))))
+ (build-initrd (string-append #$output "/initrd")
+ #:guile #$guile
+ #:init #$init
+ ;; Copy everything INIT refers to into the initrd.
+ #:references-graphs '("closure")
+ #:cpio (string-append #$cpio "/bin/cpio")
+ #:gzip (string-append #$gzip "/bin/gzip"))))
(gexp->derivation name builder
#:modules '((guix build utils)
(guix build store-copy)
(gnu build linux-initrd))
- #:references-graphs (zip graph-files to-copy))))
+ #:references-graphs `(("closure" ,init)))))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
(define build-exp
#~(begin
(use-modules (ice-9 match) (ice-9 regex)
- (guix build utils))
+ (srfi srfi-1)
+ (guix build utils)
+ (gnu build linux-modules))
(define (string->regexp str)
;; Return a regexp that matches STR exactly.
(define module-dir
(string-append #$linux "/lib/modules"))
+ (define (lookup module)
+ (let ((name (ensure-dot-ko module)))
+ (match (find-files module-dir (string->regexp name))
+ ((file)
+ file)
+ (()
+ (error "module not found" name module-dir))
+ ((_ ...)
+ (error "several modules by that name"
+ name module-dir)))))
+
+ (define modules
+ (let ((modules (map lookup '#$modules)))
+ (append modules
+ (recursive-module-dependencies modules
+ #:lookup-module lookup))))
+
(mkdir #$output)
(for-each (lambda (module)
- (match (find-files module-dir (string->regexp module))
- ((file)
- (format #t "copying '~a'...~%" file)
- (copy-file file (string-append #$output "/" module)))
- (()
- (error "module not found" module module-dir))
- ((_ ...)
- (error "several modules by that name"
- module module-dir))))
- '#$modules)))
+ (format #t "copying '~a'...~%" module)
+ (copy-file module
+ (string-append #$output "/"
+ (basename module))))
+ (delete-duplicates modules))))
(gexp->derivation "linux-modules" build-exp
- #:modules '((guix build utils))))
+ #:modules '((guix build utils)
+ (guix elf)
+ (gnu build linux-modules))))
(define (file-system->spec fs)
"Return a list corresponding to file-system FS that can be passed to the
(define* (base-initrd file-systems
#:key
+ (mapped-devices '())
qemu-networking?
virtio?
volatile-root?
- (extra-modules '())
- guile-modules-in-chroot?)
+ (extra-modules '()))
"Return a monadic derivation that builds a generic initrd. FILE-SYSTEMS is
a list of file-systems to be mounted by the initrd, possibly in addition to
the root file system specified on the kernel command line via '--root'.
+MAPPED-DEVICES is a list of device mappings to realize before FILE-SYSTEMS are
+mounted.
When QEMU-NETWORKING? is true, set up networking with the standard QEMU
parameters. When VIRTIO? is true, load additional modules so the initrd can
The initrd is automatically populated with all the kernel modules necessary
for FILE-SYSTEMS and for the given options. However, additional kernel
modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
-loaded at boot time in the order in which they appear.
-
-When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
-the new root. This is necessary is the file specified as '--load' needs
-access to these modules (which is the case if it wants to even just print an
-exception and backtrace!)."
+loaded at boot time in the order in which they appear."
(define virtio-modules
;; Modules for Linux para-virtualized devices, for use in QEMU guests.
- '("virtio.ko" "virtio_ring.ko" "virtio_pci.ko"
- "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko"))
+ '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
+ "virtio_console"))
(define cifs-modules
;; Modules needed to mount CIFS file systems.
- '("md4.ko" "ecb.ko" "cifs.ko"))
+ '("md4" "ecb" "cifs"))
(define virtio-9p-modules
;; Modules for the 9p paravirtualized file system.
- '("fscache.ko" "9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
+ '("9p" "9pnet_virtio"))
(define (file-system-type-predicate type)
(lambda (fs)
(define linux-modules
;; Modules added to the initrd and loaded from the initrd.
- `("libahci.ko" "ahci.ko" ; modules for SATA controllers
+ `("ahci" ;for SATA controllers
+ "pata_acpi" "pata_atiixp" ;for ATA controllers
,@(if (or virtio? qemu-networking?)
virtio-modules
'())
virtio-9p-modules
'())
,@(if volatile-root?
- '("fuse.ko")
+ '("fuse")
'())
,@extra-modules))
(list unionfs-fuse/static)
'())))
- (expression->initrd
- #~(begin
- (use-modules (gnu build linux-boot)
- (guix build utils)
- (srfi srfi-26))
-
- (with-output-to-port (%make-void-port "w")
- (lambda ()
- (set-path-environment-variable "PATH" '("bin" "sbin")
- '#$helper-packages)))
-
- (boot-system #:mounts '#$(map file-system->spec file-systems)
- #:linux-modules '#$linux-modules
- #:qemu-guest-networking? #$qemu-networking?
- #:guile-modules-in-chroot? '#$guile-modules-in-chroot?
- #:volatile-root? '#$volatile-root?))
- #:name "base-initrd"
- #:modules '((guix build utils)
- (gnu build linux-boot)
- (gnu build file-systems))
- #:to-copy helper-packages
- #:linux linux-libre
- #:linux-modules linux-modules))
+ (define device-mapping-commands
+ ;; List of gexps to open the mapped devices.
+ (map (lambda (md)
+ (let* ((source (mapped-device-source md))
+ (target (mapped-device-target md))
+ (type (mapped-device-type md))
+ (open (mapped-device-kind-open type)))
+ (open source target)))
+ mapped-devices))
+
+ (mlet %store-monad ((kodir (flat-linux-module-directory linux-libre
+ linux-modules)))
+ (expression->initrd
+ #~(begin
+ (use-modules (gnu build linux-boot)
+ (guix build utils)
+ (srfi srfi-26))
+
+ (with-output-to-port (%make-void-port "w")
+ (lambda ()
+ (set-path-environment-variable "PATH" '("bin" "sbin")
+ '#$helper-packages)))
+
+ (boot-system #:mounts '#$(map file-system->spec file-systems)
+ #:pre-mount (lambda ()
+ (and #$@device-mapping-commands))
+ #:linux-modules '#$linux-modules
+ #:linux-module-directory '#$kodir
+ #:qemu-guest-networking? #$qemu-networking?
+ #:volatile-root? '#$volatile-root?))
+ #:name "base-initrd"
+ #:modules '((guix build utils)
+ (gnu build linux-boot)
+ (gnu build linux-modules)
+ (gnu build file-systems)
+ (guix elf)))))
;;; linux-initrd.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff