06/10: linux-modules: Define and use a module name database.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit c85ccf60bfe4ef58110bb61f40df7f526d2a5735
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 14 23:11:01 2018 +0100

    linux-modules: Define and use a module name database.
    
    Fixes <https://bugs.gnu.org/34902>.
    Reported by Julien Lepiller <address@hidden>.
    
    * gnu/build/linux-modules.scm (module-formal-name): New procedure.
    (load-linux-modules-from-directory)[lookup-module]: Remove.
    [module-name->file-name]: New variable.  Use it.
    (module-name->file-name/guess, module-name-lookup)
    (write-module-name-database): New procedures.
    * gnu/system/linux-initrd.scm (flat-linux-module-directory): Call
    'write-module-name-database'.
---
 gnu/build/linux-modules.scm | 72 +++++++++++++++++++++++++++++++++++++++++----
 gnu/system/linux-initrd.scm |  5 +++-
 2 files changed, 71 insertions(+), 6 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 2af7c33..a149eff 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -31,8 +31,10 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:autoload   (ice-9 pretty-print) (pretty-print)
   #:export (dot-ko
             ensure-dot-ko
+            module-formal-name
             module-aliases
             module-dependencies
             module-soft-dependencies
@@ -52,6 +54,7 @@
             matching-modules
             missing-modules
 
+            write-module-name-database
             write-module-alias-database
             write-module-device-database))
 
@@ -100,6 +103,14 @@ key/value pairs.."
 (define %not-comma
   (char-set-complement (char-set #\,)))
 
+(define (module-formal-name file)
+  "Return the module name of FILE as it appears in its info section.  Usually
+the module name is the same as the base name of FILE, modulo hyphens and minus
+the \".ko\" extension."
+  (match (assq 'name (modinfo-section-contents file))
+    (('name . name) name)
+    (#f #f)))
+
 (define (module-dependencies file)
   "Return the list of modules that FILE depends on.  The returned list
 contains module names, not actual file names."
@@ -319,12 +330,13 @@ appears in BLACK-LIST are not loaded."
   "Load MODULES and their dependencies from DIRECTORY, a directory containing
 the '.ko' files.  The '.ko' suffix is automatically added to MODULES if
 needed."
-  (define (lookup-module name)
-    (string-append directory "/" (ensure-dot-ko name)))
+  (define module-name->file-name
+    (module-name-lookup directory))
 
-  (for-each (cut load-linux-module* <>
-                 #:lookup-module lookup-module)
-            (map lookup-module modules)))
+  (for-each (lambda (module)
+              (load-linux-module* (module-name->file-name module)
+                                  #:lookup-module module-name->file-name))
+            modules))
 
 
 ;;;
@@ -502,6 +514,56 @@ are required to access DEVICE."
         (remove (cut member <> provided) modules))
       '()))
 
+
+;;;
+;;; Module databases.
+;;;
+
+(define (module-name->file-name/guess directory name)
+  "Guess the file name corresponding to NAME, a module name.  That doesn't
+always work because sometimes underscores in NAME map to hyphens (e.g.,
+\"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\")."
+  (string-append directory "/" (ensure-dot-ko name)))
+
+(define (module-name-lookup directory)
+  "Return a one argument procedure that takes a module name (e.g.,
+\"input_leds\") and returns its absolute file name (e.g.,
+\"/.../input-leds.ko\")."
+  (catch 'system-error
+    (lambda ()
+      (define mapping
+        (call-with-input-file (string-append directory "/modules.name")
+          read))
+
+      (lambda (name)
+        (or (assoc-ref mapping name)
+            (module-name->file-name/guess directory name))))
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          (cut module-name->file-name/guess directory <>)
+          (apply throw args)))))
+
+(define (write-module-name-database directory)
+  "Write a database that maps \"module names\" as they appear in the relevant
+ELF section of '.ko' files, to actual file names.  This format is
+Guix-specific.  It aims to deal with inconsistent naming, in particular
+hyphens vs. underscores."
+  (define mapping
+    (map (lambda (file)
+           (match (module-formal-name file)
+             (#f   (cons (basename file ".ko") file))
+             (name (cons name file))))
+         (find-files directory "\\.ko$")))
+
+  (call-with-output-file (string-append directory "/modules.name")
+    (lambda (port)
+      (display ";; Module name to file name mapping.
+;;
+;; This format is Guix-specific; it is not supported by upstream Linux tools.
+\n"
+               port)
+      (pretty-print mapping port))))
+
 (define (write-module-alias-database directory)
   "Traverse the '.ko' files in DIRECTORY and create the corresponding
 'modules.alias' file."
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index c90b87c..7e9563b 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -133,7 +133,10 @@ MODULES and taken from LINUX."
                       (copy-file module
                                  (string-append #$output "/"
                                                 (basename module))))
-                    (delete-duplicates modules)))))
+                    (delete-duplicates modules))
+
+          ;; Hyphen or underscore?  This database tells us.
+          (write-module-name-database #$output))))
 
   (computed-file "linux-modules" build-exp))