diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-05-01 23:11:41 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-05-01 23:11:41 +0200 |
commit | 3b458d5462e6bbd852c2dc5c6670d5655abf53f5 (patch) | |
tree | 4f3ccec0de1c355134369333c17e948e3258d546 /gnu/installer/parted.scm | |
parent | 2ca3fdc2db1aef96fbf702a2f26f5e18ce832038 (diff) | |
parent | 14da3daafc8dd92fdabd3367694c930440fd72cb (diff) | |
download | guix-patches-3b458d5462e6bbd852c2dc5c6670d5655abf53f5.tar guix-patches-3b458d5462e6bbd852c2dc5c6670d5655abf53f5.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/installer/parted.scm')
-rw-r--r-- | gnu/installer/parted.scm | 55 |
1 files changed, 45 insertions, 10 deletions
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 642b8c6d8a..7cc2217cbe 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,10 @@ #:use-module ((gnu build file-systems) #:select (read-partition-uuid read-luks-partition-uuid)) + #:use-module ((gnu build linux-modules) + #:select (missing-modules)) + #:use-module ((gnu system linux-initrd) + #:select (%base-initrd-modules)) #:use-module (guix build syscalls) #:use-module (guix build utils) #:use-module (guix records) @@ -1243,22 +1248,51 @@ from (gnu system mapped-devices) and return it." (target ,label) (type luks-device-mapping)))) +(define (root-user-partition? partition) + "Return true if PARTITION is the root partition." + (let ((mount-point (user-partition-mount-point partition))) + (and mount-point + (string=? mount-point "/")))) + (define (bootloader-configuration user-partitions) "Return the bootloader configuration field for USER-PARTITIONS." - (let* ((root-partition - (find (lambda (user-partition) - (let ((mount-point - (user-partition-mount-point user-partition))) - (and mount-point - (string=? mount-point "/")))) - user-partitions)) + (let* ((root-partition (find root-user-partition? + user-partitions)) (root-partition-disk (user-partition-disk-file-name root-partition))) `((bootloader-configuration ,@(if (efi-installation?) `((bootloader grub-efi-bootloader) (target ,(default-esp-mount-point))) `((bootloader grub-bootloader) - (target ,root-partition-disk))))))) + (target ,root-partition-disk))) + + ;; XXX: Assume we defined the 'keyboard-layout' field of + ;; <operating-system> right above. + (keyboard-layout keyboard-layout))))) + +(define (user-partition-missing-modules user-partitions) + "Return the list of kernel modules missing from the default set of kernel +modules to access USER-PARTITIONS." + (let ((devices (filter user-partition-crypt-label user-partitions)) + (root (find root-user-partition? user-partitions))) + (delete-duplicates + (append-map (lambda (device) + (catch 'system-error + (lambda () + (missing-modules device %base-initrd-modules)) + (const '()))) + (delete-duplicates + (map user-partition-file-name + (cons root devices))))))) + +(define (initrd-configuration user-partitions) + "Return an 'initrd-modules' field with everything needed for +USER-PARTITIONS, or return nothing." + (match (user-partition-missing-modules user-partitions) + (() + '()) + ((modules ...) + `((initrd-modules ',modules))))) (define (user-partitions->configuration user-partitions) "Return the configuration field for USER-PARTITIONS." @@ -1266,10 +1300,11 @@ from (gnu system mapped-devices) and return it." (swap-devices (map user-partition-file-name swap-user-partitions)) (encrypted-partitions (filter user-partition-crypt-label user-partitions))) - `(,@(if (null? swap-devices) + `((bootloader ,@(bootloader-configuration user-partitions)) + ,@(initrd-configuration user-partitions) + ,@(if (null? swap-devices) '() `((swap-devices (list ,@swap-devices)))) - (bootloader ,@(bootloader-configuration user-partitions)) ,@(if (null? encrypted-partitions) '() `((mapped-devices |