03/06: linux-modules: Factorize 'missing-modules'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 4cd386afae444f3ee603cd07d282b2eee3253555
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 13 17:11:19 2019 +0100

    linux-modules: Factorize 'missing-modules'.
    
    * gnu/build/linux-modules.scm (missing-modules): New procedure.
    * gnu/system/mapped-devices.scm (check-device-initrd-modules): Use it.
---
 gnu/build/linux-modules.scm   | 27 +++++++++++++++++++--
 gnu/system/mapped-devices.scm | 55 +++++++++++++++++--------------------------
 2 files changed, 47 insertions(+), 35 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index d99d1f0..c66ef97 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -47,7 +47,8 @@
 
             device-module-aliases
             known-module-aliases
-            matching-modules))
+            matching-modules
+            missing-modules))
 
 ;;; Commentary:
 ;;;
@@ -463,4 +464,26 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
                       module)))
               known-aliases))
 
+(define* (missing-modules device modules-provided)
+  "Assuming MODULES-PROVIDED lists kernel modules that are already
+provided--e.g., in the initrd, return the list of missing kernel modules that
+are required to access DEVICE."
+  (define aliases
+    ;; Attempt to load 'modules.alias' from the current kernel, assuming we're
+    ;; on Guix System, and assuming that corresponds to the kernel we'll be
+    ;; installing.
+    (known-module-aliases))
+
+  (if aliases
+      (let* ((modules  (delete-duplicates
+                        (append-map (cut matching-modules <> aliases)
+                                    (device-module-aliases device))))
+
+             ;; Module names (not file names) are supposed to use underscores
+             ;; instead of hyphens.  MODULES is a list of module names, whereas
+             ;; LINUX-MODULES is file names without '.ko', so normalize them.
+             (provided (map file-name->module-name modules-provided)))
+        (remove (cut member <> provided) modules))
+      '()))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index e29ad3a..7c58f87 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -32,8 +32,7 @@
   #:use-module (gnu system uuid)
   #:autoload   (gnu build file-systems) (find-partition-by-luks-uuid)
   #:autoload   (gnu build linux-modules)
-                 (device-module-aliases matching-modules known-module-aliases
-                  normalize-module-name file-name->module-name)
+                 (missing-modules)
   #:autoload   (gnu packages cryptsetup) (cryptsetup-static)
   #:autoload   (gnu packages linux) (mdadm-static)
   #:use-module (srfi srfi-1)
@@ -118,37 +117,27 @@
 (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."
-  (define aliases
-    ;; Attempt to load 'modules.alias' from the current kernel, assuming we're
-    ;; on Guix System, and assuming that corresponds to the kernel we'll be
-    ;; installing.  Skip the whole thing if that file cannot be read.
+  (define missing
+    ;; Attempt to determine missing modules.
     (catch 'system-error
       (lambda ()
-        (known-module-aliases))
-      (const #f)))
-
-  (when aliases
-    (let* ((modules  (delete-duplicates
-                      (append-map (cut matching-modules <> aliases)
-                                  (device-module-aliases device))))
-
-           ;; Module names (not file names) are supposed to use underscores
-           ;; instead of hyphens.  MODULES is a list of module names, whereas
-           ;; LINUX-MODULES is file names without '.ko', so normalize them.
-           (provided (map file-name->module-name linux-modules))
-           (missing  (remove (cut member <> provided) modules)))
-      (unless (null? missing)
-        ;; Note: What we suggest here is a list of module names (e.g.,
-        ;; "usb_storage"), not file names (e.g., "usb-storage.ko").  This is
-        ;; OK because we have machinery that accepts both the hyphen and the
-        ;; underscore version.
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "you may need these modules \
+        (missing-modules device linux-modules))
+
+      ;; If we can't do that (e.g., EPERM), skip the whole thing.
+      (const '())))
+
+  (unless (null? missing)
+    ;; Note: What we suggest here is a list of module names (e.g.,
+    ;; "usb_storage"), not file names (e.g., "usb-storage.ko").  This is
+    ;; OK because we have machinery that accepts both the hyphen and the
+    ;; underscore version.
+    (raise (condition
+            (&message
+             (message (format #f (G_ "you may need these modules \
 in the initrd for ~a:~{ ~a~}")
-                                  device missing)))
-                (&fix-hint
-                 (hint (format #f (G_ "Try adding them to the
+                              device missing)))
+            (&fix-hint
+             (hint (format #f (G_ "Try adding them to the
 @code{initrd-modules} field of your @code{operating-system} declaration, along
 these lines:
 
@@ -161,9 +150,9 @@ these lines:
 
 If you think this diagnostic is inaccurate, use the @option{--skip-checks}
 option of @command{guix system}.\n")
-                               missing)))
-                (&error-location
-                 (location (source-properties->location location)))))))))
+                           missing)))
+            (&error-location
+             (location (source-properties->location location)))))))
 
 
 ;;;