linux-initrd: Factorize 'check-device-initrd-modules'.

* gnu/system/mapped-devices.scm (check-device-initrd-modules): Move to...
* gnu/system/linux-initrd.scm (check-device-initrd-modules): ... here.
New procedure.
* po/guix/POTFILES.in: Add it.
* guix/scripts/system.scm (check-initrd-modules)[check-device]: Remove.
Use 'check-device-initrd-modules' instead.
This commit is contained in:
Ludovic Courtès 2018-03-07 10:41:06 +01:00
parent 6c4458172d
commit ca23693d28
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 31 additions and 36 deletions

View file

@ -24,6 +24,7 @@ (define-module (gnu system linux-initrd)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix i18n)
#:use-module ((guix store) #:use-module ((guix store)
#:select (%store-prefix)) #:select (%store-prefix))
#:use-module ((guix derivations) #:use-module ((guix derivations)
@ -37,16 +38,22 @@ (define-module (gnu system linux-initrd)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices) #:use-module (gnu system mapped-devices)
#:autoload (gnu build linux-modules)
(device-module-aliases matching-modules)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (expression->initrd #:export (expression->initrd
%base-initrd-modules %base-initrd-modules
raw-initrd raw-initrd
file-system-packages file-system-packages
base-initrd)) base-initrd
check-device-initrd-modules))
;;; Commentary: ;;; Commentary:
@ -343,4 +350,19 @@ (define helper-packages
#:volatile-root? volatile-root? #:volatile-root? volatile-root?
#:on-error on-error)) #: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."
(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))))))))
;;; linux-initrd.scm ends here ;;; linux-initrd.scm ends here

View file

@ -29,9 +29,9 @@ (define-module (gnu system mapped-devices)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
#:use-module ((gnu system linux-initrd)
#:select (check-device-initrd-modules))
#:autoload (gnu build file-systems) (find-partition-by-luks-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 cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static) #:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -154,21 +154,6 @@ (define (close-luks-device source target)
#~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup") #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
"close" #$target))) "close" #$target)))
(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 (define* (check-luks-device md #:key
needed-for-boot? needed-for-boot?
(initrd-modules '()) (initrd-modules '())

View file

@ -43,8 +43,7 @@ (define-module (guix scripts system)
(find-partition-by-label find-partition-by-uuid) (find-partition-by-label find-partition-by-uuid)
#:autoload (gnu build linux-modules) #:autoload (gnu build linux-modules)
(device-module-aliases matching-modules) (device-module-aliases matching-modules)
#:autoload (gnu system linux-initrd) #:use-module (gnu system linux-initrd)
(base-initrd default-initrd-modules)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu bootloader) #:use-module (gnu bootloader)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
@ -661,27 +660,15 @@ (define (file-system-/dev fs)
('uuid (find-partition-by-uuid device)) ('uuid (find-partition-by-uuid device))
('label (find-partition-by-label 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 (define file-systems
(filter file-system-needed-for-boot? (filter file-system-needed-for-boot?
(operating-system-file-systems os))) (operating-system-file-systems os)))
(for-each (lambda (fs) (for-each (lambda (fs)
(check-device (file-system-/dev fs) (check-device-initrd-modules (file-system-/dev fs)
(source-properties->location (operating-system-initrd-modules os)
(file-system-location fs)))) (source-properties->location
(file-system-location fs))))
file-systems)) file-systems))

View file

@ -5,6 +5,7 @@ gnu/packages.scm
gnu/services.scm gnu/services.scm
gnu/system.scm gnu/system.scm
gnu/services/shepherd.scm gnu/services/shepherd.scm
gnu/system/linux-initrd.scm
gnu/system/shadow.scm gnu/system/shadow.scm
guix/scripts.scm guix/scripts.scm
guix/scripts/build.scm guix/scripts/build.scm