[bug#30604] [PATCH v11 5/6] linux-initrd: Provide our own 'modprobe' program.

[Ludovic Courtès]

From: Danny Milosavljevic <address@hidden>

This allows us to load modules on demand when the kernel asks for them.

* gnu/system/linux-initrd.scm (modprobe-program): New variable.
(flat-linux-module-directory): Call 'write-module-alias-database'.
(raw-initrd): Pass #:modprobe to 'boot-system' and to 'expression->initrd'.
(expression->initrd): Copy "closure" to $out/references.  Add #:modprobe
and pass it to 'build-initrd'.
* gnu/build/linux-initrd.scm (build-initrd): Add #:modprobe and honor
it.
* gnu/build/linux-boot.scm (boot-system): Add #:modprobe and honor it.
Call 'load-needed-linux-modules'.
* gnu/system/vm.scm (qemu-image): Add #:linux parameter.  Define
'modprobe-wrapper' and pass it to 'activate-modprobe'.  Pass #:linux to
'expression->derivation-in-linux-vm'.

Co-authored-by: Ludovic Courtès <address@hidden>
---
 gnu/build/linux-boot.scm    | 13 +++++-
 gnu/build/linux-initrd.scm  | 16 ++++++--
 gnu/system/linux-initrd.scm | 97 ++++++++++++++++++++++++++++++++++++++++-----
 gnu/system/vm.scm           | 21 ++++++++++
 4 files changed, 133 insertions(+), 14 deletions(-)

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index df0b2b2d1..eedc4bb9d 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -435,6 +435,7 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
 
 
 (define* (boot-system #:key
+                      modprobe
                       (linux-modules '())
                       linux-module-directory
                       qemu-guest-networking?
@@ -449,6 +450,9 @@ QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting 
the file systems
 specified in MOUNTS, and finally booting into the new root if any.  The initrd
 supports kernel command-line options '--load', '--root', and '--repl'.
 
+MODPROBE must be #f or a program to install as the modprobe program that the
+kernel will invoke when it needs to load modules.
+
 Mount the root file system, specified by the '--root' command-line argument,
 if any.
 
@@ -482,9 +486,14 @@ upon error."
        (when (member "--repl" args)
          (start-repl))
 
+       (when modprobe
+         ;; Tell the kernel to invoke MODPROBE.
+         (call-with-output-file "/proc/sys/kernel/modprobe"
+           (lambda (port)
+             (display modprobe port))))
+
        (display "loading kernel modules...\n")
-       (load-linux-modules-from-directory linux-modules
-                                          linux-module-directory)
+       (load-needed-linux-modules linux-module-directory)
 
        (when qemu-guest-networking?
          (unless (configure-qemu-networking)
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index c65b5aacf..4fa2bee7d 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -107,12 +107,18 @@ This is similar to what 'compiled-file-name' in (system 
base compile) does."
 
 (define* (build-initrd output
                        #:key
-                       guile init
+                       guile init modprobe
                        (references-graphs '())
                        (gzip "gzip"))
   "Write an initial RAM disk (initrd) to OUTPUT.  The initrd starts the script
 at INIT, running GUILE.  It contains all the items referred to by
-REFERENCES-GRAPHS."
+REFERENCES-GRAPHS.
+
+When MODPROBE is true, make /sbin/modprobe a symlink to it.  This is useful
+because Linux invokes 'modprobe' when it needs to load a module and its
+default file name is '/sbin/modprobe' (see 'call_modprobe' in kernel/kmod.c).
+Creating this symlink allows us to make sure there's no time window during
+which 'modprobe' is unavailable."
   (mkdir "contents")
 
   ;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
@@ -131,6 +137,10 @@ REFERENCES-GRAPHS."
     (symlink (string-append guile "/bin/guile") "proc/self/exe")
     (readlink "proc/self/exe")
 
+    (when modprobe
+      (mkdir-p "sbin")
+      (symlink modprobe "sbin/modprobe"))
+
     ;; 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 1eb5f5130..7a167146f 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -63,16 +63,87 @@
 ;;;
 ;;; Code:
 
+(define* (modprobe-program linux-module-directory #:key
+                           (guile %guile-static-stripped))
+  "Return a minimal implementation of 'modprobe' for our initrd that looks up
+modules in LINUX-MODULE-DIRECTORY.  This program will be invoked by the kernel
+when modules need to be loaded."
+  (define program
+    (with-imported-modules (source-module-closure
+                            '((gnu build linux-modules)))
+      #~(begin
+          (use-modules (gnu build linux-modules)
+                       (ice-9 match)
+                       (srfi srfi-1)
+                       (srfi srfi-26)
+                       (srfi srfi-37))
+
+          (define option-spec
+            (list (option '(#\q "quiet") #f #f
+                          (lambda (opt name arg result)
+                            (alist-cons 'quiet? #t result)))))
+
+          (define options
+            ;; Alist of options and non-option arguments.
+            (args-fold (cdr (program-arguments))
+                       option-spec
+                       (lambda (opt name arg result)
+                         (error "unrecognized option" name))
+                       (lambda (arg result)
+                         (alist-cons 'argument arg result))
+                       '()))
+
+          (define alias
+            ;; The alias we are asked to load.  The remaining arguments are
+            ;; module parameters.  In practice the kernel doesn't pass module
+            ;; parameters so we ignore them here.
+            (any (match-lambda
+                   (('argument . alias) alias)
+                   (_ #f))
+                 options))
+
+          (define linux-module-directory
+            ;; The module directory.  Note: We expect a flat directory here.
+            #$linux-module-directory)
+
+          (define %known-aliases
+            ;; The alias database.
+            (known-module-aliases
+             (string-append linux-module-directory "/modules.alias")))
+
+          (when (assq-ref options 'quiet?)
+            (current-error-port (%make-void-port "w"))
+            (current-output-port (%make-void-port "w")))
+
+          (let ((modules (matching-modules alias %known-aliases)))
+            (call-with-output-file "/dev/kmsg"
+              (lambda (port)
+                (setvbuf port 'block 1024)
+                (format port "modprobe[~a]: alias ~s; modules ~s; args ~s~%"
+                        (getpid) alias modules (program-arguments))))
+
+            (when (null? modules)
+              (error "alias resolution failed" alias))
+
+            (load-linux-modules-from-directory modules
+                                               linux-module-directory)))))
+
+  (program-file "modprobe" program #:guile guile))
 
 (define* (expression->initrd exp
                              #:key
+                             modprobe
                              (guile %guile-static-stripped)
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
 containing GUILE and that evaluates EXP, a G-expression, upon booting.  All
-the derivations referenced by EXP are automatically copied to the initrd."
+the derivations referenced by EXP are automatically copied to the initrd.
+
+When MODPROBE is true, '/sbin/modprobe' is created as a symlink pointing to
+it.  This allows Linux to call out to MODPROBE as soon as it boots if it needs
+to load modules."
 
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
@@ -89,20 +160,21 @@ the derivations referenced by EXP are automatically copied 
to the initrd."
           (mkdir #$output)
 
           ;; The guile used in the initrd must be present in the store, so
-          ;; that module loading works once the root is switched.
+          ;; that module loading works once the root is switched.  Similarly,
+          ;; the 'modprobe' program installed in /proc/sys/kernel/modprobe by
+          ;; the initrd, if any, must be present after switch root.
           ;;
-          ;; To ensure that is the case, add an explicit reference to the
-          ;; guile package used in the initrd to the output.
+          ;; To ensure that is the case, add an explicit reference to these in
+          ;; the output.
           ;;
-          ;; This fixes guix-patches bug #28399, "Fix mysql activation, and
+          ;; This fixes <https://bugs.gnu.org/28399>, "Fix mysql activation, 
and
           ;; add a basic test".
-          (call-with-output-file (string-append #$ output "/references")
-            (lambda (port)
-              (simple-format port "~A\n" #$guile)))
+          (copy-file "closure" (string-append #$output "/references"))
 
           (build-initrd (string-append #$output "/initrd")
                         #:guile #$guile
                         #:init #$init
+                        #:modprobe #$modprobe
                         ;; Copy everything INIT refers to into the initrd.
                         #:references-graphs '("closure")
                         #:gzip (string-append #$gzip "/bin/gzip")))))
@@ -153,7 +225,9 @@ MODULES and taken from LINUX."
                       (copy-file module
                                  (string-append #$output "/"
                                                 (basename module))))
-                    (delete-duplicates modules)))))
+                    (delete-duplicates modules))
+
+          (write-module-alias-database #$output))))
 
   (computed-file "linux-modules" build-exp))
 
@@ -196,6 +270,9 @@ upon error."
   (define kodir
     (flat-linux-module-directory linux linux-modules))
 
+  (define modprobe
+    (modprobe-program kodir))
+
   (expression->initrd
    (with-imported-modules (source-module-closure
                            '((gnu build linux-boot)
@@ -229,9 +306,11 @@ upon error."
                                     (and address@hidden))
                       #:linux-modules '#$linux-modules
                       #:linux-module-directory '#$kodir
+                      #:modprobe #$modprobe
                       #:qemu-guest-networking? #$qemu-networking?
                       #:volatile-root? '#$volatile-root?
                       #:on-error '#$on-error)))
+   #:modprobe modprobe
    #:name "raw-initrd"))
 
 (define* (file-system-packages file-systems #:key (volatile-root? #f))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 4360adf15..7f552bef8 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -249,6 +249,7 @@ INPUTS is a list of inputs (as for packages)."
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
+                     (linux linux-libre)
                      (qemu qemu-minimal)
                      (disk-image-size 'guess)
                      (disk-image-format "qcow2")
@@ -275,18 +276,37 @@ INPUTS is a list of inputs (as for packages).  When 
COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
 register INPUTS in the store database of the image so that Guix can be used in
 the image."
+  (define modprobe-wrapper
+    ;; Wrapper for the 'modprobe' command that knows where modules live.
+    (let ((modprobe (file-append kmod "/bin/modprobe")))
+      (program-file "modprobe"
+                    #~(begin
+                        (setenv "LINUX_MODULE_DIRECTORY"
+                                #$(file-append linux "/lib/modules"))
+                        (apply execl #$modprobe
+                               (cons #$modprobe (cdr (command-line))))))))
+
+
   (expression->derivation-in-linux-vm
    name
    (with-imported-modules (source-module-closure '((gnu build bootloader)
                                                    (gnu build vm)
+                                                   (gnu build activation)
                                                    (guix build utils)))
      #~(begin
          (use-modules (gnu build bootloader)
                       (gnu build vm)
+                      ((gnu build activation) #:select (activate-modprobe))
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
+         ;; We may need to lazy-load Linux modules.  The initrd installs a
+         ;; 'modprobe' that can only search through the modules available in
+         ;; the initrd, but here we want to be able to use all the modules of
+         ;; LINUX.  Thus, install a real 'modprobe'.
+         (activate-modprobe #$modprobe-wrapper)
+
          (let ((inputs
                 '#$(append (list qemu parted e2fsprogs dosfstools)
                            (map canonical-package
@@ -361,6 +381,7 @@ the image."
                                    #$(bootloader-installer bootloader))
              (reboot)))))
    #:system system
+   #:linux linux
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-- 
2.16.2