[bug#30638] [WIP v3] linux-initrd: Make modprobe pure-Guile.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/build/linux-initrd.scm (build-initrd): Replace kmod by modprobe.
* gnu/system/linux-initrd.scm (%modprobe-exp): New variable.
(expression->initrd): Delete parameter "kmod".  Use the above.
(base-initrd): Add LINUX-MODULES parameter again because it fell out before (?)
---
 gnu/build/linux-initrd.scm  |  7 +++--
 gnu/system/linux-initrd.scm | 74 +++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 72 insertions(+), 9 deletions(-)

diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 6356007df..f54d7102d 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 kmod linux-module-directory
+                       guile init modprobe linux-module-directory
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
@@ -132,9 +132,10 @@ REFERENCES-GRAPHS."
     (readlink "proc/self/exe")
 
     ;; Make modprobe available as /sbin/modprobe so the kernel finds it.
-    (when kmod
+    (when modprobe
       (mkdir-p "sbin")
-      (symlink (string-append kmod "/bin/modprobe") "sbin/modprobe"))
+      (symlink modprobe "sbin/modprobe")
+      (compile-to-cache "sbin/modprobe"))
 
     ;; Make modules available as /lib/modules so modprobe finds them.
     (mkdir-p "lib")
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1cb73b310..0ae21882e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,69 @@
 ;;;
 ;;; 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 (lookup 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
+                  (match (delete-duplicates (matching-modules module
+                          (known-module-aliases
+                           (string-append linux-release-module-directory
+                                          "/modules.alias"))))
+                   (()
+                    (error "no module by that name" module))
+                   ((x-name)
+                    (lookup x-name))
+                   ((_ ...)
+                    (error "several modules by that name"
+                           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 (module)
+                                     (catch #t
+                                       (lambda ()
+                                         (let ((file-name (lookup module)))
+                                           (load-linux-module* file-name
+                                                               #:lookup-module
+                                                               lookup)))
+                                       (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)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +132,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)))
@@ -98,14 +158,16 @@ the derivations referenced by EXP are automatically copied to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
-                        #:kmod #$kmod
+                        #:modprobe #$modprobe
                         #:linux-module-directory #$linux-module-directory
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        ;; 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 kmod)
   "Return a flat directory containing the Linux kernel modules listed in
@@ -247,7 +309,6 @@ upon error."
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
-   #:kmod kmod
    #:linux-module-directory kodir
    #:name "raw-initrd"))
 
@@ -321,6 +382,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?