03/08: linux-initrd: Factorize 'check-device-initrd-modules'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit ca23693d280de5c4031058da4d3041d830080484
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 7 10:41:06 2018 +0100

    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 e0cb59c..d75caed 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -24,6 +24,7 @@
   #: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 @@
                 #: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 @@ loaded at boot time in the order in which they appear."
               #: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 5ceb5e6..e6ac635 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -29,9 +29,9 @@
   #: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 @@
   #~(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 ff322ec..acfccce 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -43,8 +43,7 @@
                  (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 @@ checking this by themselves in their 'check' procedure."
         ('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 6510b99..ba09605 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