[bug#30604] [PATCH v9 7/7] linux-initrd: Use module-aliases->module-file-names, too.

[Danny Milosavljevic]

* gnu/system/linux-initrd.scm (flat-linux-module-directory): Use
module-aliases->module-file-names.
* gnu/build/linux-modules.scm (file-name->module-name): Export.
---
 gnu/build/linux-modules.scm |  1 +
 gnu/system/linux-initrd.scm | 67 ++++++++++++++++++++++++++-------------------
 2 files changed, 40 insertions(+), 28 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index f6bb0512b..81a4b15b1 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -35,6 +35,7 @@
             ensure-dot-ko
             module-aliases
             module-aliases->module-file-names
+            file-name->module-name
             module-dependencies
             recursive-module-dependencies
             modules-loaded
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 339ecf754..0b976afad 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -161,17 +161,17 @@ the derivations referenced by EXP are automatically 
copied to the initrd."
                     #:references-graphs `(("init-closure" ,init)
                                           ("modprobe-closure" ,modprobe))))
 
-(define (flat-linux-module-directory linux modules)
-  "Return a flat directory containing the Linux kernel modules listed in
-MODULES and taken from LINUX."
+(define (flat-linux-module-directory linux aliases)
+  "Return a flat directory containing the Linux kernel modules resolved by
+ALIASES and taken from LINUX."
   (define build-exp
     (with-imported-modules (source-module-closure
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 ftw)
                        (srfi srfi-1)
-                       (guix build utils)
+                       (guix build utils) ; mkdir-p
                        (gnu build linux-modules))
 
           (define (string->regexp str)
@@ -181,31 +181,42 @@ MODULES and taken from LINUX."
           (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 (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
 
-          (define modules
-            (let ((modules (map lookup '#$modules)))
-              (append modules
-                      (recursive-module-dependencies modules
-                                                     #:lookup-module lookup))))
-
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules)))))
+          (define linux-release-module-directory
+            (find-only-entry module-dir))
 
+          (define modules
+            (module-aliases->module-file-names #$linux '#$aliases))
+
+          (define version
+            (basename linux-release-module-directory))
+
+          (define (install-module-files module-files output)
+            "Install MODULE-FILES to OUTPUT.
+Precondition: OUTPUT is an empty directory except for \"modules.builtin\"."
+            (let ((aliases
+                   (map (lambda (module-file-name)
+                          (format #t "copying '~a'...~%" module-file-name)
+                          (copy-file module-file-name
+                           (string-append output "/"
+                                          (basename module-file-name)))
+                         `(,(file-name->module-name module-file-name) .
+                            ,(module-aliases module-file-name)))
+                     (sort module-files string<))))
+              (install-file (string-append linux-release-module-directory
+                                           "/modules.builtin")
+                            output)
+              (write-module-alias-database aliases output)
+              (write-module-device-database aliases output)))
+
+          (let ((output (string-append #$output "/lib/modules/" version)))
+            (mkdir-p output)
+            (install-module-files (delete-duplicates modules) output)
+            #t))))
   (computed-file "linux-modules" build-exp))
 
 (define* (raw-initrd file-systems