mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
6c4458172d
commit
ca23693d28
4 changed files with 31 additions and 36 deletions
|
@ -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
|
||||||
|
|
|
@ -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 '())
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue