[bug#30604] [PATCH v8 6/7] linux-initrd: Provide modprobe to the initrd.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/build/linux-initrd.scm (build-initrd): Provide modprobe and the
linux modules to the initrd.
* gnu/system/linux-initrd.scm (%modprobe): New procedure.
(expression->initrd): Use it.  Add linux-module-directory.
(raw-initrd): Pass linux-module-directory.
---
 gnu/build/linux-initrd.scm  | 13 +++++-
 gnu/system/linux-initrd.scm | 99 +++++++++++++++++++++++++++++++++++++++------
 2 files changed, 99 insertions(+), 13 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..d4cb5e2d8 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -107,7 +107,7 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -131,6 +131,17 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
+
+    ;; Make modules available as /lib/modules so modprobe finds them.
+    (mkdir-p "lib")
+    (symlink (string-append linux-module-directory "/lib/modules")
+             "lib/modules")
+
     ;; Reset the timestamps of all the files that will make it in the initrd.
     (for-each (lambda (file)
                 (unless (eq? 'symlink (stat:type (lstat file)))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b50d3ff80..8050ac47e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,11 +56,73 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  (program-file "modprobe"
+    (with-imported-modules (source-module-closure
+                            '((gnu build linux-modules)))
+      #~(begin
+          (use-modules (gnu build linux-modules) (ice-9 getopt-long)
+                       (ice-9 match) (srfi srfi-1) (ice-9 ftw))
+          (define (find-only-entry directory)
+            (match (scandir directory)
+             (("." ".." basename)
+              (string-append directory "/" basename))))
+          (define (resolve-alias alias)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules"))))
+              (match (delete-duplicates (matching-modules alias
+                      (known-module-aliases
+                        (string-append linux-release-module-directory
+                                       "/modules.alias"))))
+               (()
+                (error "no alias by that name" alias))
+               (items
+                items))))
+          (define (lookup-module module)
+            (let* ((linux-release-module-directory
+                    (find-only-entry (string-append "/lib/modules")))
+                   (file-name (string-append linux-release-module-directory
+                                             "/" (ensure-dot-ko module))))
+              (if (file-exists? file-name)
+                  file-name
+                  (error "no module file found for module" module))))
+          (define option-spec
+           '((quiet    (single-char #\q) (value #f))))
+          (define options
+            (getopt-long (command-line) option-spec))
+          (when (option-ref options 'quiet #f)
+            (current-error-port (%make-void-port "w"))
+            (current-output-port (%make-void-port "w")))
+          (let ((exit-status 0))
+            (for-each (match-lambda
+                        (('quiet . #t)
+                         #f)
+                        ((() modules ...)
+                         (for-each (lambda (alias)
+                                     (catch #t
+                                       (lambda ()
+                                         (let ((modules (resolve-alias alias)))                                           (for-each (lambda (module)
+                                                       (load-linux-module*
+                                                        (lookup-module module)
+                                                        #:lookup-module
+                                                        lookup-module))
+                                                     modules)))
+                                       (lambda (key . args)
+                                         (display (cons* key args)
+                                                  (current-error-port))
+                                         (newline (current-error-port))
+                                         (set! exit-status 1))))
+                                   modules)))
+                      options)
+            (exit exit-status))))
+  #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
+                             linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
@@ -73,6 +135,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (%modprobe linux-module-directory #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -96,12 +161,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
+                        ;; Copy everything INIT and MODPROBE refer to into the
+                        ;; initrd.
+                        #:references-graphs '("init-closure"
+                                              "modprobe-closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
 
   (gexp->derivation name builder
-                    #:references-graphs `(("closure" ,init))))
+                    #: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
@@ -111,7 +181,7 @@ MODULES and taken from LINUX."
                             '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
-          (use-modules (ice-9 match) (ice-9 regex)
+          (use-modules (ice-9 match) (ice-9 regex) (ice-9 ftw)
                        (srfi srfi-1)
                        (guix build utils)
                        (gnu build linux-modules))
@@ -140,14 +210,18 @@ MODULES and taken from LINUX."
                       (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 version
+            (match
+             (filter
+              (lambda (name)
+                (not (string-prefix? "." name)))
+              (scandir module-dir))
+             ((item) item)))
+
+          (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
@@ -227,6 +301,7 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:linux-module-directory kodir
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))