[bug#30604] [PATCH v9 3/7] linux-initrd: Provide pure-Guile modprobe.

[Danny Milosavljevic]

* gnu/system/linux-initrd.scm (%modprobe): New variable.
(expression->initrd): Add modprobe, LINUX-MODULE-DIRECTORY.
(raw-initrd): Pass KODIR as LINUX-MODULE-DIRECTORY.
* gnu/build/linux-initrd.scm (build-initrd): Add modprobe.
---
 gnu/build/linux-initrd.scm  | 13 ++++++++-
 gnu/system/linux-initrd.scm | 65 ++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 74 insertions(+), 4 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 e0cb59c00..6ad6d75f7 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -46,7 +46,8 @@
             %base-initrd-modules
             raw-initrd
             file-system-packages
-            base-initrd))
+            base-initrd
+            %modprobe))
 
 
 ;;; Commentary:
@@ -56,11 +57,61 @@
 ;;;
 ;;; Code:
 
+(define* (%modprobe linux-module-directory #:key
+                    (guile %guile-static-stripped))
+  "Minimal implementation of modprobe for our initrd.
+LINUX-MODULE-DIRECTORY is the directory that contains \"lib\"."
+  (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))
+          (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)
+                        ((() aliases ...)
+                         (catch #t
+                           (lambda ()
+                             (let ((module-file-names
+                                    (module-aliases->module-file-names
+                                     #$linux-module-directory aliases)))
+                               (for-each (lambda (name)
+                                           (catch 'system-error
+                                             (lambda ()
+                                               (when (not (load-linux-module* 
name
+                                                                              
#:recursive?
+                                                                              
#f))
+                                                 (set! exit-status 1)))
+                                             (lambda (key . args)
+                                               (when (not (= EEXIST
+                                                             
(system-error-errno
+                                                              (cons key 
args))))
+                                                 (print-exception 
(current-error-port)
+                                                                  #f key args)
+                                                 (set! exit-status 1)))))
+                                         module-file-names)))
+                           (lambda (key . args)
+                             (print-exception (current-error-port)
+                                              #f key args)
+                             (set! exit-status 1)))))
+                      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 +124,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 +150,16 @@ the derivations referenced by EXP are automatically copied 
to the initrd."
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:modprobe #$modprobe
+                        #:linux-module-directory #$linux-module-directory
                         ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                        #: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
@@ -225,6 +283,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))