summaryrefslogtreecommitdiff
path: root/guix/scripts/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-02-27 14:55:43 +0100
committerLudovic Courtès <ludo@gnu.org>2018-03-02 13:53:15 +0100
commit424cea8083a4cee63290c80235aed61bd12affb1 (patch)
treeb588b7552e1bcfa83f6304aa6c9d0215c6ee7b75 /guix/scripts/system.scm
parentbc499b113a598c0e7863da9887a4133472985713 (diff)
guix system: Check for the lack of modules in the initrd.
* guix/scripts/system.scm (check-mapped-devices): Take an OS instead of a list of <mapped-device>. Pass #:needed-for-boot? and #:initrd-modules to CHECK. (check-initrd-modules): New procedure. (perform-action): Move 'check-mapped-devices' call first. Add call to 'check-initrd-modules'. * gnu/system/mapped-devices.scm (check-device-initrd-modules): New procedure. (check-luks-device): Add #:initrd-modules and #:needed-for-boot?. Use them to call 'check-device-initrd-modules'.
Diffstat (limited to 'guix/scripts/system.scm')
-rw-r--r--guix/scripts/system.scm67
1 files changed, 56 insertions, 11 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 999ffb010b..ff322ec785 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -41,6 +41,10 @@
#:use-module (gnu build install)
#:autoload (gnu build file-systems)
(find-partition-by-label find-partition-by-uuid)
+ #:autoload (gnu build linux-modules)
+ (device-module-aliases matching-modules)
+ #:autoload (gnu system linux-initrd)
+ (base-initrd default-initrd-modules)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
@@ -624,21 +628,61 @@ any, are available. Raise an error if they're not."
;; Better be safe than sorry.
(exit 1))))
-(define (check-mapped-devices mapped-devices)
+(define (check-mapped-devices os)
"Check that each of MAPPED-DEVICES is valid according to the 'check'
procedure of its type."
+ (define boot-mapped-devices
+ (operating-system-boot-mapped-devices os))
+
+ (define (needed-for-boot? md)
+ (memq md boot-mapped-devices))
+
+ (define initrd-modules
+ (operating-system-initrd-modules os))
+
(for-each (lambda (md)
(let ((check (mapped-device-kind-check
(mapped-device-type md))))
;; We expect CHECK to raise an exception with a detailed
- ;; '&message' if something goes wrong, but handle the case
- ;; where it just returns #f.
- (unless (check md)
- (leave (G_ "~a: invalid '~a' mapped device~%")
- (location->string
- (source-properties->location
- (mapped-device-location md)))))))
- mapped-devices))
+ ;; '&message' if something goes wrong.
+ (check md
+ #:needed-for-boot? (needed-for-boot? md)
+ #:initrd-modules initrd-modules)))
+ (operating-system-mapped-devices os)))
+
+(define (check-initrd-modules os)
+ "Check that modules needed by 'needed-for-boot' file systems in OS are
+available in the initrd. Note that mapped devices are responsible for
+checking this by themselves in their 'check' procedure."
+ (define (file-system-/dev fs)
+ (let ((device (file-system-device fs)))
+ (match (file-system-title fs)
+ ('device device)
+ ('uuid (find-partition-by-uuid device))
+ ('label (find-partition-by-label device)))))
+
+ (define (check-device device location)
+ (let ((modules (delete-duplicates
+ (append-map matching-modules
+ (device-module-aliases device)))))
+ (unless (every (cute member <> (operating-system-initrd-modules os))
+ modules)
+ (raise (condition
+ (&message
+ (message (format #f (G_ "you need these modules \
+in the initrd for ~a:~{ ~a~}")
+ device modules)))
+ (&error-location (location location)))))))
+
+ (define file-systems
+ (filter file-system-needed-for-boot?
+ (operating-system-file-systems os)))
+
+ (for-each (lambda (fs)
+ (check-device (file-system-/dev fs)
+ (source-properties->location
+ (file-system-location fs))))
+ file-systems))
;;;
@@ -730,9 +774,10 @@ output when building a system derivation, such as a disk image."
;; instantiating a broken configuration. Assume that we can only check if
;; running as root.
(when (memq action '(init reconfigure))
+ (check-mapped-devices os)
(when (zero? (getuid))
- (check-file-system-availability (operating-system-file-systems os)))
- (check-mapped-devices (operating-system-mapped-devices os)))
+ (check-file-system-availability (operating-system-file-systems os))
+ (check-initrd-modules os)))
(mlet* %store-monad
((sys (system-derivation-for-action os action