summaryrefslogtreecommitdiff
path: root/gnu/system
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 /gnu/system
parentbc499b113a598c0e7863da9887a4133472985713 (diff)
downloadpatches-424cea8083a4cee63290c80235aed61bd12affb1.tar
patches-424cea8083a4cee63290c80235aed61bd12affb1.tar.gz
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 'gnu/system')
-rw-r--r--gnu/system/mapped-devices.scm53
1 files changed, 40 insertions, 13 deletions
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index dbeb0d3436..5ceb5e658c 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
;;;
@@ -30,9 +30,12 @@
#:use-module (gnu services shepherd)
#:use-module (gnu system uuid)
#:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
+ #:autoload (gnu build linux-modules)
+ (device-module-aliases matching-modules)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -151,19 +154,43 @@
#~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"close" #$target)))
-(define (check-luks-device md)
+(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."
+ (let ((modules (delete-duplicates
+ (append-map matching-modules
+ (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)))
+ (&error-location
+ (location (source-properties->location location))))))))
+
+(define* (check-luks-device md #:key
+ needed-for-boot?
+ (initrd-modules '())
+ #:allow-other-keys
+ #:rest rest)
"Ensure the source of MD is valid."
- (let ((source (mapped-device-source md)))
- (or (not (uuid? source))
- (not (zero? (getuid)))
- (find-partition-by-luks-uuid (uuid-bytevector source))
- (raise (condition
- (&message
- (message (format #f (G_ "no LUKS partition with UUID '~a'")
- (uuid->string source))))
- (&error-location
- (location (source-properties->location
- (mapped-device-location md)))))))))
+ (let ((source (mapped-device-source md))
+ (location (mapped-device-location md)))
+ (or (not (zero? (getuid)))
+ (if (uuid? source)
+ (match (find-partition-by-luks-uuid (uuid-bytevector source))
+ (#f
+ (raise (condition
+ (&message
+ (message (format #f (G_ "no LUKS partition with UUID '~a'")
+ (uuid->string source))))
+ (&error-location
+ (location (source-properties->location
+ (mapped-device-location md)))))))
+ ((? string? device)
+ (check-device-initrd-modules device initrd-modules location)))
+ (check-device-initrd-modules source initrd-modules location)))))
(define luks-device-mapping
;; The type of LUKS mapped devices.