[bug#42193] [WIP 3/6] services: Add 'modprobe-service-type'.

[Brice Waegeneire]

* gnu/services.scm (%linux-kernel-activation): Remove
'activate-modprobe' from it.
(%modprobe-wrapper): Move it…
* gnu/services/linux.scm (%modprobe-wrapper): …here and make it a
procedure taking one argument specifying the configuration directory.
(modprobe-service-type, modprobe-environment,
modprobe->activation-gexp): New variables.
* gnu/system.scm (operating-system-default-essential-services): Add
'modprobe-service-type'.
* gnu/system/linux-container.scm (container-essential-services): Add
'modprobe-service-type' to the list of services to be removed.
---
 gnu/services.scm               | 22 +-------------
 gnu/services/linux.scm         | 53 +++++++++++++++++++++++++++++++++-
 gnu/system.scm                 |  2 ++
 gnu/system/linux-container.scm |  2 ++
 4 files changed, 57 insertions(+), 22 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index b5ec222207..7df9bf9d46 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -654,31 +654,11 @@ ACTIVATION-SCRIPT-TYPE."
   ;; receives.
   (service activation-service-type #t))
 
-(define %modprobe-wrapper
-  ;; 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.
-  (let ((modprobe "/run/current-system/profile/bin/modprobe"))
-    (program-file "modprobe"
-                  #~(begin
-                      (setenv "LINUX_MODULE_DIRECTORY"
-                              "/run/booted-system/kernel/lib/modules")
-                      ;; FIXME: Remove this crutch when the patch #40422,
-                      ;; updating to kmod 27 is merged.
-                      (setenv "MODPROBE_OPTIONS"
-                              "-C /etc/modprobe.d")
-                      (apply execl #$modprobe
-                             (cons #$modprobe (cdr (command-line))))))))
-
+;; TODO Maybe rename it
 (define %linux-kernel-activation
   ;; Activation of the Linux kernel running on the bare metal (as opposed to
   ;; running in a container.)
   #~(begin
-      ;; Tell the kernel to use our 'modprobe' command.
-      (activate-modprobe #$%modprobe-wrapper)
-
       ;; Let users debug their own processes!
       (activate-ptrace-attach)))
 
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index 12934c2084..c608cc4d8d 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -23,6 +23,7 @@
   #:use-module (guix modules)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu system pam)
   #:use-module (gnu packages linux)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -42,7 +43,9 @@
             earlyoom-configuration-send-notification-command
             earlyoom-service-type
 
-            kernel-module-loader-service-type))
+            kernel-module-loader-service-type
+
+            modprobe-service-type))
 
 
 ;;;
@@ -177,3 +180,51 @@ representation."
    (compose concatenate)
    (extend append)
    (default-value '())))
+
+
+;;;
+;;; Modprobe service.
+;;;
+
+(define (%modprobe-wrapper directory)
+  "Return a wrapper for modprobe loading configuration files from CONFIG."
+  ;; 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.
+  (let ((modprobe "/run/current-system/profile/bin/modprobe"))
+    (program-file "modprobe"
+                  #~(begin
+                      (setenv "LINUX_MODULE_DIRECTORY"
+                              "/run/booted-system/kernel/lib/modules")
+                      (setenv "MODPROBE_OPTIONS"
+                              (string-append "--config=" #$directory))
+                      (apply execl #$modprobe
+                             (cons #$modprobe (cdr (command-line))))))))
+
+(define (modprobe->activation-gexp configs)
+  "Return a gexp to tell the kernel to use modprobe configured with CONFIGS
+files."
+  (let ((directory (file-union "modprobe.d" configs)))
+    #~(activate-modprobe #$(%modprobe-wrapper directory))))
+
+(define (modprobe-environment configs)
+  (let ((options #~(string-append
+                    "--config="
+                    #$(file-union "modprobe.d"
+                                  configs))))
+    `(("MODPROBE_OPTIONS" . ,options))))
+
+(define modprobe-service-type
+  (service-type
+   (name 'modropbe)
+   (description "Tell the kernel to use Guix's 'modprobe'.")
+   (default-value '())                  ; list of <file-like>
+   (extensions
+    (list (service-extension activation-service-type
+                             modprobe->activation-gexp)
+          (service-extension session-environment-service-type
+                             modprobe-environment)))
+   (compose concatenate)
+   (extend append)))
diff --git a/gnu/system.scm b/gnu/system.scm
index ff374dddda..ba9eeb66b8 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -58,6 +58,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
+  #:use-module (gnu services linux)
   #:use-module (gnu bootloader)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
@@ -594,6 +595,7 @@ bookkeeping."
            (service profile-service-type
                     (operating-system-packages os))
            other-fs
+           (service modprobe-service-type)
            (append mappings swaps
 
                    ;; Add the firmware service.
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index c5e2e4bf9c..b8bf88e495 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -31,6 +31,7 @@
   #:use-module (gnu build linux-container)
   #:use-module (gnu services)
   #:use-module (gnu services base)
+  #:use-module (gnu services linux)
   #:use-module (gnu services networking)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system)
@@ -48,6 +49,7 @@ from OS that are needed on the bare metal and not in a 
container."
     (remove (lambda (service)
               (memq (service-kind service)
                     (list (service-kind %linux-bare-metal-service)
+                          modprobe-service-type
                           firmware-service-type
                           system-service-type)))
             (operating-system-default-essential-services os)))
-- 
2.26.2