From fcd068e984078ab74c6842af2525bf88096cd262 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 29 Jul 2018 18:31:42 +0200
Subject: [PATCH] linux-initrd: Try several file names when looking up modules.

Fixes <https://bugs.gnu.org/31714>.
Reported by Tonton <tonton@riseup.net>.

* gnu/build/linux-modules.scm (find-module-file): New procedure.
* gnu/system/linux-initrd.scm (flat-linux-module-directory)[build-exp]:
Remove 'lookup' procedure and use 'find-module-file' instead.
* gnu/system/mapped-devices.scm (check-device-initrd-modules): Add
comment.
---
 gnu/build/linux-modules.scm   | 35 +++++++++++++++++++++++++++++++++++
 gnu/system/linux-initrd.scm   | 26 +++++---------------------
 gnu/system/mapped-devices.scm |  4 ++++
 3 files changed, 44 insertions(+), 21 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index b06c576441..9c8761527a 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
   #:use-module (guix elf)
   #:use-module (guix glob)
   #:use-module (guix build syscalls)
+  #:use-module ((guix build utils) #:select (find-files))
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
@@ -34,6 +35,7 @@
             module-dependencies
             normalize-module-name
             file-name->module-name
+            find-module-file
             recursive-module-dependencies
             modules-loaded
             module-loaded?
@@ -131,6 +133,39 @@ underscores."
 and normalizing it."
   (normalize-module-name (basename file ".ko")))
 
+(define (find-module-file directory module)
+  "Lookup module NAME under DIRECTORY, and return its absolute file name.
+NAME can be a file name with or without '.ko', or it can be a module name.
+Return #f if it could not be found.
+
+Module names can differ from file names in interesting ways; for instance,
+module names usually (always?) use underscores as the inter-word separator,
+whereas file names often, but not always, use hyphens.  Examples:
+\"usb-storage.ko\", \"serpent_generic.ko\"."
+  (define names
+    ;; List of possible file names.  XXX: It would of course be cleaner to
+    ;; have a database that maps module names to file names and vice versa,
+    ;; but everyone seems to be doing hacks like this one.  Oh well!
+    (map ensure-dot-ko
+         (delete-duplicates
+          (list module
+                (normalize-module-name module)
+                (string-map (lambda (chr) ;converse of 'normalize-module-name'
+                              (case chr
+                                ((#\_) #\-)
+                                (else chr)))
+                            module)))))
+
+  (match (find-files directory
+                     (lambda (file stat)
+                       (member (basename file) names)))
+    ((file)
+     file)
+    (()
+     #f)
+    ((_ ...)
+     (error "several modules by that name" module directory))))
+
 (define* (recursive-module-dependencies files
                                         #:key (lookup-module dot-ko))
   "Return the topologically-sorted list of file names of the modules depended
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index d73ebfd8d3..a5a111908f 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -108,34 +108,18 @@ the derivations referenced by EXP are automatically copied to the initrd."
 MODULES and taken from LINUX."
   (define build-exp
     (with-imported-modules (source-module-closure
-                            '((guix build utils)
-                              (gnu build linux-modules)))
+                            '((gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (gnu build linux-modules)
                        (srfi srfi-1)
-                       (guix build utils)
-                       (gnu build linux-modules))
-
-          (define (string->regexp str)
-            ;; Return a regexp that matches STR exactly.
-            (string-append "^" (regexp-quote str) "$"))
+                       (srfi srfi-26))
 
           (define module-dir
             (string-append #$linux "/lib/modules"))
 
-          (define (lookup module)
-            (let ((name (ensure-dot-ko module)))
-              (match (find-files module-dir (string->regexp name))
-                ((file)
-                 file)
-                (()
-                 (error "module not found" name module-dir))
-                ((_ ...)
-                 (error "several modules by that name"
-                        name module-dir)))))
-
           (define modules
-            (let ((modules (map lookup '#$modules)))
+            (let* ((lookup  (cut find-module-file module-dir <>))
+                   (modules (map lookup '#$modules)))
               (append modules
                       (recursive-module-dependencies modules
                                                      #:lookup-module lookup))))
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index aec49322e7..384b1aaf7d 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -137,6 +137,10 @@ DEVICE must be a \"/dev\" file name."
           ;; LINUX-MODULES is file names without '.ko', so normalize them.
           (provided (map file-name->module-name linux-modules)))
       (unless (every (cut member <> provided) modules)
+        ;; 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 \