[bug#30604] [PATCH v3 5/6] vm: Allow qemu-image builder to load Linux kernel modules.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/system/vm.scm (%modprobe-wrapper): New variable.
(qemu-image): Modify.
---
 gnu/system/vm.scm | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd..b5a559012 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -246,6 +246,17 @@ INPUTS is a list of inputs (as for packages)."
    #:single-file-output? #t
    #:references-graphs inputs))
 
+(define (%modprobe-wrapper modprobe linux-module-directory)
+  ;; Wrapper for the 'modprobe' command that knows where modules live.
+  ;;
+  ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe',
+  ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY'
+  ;; environment variable is not set---hence the need for this wrapper.
+  (program-file "modprobe"
+    #~(begin
+        (setenv "LINUX_MODULE_DIRECTORY" #$linux-module-directory)
+        (apply execl #$modprobe (cons #$modprobe (cdr (command-line)))))))
+
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
@@ -275,20 +286,24 @@ 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."
+  (let ((modprobe-name (file-append os-drv "/profile/bin/modprobe"))
+        (linux-module-directory (file-append (file-append os-drv "/kernel/lib/modules"))))
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules (source-module-closure '((gnu build bootloader)
+   (with-imported-modules (source-module-closure '((gnu build activation)
+                                                   (gnu build bootloader)
                                                    (gnu build vm)
                                                    (guix build utils)))
      #~(begin
-         (use-modules (gnu build bootloader)
+         (use-modules (gnu build activation)
+                      (gnu build bootloader)
                       (gnu build vm)
                       (guix build utils)
                       (srfi srfi-26)
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list qemu parted e2fsprogs dosfstools kmod)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))
@@ -302,6 +317,14 @@ the image."
                         inputs)))
 
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+           ;; It's possible that we need to load nls modules in order to
+           ;; mount the new partition.
+           (if (file-exists? #$modprobe-name)
+               (activate-modprobe #$(%modprobe-wrapper modprobe-name
+                                     linux-module-directory))
+               (format (current-error-port)
+                "WARNING: No modprobe found in ~s.  \
+Loading kernel modules will be impossible.\n" #$modprobe-name))
 
            (let* ((graphs     '#$(match inputs
                                    (((names . _) ...)
@@ -364,7 +387,7 @@ the image."
    #:make-disk-image? #t
    #:disk-image-size disk-image-size
    #:disk-image-format disk-image-format
-   #:references-graphs inputs))
+   #:references-graphs inputs)))
 
 \f
 ;;;