[bug#55231] [PATCH v2 1/2] Allows copying of out-of-tree modules to the Linux initrd.

[Brian Cully via Guix-patches via <guix-patches@gnu.org>]

With this patch, modules for ‘initrd-modules’ will not only be searched for in
the in-tree Linux modules, but also any additional modules specified in
‘kernel-loadable-modules’.

* gnu/build/linux-modules.scm (find-module-file): change DIRECTORY argument to
DIRECTORIES. Now takes a list of directories to search, rather than a single
one.
* gnu/system/linux-initrd.scm (flat-linux-module-directory): change LINUX
argument to PACKAGES. Now contains a list of file-likes to search for modules.
(raw-initrd): Add LINUX-EXTRA-MODULE-PATHS keyword argument. Pass it
to (flat-linux-extra-module-paths) along with the selected LINUX package.
(base-initrd): Add LINUX-EXTRA-MODULE-PATHS keyword argument. Pass it
to (raw-initrd).
* gnu/system.scm (operating-system-initrd-file): pass in operating system
definition's kernel-loadable-modules into (make-initrd) as
LINUX-EXTRA-MODULE-PATHS.
---

I've removed the new operating-system slot in preference to re-using
kernel-loadable-modules, as discussed.

I did leave the old argument names for the lower level routines in place,
as I feel that they more accurately represent how the data are being
used.

I've also pulled out the documentation. Once this patch set is beaten
into acceptability, the documentation can be adjusted if that's deemed
necessary.

 gnu/build/linux-modules.scm | 19 ++++++++------
 gnu/system.scm              |  2 ++
 gnu/system/linux-initrd.scm | 52 +++++++++++++++++++++++++------------
 3 files changed, 48 insertions(+), 25 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 053720574b..97b7e429ea 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -225,8 +225,8 @@ (define (file-name->module-name file)
 '.ko[.gz|.xz]' and normalizing it."
   (normalize-module-name (strip-extension (basename file))))
 
-(define (find-module-file directory module)
-  "Lookup module NAME under DIRECTORY, and return its absolute file name.
+(define (find-module-file directories module)
+  "Lookup module NAME under DIRECTORIES, and return its absolute file name.
 NAME can be a file name with or without '.ko', or it can be a module name.
 Raise an error if it could not be found.
 
@@ -247,16 +247,19 @@ (define (find-module-file directory module)
                            (else chr)))
                        module))))
 
-  (match (find-files directory
-                     (lambda (file stat)
-                       (member (strip-extension
-                                (basename file)) names)))
+  (match (append-map (lambda (directory)
+                       (find-files directory
+                                   (lambda (file _stat)
+                                     (member (strip-extension
+                                              (basename file))
+                                             names))))
+                       directories)
     ((file)
      file)
     (()
-     (error "kernel module not found" module directory))
+     (error "kernel module not found" module directories))
     ((_ ...)
-     (error "several modules by that name" module directory))))
+     (error "several modules by that name" module directories))))
 
 (define* (recursive-module-dependencies files
                                         #:key (lookup-module dot-ko))
diff --git a/gnu/system.scm b/gnu/system.scm
index ba1b7b5152..6f52377c8d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1313,6 +1313,8 @@ (define (operating-system-initrd-file os)
                #:linux (operating-system-kernel os)
                #:linux-modules
                (operating-system-initrd-modules os)
+               #:linux-extra-module-paths
+               (operating-system-kernel-loadable-modules os)
                #:mapped-devices mapped-devices
                #:keyboard-layout (operating-system-keyboard-layout os)))
 
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 4c4c78e444..50a182d7d5 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -119,13 +119,23 @@ (define* (expression->initrd exp
                               `(#:references-graphs (("closure" ,init))))
                "/initrd.cpio.gz"))
 
-(define (flat-linux-module-directory linux modules)
+(define (flat-linux-module-directory packages modules)
   "Return a flat directory containing the Linux kernel modules listed in
-MODULES and taken from LINUX."
+MODULES and taken from PACKAGES."
   (define imported-modules
     (source-module-closure '((gnu build linux-modules)
                              (guix build utils))))
 
+  (define (package+out->input package out)
+    (gexp-input package out))
+
+  (define package-inputs
+    (map (lambda (p)
+           (match p
+             ((p o) (package+out->input p o))
+             (p     (package+out->input p "out"))))
+         packages))
+
   (define build-exp
     (with-imported-modules imported-modules
       (with-extensions (list guile-zlib)
@@ -135,11 +145,12 @@ (define (flat-linux-module-directory linux modules)
                          (srfi srfi-1)
                          (srfi srfi-26))
 
-            (define module-dir
-              (string-append #$linux "/lib/modules"))
+            (define module-dirs
+              (map (cut string-append <> "/lib/modules")
+                   '#$package-inputs))
 
             (define modules
-              (let* ((lookup  (cut find-module-file module-dir <>))
+              (let* ((lookup  (cut find-module-file module-dirs <>))
                      (modules (map lookup '#$modules)))
                 (append modules
                         (recursive-module-dependencies
@@ -172,20 +183,23 @@ (define* (raw-initrd file-systems
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (linux-extra-module-paths '())
                       (mapped-devices '())
                       (keyboard-layout #f)
                       (helper-packages '())
                       qemu-networking?
                       volatile-root?
                       (on-error 'debug))
-  "Return as a file-like object a raw initrd, with kernel
-modules taken from LINUX.  FILE-SYSTEMS is a list of file-systems to be
-mounted by the initrd, possibly in addition to the root file system specified
-on the kernel command line via 'root'.  LINUX-MODULES is a list of kernel
-modules to be loaded at boot time. MAPPED-DEVICES is a list of device
-mappings to realize before FILE-SYSTEMS are mounted.
-HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
-e2fsck/static or other packages needed by the initrd to check root partition.
+  "Return as a file-like object a raw initrd, with kernel modules taken from
+LINUX.  FILE-SYSTEMS is a list of file-systems to be mounted by the initrd,
+possibly in addition to the root file system specified on the kernel command
+line via 'root'.  LINUX-MODULES is a list of kernel modules to be loaded at
+boot time. LINUX-EXTRA-MODULE-PATHS is a list of file-like objects which will
+be searched for modules in addition to the linux kernel. MAPPED-DEVICES is a
+list of device mappings to realize before FILE-SYSTEMS are mounted.
+HELPER-PACKAGES is a list of packages to be copied in the initrd. It may
+include e2fsck/static or other packages needed by the initrd to check root
+partition.
 
 When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
 console keyboard layout.  This is done before MAPPED-DEVICES are set up and
@@ -221,7 +235,8 @@ (define* (raw-initrd file-systems
           #~())))
 
   (define kodir
-    (flat-linux-module-directory linux linux-modules))
+    (flat-linux-module-directory (cons linux linux-extra-module-paths)
+                                 linux-modules))
 
   (expression->initrd
    (with-imported-modules (source-module-closure
@@ -366,6 +381,7 @@ (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
                       (linux-modules '())
+                      (linux-extra-module-paths '())
                       (mapped-devices '())
                       (keyboard-layout #f)
                       qemu-networking?
@@ -386,9 +402,10 @@ (define* (base-initrd file-systems
 QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
 
 The initrd is automatically populated with all the kernel modules necessary
-for FILE-SYSTEMS and for the given options.  Additional kernel
-modules can be listed in LINUX-MODULES.  They will be added to the initrd, and
-loaded at boot time in the order in which they appear."
+for FILE-SYSTEMS and for the given options.  Additional kernel modules can be
+listed in LINUX-MODULES.  Additional search paths for modules can be listed in
+LINUX-EXTRA-MODULE-PATHS.  They will be added to the initrd, and loaded at
+boot time in the order in which they appear."
   (define linux-modules*
     ;; Modules added to the initrd and loaded from the initrd.
     `(,@linux-modules
@@ -408,6 +425,7 @@ (define* (base-initrd file-systems
   (raw-initrd file-systems
               #:linux linux
               #:linux-modules linux-modules*
+              #:linux-extra-module-paths linux-extra-module-paths
               #:mapped-devices mapped-devices
               #:helper-packages helper-packages
               #:keyboard-layout keyboard-layout
-- 
2.36.1