From ca23693d280de5c4031058da4d3041d830080484 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 7 Mar 2018 10:41:06 +0100 Subject: 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. --- gnu/system/linux-initrd.scm | 24 +++++++++++++++++++++++- gnu/system/mapped-devices.scm | 19 ++----------------- guix/scripts/system.scm | 23 +++++------------------ po/guix/POTFILES.in | 1 + 4 files changed, 31 insertions(+), 36 deletions(-) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index e0cb59c009..d75caed83e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -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 diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 5ceb5e658c..e6ac635231 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -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 '()) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ff322ec785..acfccce96d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -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)) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 6510b99e8f..ba09605375 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -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 -- cgit v1.2.3