diff options
Diffstat (limited to 'gnu/system/linux-initrd.scm')
| -rw-r--r-- | gnu/system/linux-initrd.scm | 164 |
1 files changed, 112 insertions, 52 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 330438bce4..410484390c 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -24,6 +24,7 @@ #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix utils) + #:use-module (guix i18n) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix derivations) @@ -37,14 +38,22 @@ #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) #:use-module (gnu system mapped-devices) + #:autoload (gnu build linux-modules) + (device-module-aliases matching-modules known-module-aliases) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) + #:use-module (ice-9 format) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (expression->initrd + %base-initrd-modules raw-initrd file-system-packages - base-initrd)) + base-initrd + check-device-initrd-modules)) ;;; Commentary: @@ -242,14 +251,71 @@ FILE-SYSTEMS." (list btrfs-progs/static) '()))) +(define-syntax vhash ;TODO: factorize + (syntax-rules (=>) + "Build a vhash with the given key/value mappings." + ((_) + vlist-null) + ((_ (key others ... => value) rest ...) + (vhash-cons key value + (vhash (others ... => value) rest ...))) + ((_ (=> value) rest ...) + (vhash rest ...)))) + +(define-syntax lookup-procedure + (syntax-rules (else) + "Return a procedure that lookups keys in the given dictionary." + ((_ mapping ... (else default)) + (let ((table (vhash mapping ...))) + (lambda (key) + (match (vhash-assoc key table) + (#f default) + ((key . value) value))))))) + +(define file-system-type-modules + ;; Given a file system type, return the list of modules it needs. + (lookup-procedure ("cifs" => '("md4" "ecb" "cifs")) + ("9p" => '("9p" "9pnet_virtio")) + ("btrfs" => '("btrfs")) + ("iso9660" => '("isofs")) + (else '()))) + +(define (file-system-modules file-systems) + "Return the list of Linux modules needed to mount FILE-SYSTEMS." + (append-map (compose file-system-type-modules file-system-type) + file-systems)) + +(define* (default-initrd-modules #:optional (system (%current-system))) + "Return the list of modules included in the initrd by default." + (define virtio-modules + ;; Modules for Linux para-virtualized devices, for use in QEMU guests. + '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" + "virtio_console")) + + `("ahci" ;for SATA controllers + "usb-storage" "uas" ;for the installation image etc. + "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot + "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions + "nls_iso8859-1" ;for `mkfs.fat`, et.al + ,@(if (string-match "^(x86_64|i[3-6]86)-" system) + '("pata_acpi" "pata_atiixp" ;for ATA controllers + "isci") ;for SAS controllers like Intel C602 + '()) + + ,@virtio-modules)) + +(define-syntax %base-initrd-modules + ;; This more closely matches our naming convention. + (identifier-syntax (default-initrd-modules))) + (define* (base-initrd file-systems #:key (linux linux-libre) + (linux-modules '()) (mapped-devices '()) qemu-networking? volatile-root? - (virtio? #t) - (extra-modules '()) + (extra-modules '()) ;deprecated (on-error 'debug)) "Return a monadic derivation that builds a generic initrd, with kernel modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be @@ -259,57 +325,14 @@ mappings to realize before FILE-SYSTEMS are mounted. QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd. -When VIRTIO? is true, load additional modules so the initrd can -be used as a QEMU guest with the root file system on a para-virtualized block -device. - 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 +for FILE-SYSTEMS and for the given options. Additional kernel +modules can be listed in LINUX-MODULES. They will be added to the initrd, and 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_pci" "virtio_balloon" "virtio_blk" "virtio_net" - "virtio_console")) - - (define cifs-modules - ;; Modules needed to mount CIFS file systems. - '("md4" "ecb" "cifs")) - - (define virtio-9p-modules - ;; Modules for the 9p paravirtualized file system. - '("9p" "9pnet_virtio")) - - (define (file-system-type-predicate type) - (lambda (fs) - (string=? (file-system-type fs) type))) - - (define linux-modules + (define linux-modules* ;; Modules added to the initrd and loaded from the initrd. - `("ahci" ;for SATA controllers - "usb-storage" "uas" ;for the installation image etc. - "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot - "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions - "nls_iso8859-1" ;for `mkfs.fat`, et.al - ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system)) - '("pata_acpi" "pata_atiixp" ;for ATA controllers - "isci") ;for SAS controllers like Intel C602 - '()) - ,@(if (or virtio? qemu-networking?) - virtio-modules - '()) - ,@(if (find (file-system-type-predicate "cifs") file-systems) - cifs-modules - '()) - ,@(if (find (file-system-type-predicate "9p") file-systems) - virtio-9p-modules - '()) - ,@(if (find (file-system-type-predicate "btrfs") file-systems) - '("btrfs") - '()) - ,@(if (find (file-system-type-predicate "iso9660") file-systems) - '("isofs") - '()) + `(,@linux-modules + ,@(file-system-modules file-systems) ,@(if volatile-root? '("overlay") '()) @@ -320,11 +343,48 @@ loaded at boot time in the order in which they appear." (raw-initrd file-systems #:linux linux - #:linux-modules linux-modules + #:linux-modules linux-modules* #:mapped-devices mapped-devices #:helper-packages helper-packages #:qemu-networking? qemu-networking? #:volatile-root? volatile-root? #:on-error on-error)) +(define (check-device-initrd-modules device linux-modules location) + "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate. +DEVICE must be a \"/dev\" file name." + (define aliases + ;; Attempt to load 'modules.alias' from the current kernel, assuming we're + ;; on GuixSD, and assuming that corresponds to the kernel we'll be + ;; installing. Skip the whole thing if that file cannot be read. + (catch 'system-error + (lambda () + (known-module-aliases)) + (const #f))) + + (when aliases + (let ((modules (delete-duplicates + (append-map (cut matching-modules <> aliases) + (device-module-aliases device))))) + (unless (every (cute member <> linux-modules) modules) + (raise (condition + (&message + (message (format #f (G_ "you may need these modules \ +in the initrd for ~a:~{ ~a~}") + device modules))) + (&fix-hint + (hint (format #f (G_ "Try adding them to the +@code{initrd-modules} field of your @code{operating-system} declaration, along +these lines: + +@example + (operating-system + ;; @dots{} + (initrd-modules (append (list~{ ~s~}) + %base-initrd-modules))) +@end example\n") + modules))) + (&error-location + (location (source-properties->location location))))))))) + ;;; linux-initrd.scm ends here |