>From ffd464d540943e221636f7c63bcd22f4370803ae Mon Sep 17 00:00:00 2001
From: Danny Milosavljevic <address@hidden>
Date: Tue, 27 Feb 2018 21:25:27 +0100
Subject: [FIXME 13/13] linux-initrd: Make modprobe pure-Guile.
Tags: patch

* 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.
(raw-initrd): Replace kmod's default by "kmod".
(base-initrd): Replace kmod's default by "kmod".
Add LINUX-MODULES parameter again because it fell out before (?).
---
 gnu/build/linux-initrd.scm  |  7 +++---
 gnu/system/linux-initrd.scm | 57 ++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 55 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..0e8ce3590 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -56,12 +56,51 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe-exp linux-module-directory)
+  (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))
+        (define (lookup module)
+          (let* ((name (ensure-dot-ko module))
+                 (linux-release-module-directory
+                  (string-append "/lib/modules/" (utsname:release (uname))
+                                 "/"))
+                 (path (string-append linux-release-module-directory name)))
+            (if (file-exists? path)
+                path
+                ;; FIXME: Make safe.
+                (match (delete-duplicates (matching-modules module
+                        (known-module-aliases
+                         (string-append linux-release-module-directory
+                                        "modules.alias"))))
+                 (() #f)
+                 ((x-name) (lookup x-name))
+                 ((_ ...)
+                  (error "several modules by that name"
+                         name))))))
+        (define option-spec
+         '((quiet    (single-char #\q) (value #f))))
+        (define options (getopt-long (command-line) option-spec))
+        (for-each
+          (lambda (option)
+            (match option
+             ((() modules ...)
+              (for-each
+                (lambda (module)
+                  (let ((file-name (lookup module)))
+                    (when file-name
+                      (load-linux-module* file-name
+                                          #:lookup-module lookup))))
+                modules))
+             (_ #t)))
+          options))))
 
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
                              (gzip gzip)
-                             kmod
                              linux-module-directory
                              (name "guile-initrd")
                              (system (%current-system)))
@@ -75,6 +114,10 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (define init
     (program-file "init" exp #:guile guile))
 
+  (define modprobe
+    (program-file "modprobe"
+     (%modprobe-exp linux-module-directory) #:guile guile))
+
   (define builder
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
@@ -98,14 +141,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 +292,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 +365,7 @@ FILE-SYSTEMS."
 (define* (base-initrd file-systems
                       #:key
                       (linux linux-libre)
+                      (linux-modules '())
                       (kmod kmod-minimal/static)
                       (mapped-devices '())
                       qemu-networking?