ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

24
gnu/system/linux-initrd.scm
View file

@ -24,6 +24,7 @@ (define-module (gnu system linux-initrd)
#: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,16 +38,22 @@ (define-module (gnu system linux-initrd)
#: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)
#: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:
@ -343,4 +350,19 @@ (define helper-packages
#: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."
(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

19
gnu/system/mapped-devices.scm
View file

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

23
guix/scripts/system.scm
View file

@ -43,8 +43,7 @@ (define-module (guix scripts system)
(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 linux-initrd)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
@ -661,27 +660,15 @@ (define (file-system-/dev fs)
('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))))
(check-device-initrd-modules (file-system-/dev fs)
(operating-system-initrd-modules os)
(source-properties->location
(file-system-location fs))))
file-systems))

1
po/guix/POTFILES.in
View file

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