02/02: gnu: Add kernel-module-loader-service.

[guix-commits]

dannym pushed a commit to branch master
in repository guix.

commit 044d1478c9a63a64547c9cc320008f8d8fbf6791
Author: Brice Waegeneire <address@hidden>
AuthorDate: Sun Apr 5 07:28:03 2020 +0200

    gnu: Add kernel-module-loader-service.
    
    * doc/guix.texi (Linux Services): Add a new subsection and document the
    new service and its configuration.
    * gnu/services/linux.scm (kernel-module-loader-service-type): New type.
    (kernel-module-loader-shepherd-service): New procedure.
    * gnu/tests/linux-modules.scm (module-loader-program): Procedure
    removed.
    (modules-loaded?-program): New procedure.
    (run-loadable-kernel-modules-test): 'module-loader-program' procedure
    replaced by the new one.
    [os]: Use 'kernel-module-loader-service'.
    
    Signed-off-by: Danny Milosavljevic <address@hidden>
---
 doc/guix.texi               | 37 +++++++++++++++++++++++++++++
 gnu/services/linux.scm      | 57 ++++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/linux-modules.scm | 45 ++++++++++++++++++++++++-----------
 3 files changed, 125 insertions(+), 14 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8cb85fe..bc56024 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -76,6 +76,7 @@ Copyright @copyright{} 2020 Damien Cassou@*
 Copyright @copyright{} 2020 Jakub Kądziołka@*
 Copyright @copyright{} 2020 Jack Hill@*
 Copyright @copyright{} 2020 Naga Malleswari@*
+Copyright @copyright{} 2020 Brice Waegeneire@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -25383,6 +25384,42 @@ notifications.
 @end table
 @end deftp
 
+@cindex modprobe
+@cindex kernel module loader
+@subsubsection Kernel Module Loader Service
+
+The kernel module loader service allows one to load loadable kernel
+modules at boot.  This is especially useful for modules that don't
+autoload and need to be manually loaded, as it's the case with
+@code{ddcci}.
+
+@deffn {Scheme Variable} kernel-module-loader-service-type
+The service type for loading loadable kernel modules at boot with
+@command{modprobe}.  Its value must be a list of strings representing
+module names.  For example loading the drivers provided by
+@code{ddcci-driver-linux}, in debugging mode by passing some module
+parameters, can be done as follow:
+
+@lisp
+(use-modules (gnu) (gnu services))
+(use-package-modules linux)
+(use-service-modules linux)
+
+(define ddcci-config
+  (plain-file "ddcci.conf"
+              "options ddcci dyndbg delay=120"))
+
+(operating-system
+  ...
+  (services (cons* (service kernel-module-loader-service-type
+                            '("ddcci" "ddcci_backlight"))
+                   (simple-service 'ddcci-config etc-service-type
+                                   (list `("modprobe.d/ddcci.conf"
+                                           ,ddcci-config)))
+                   %base-services))
+  (kernel-loadable-modules (list ddcci-driver-linux)))
+@end lisp
+@end deffn
 
 @node Miscellaneous Services
 @subsection Miscellaneous Services
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index caa0326..781a619 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Maxim Cournoyer <address@hidden>
+;;; Copyright © 2020 Brice Waegeneire <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,8 @@
   #:use-module (gnu packages linux)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:export (earlyoom-configuration
             earlyoom-configuration?
@@ -37,7 +40,9 @@
             earlyoom-configuration-ignore-positive-oom-score-adj?
             earlyoom-configuration-show-debug-messages?
             earlyoom-configuration-send-notification-command
-            earlyoom-service-type))
+            earlyoom-service-type
+
+            kernel-module-loader-service-type))
 
 
 ;;;
@@ -123,3 +128,53 @@ representation."
     (list (service-extension shepherd-root-service-type
                              (compose list earlyoom-shepherd-service))))
    (description "Run @command{earlyoom}, the Early OOM daemon.")))
+
+
+;;;
+;;; Kernel module loader.
+;;;
+
+(define kernel-module-loader-shepherd-service
+  (match-lambda
+    ((and (? list? kernel-modules) ((? string?) ...))
+     (list
+      (shepherd-service
+       (documentation "Load kernel modules.")
+       (provision '(kernel-module-loader))
+       (requirement '(file-systems))
+       (respawn? #f)
+       (one-shot? #t)
+       (modules `((srfi srfi-1)
+                  (srfi srfi-34)
+                  (srfi srfi-35)
+                  (rnrs io ports)
+                  ,@%default-modules))
+       (start
+        #~(lambda _
+            (cond
+             ((null? '#$kernel-modules) #t)
+             ((file-exists? "/proc/sys/kernel/modprobe")
+              (let ((modprobe (call-with-input-file
+                               "/proc/sys/kernel/modprobe" get-line)))
+                (guard (c ((message-condition? c)
+                           (format (current-error-port) "~a~%"
+                                   (condition-message c))
+                           #f))
+                  (every (lambda (module)
+                         (invoke/quiet modprobe "--" module))
+                         '#$kernel-modules))))
+             (else
+               (format (current-error-port) "error: ~a~%"
+                       "Kernel is missing loadable module support.")
+               #f)))))))))
+
+(define kernel-module-loader-service-type
+  (service-type
+   (name 'kernel-module-loader)
+   (description "Load kernel modules.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             kernel-module-loader-shepherd-service)))
+   (compose concatenate)
+   (extend append)
+   (default-value '())))
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 39e1158..788bdc8 100644
--- a/gnu/tests/linux-modules.scm
+++ b/gnu/tests/linux-modules.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <address@hidden>
 ;;; Copyright © 2020 Danny Milosavljevic <address@hidden>
+;;; Copyright © 2020 Brice Waegeneire <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 
 (define-module (gnu tests linux-modules)
   #:use-module (gnu packages linux)
+  #:use-module (gnu services)
+  #:use-module (gnu services linux)
   #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (gnu tests)
@@ -37,25 +40,40 @@
 ;;;
 ;;; Code:
 
-(define* (module-loader-program os modules)
-  "Return an executable store item that, upon being evaluated, will dry-run
-load MODULES."
+(define* (modules-loaded?-program os modules)
+  "Return an executable store item that, upon being evaluated, will verify
+that MODULES are actually loaded."
   (program-file
-   "load-kernel-modules.scm"
-   (with-imported-modules (source-module-closure '((guix build utils)))
-     #~(begin
-         (use-modules (guix build utils))
-         (for-each (lambda (module)
-                     (invoke (string-append #$kmod "/bin/modprobe") "-n" "--"
-                             module))
-                   '#$modules)))))
+   "verify-kernel-modules-loaded.scm"
+   #~(begin
+     (use-modules (ice-9 rdelim)
+                  (ice-9 popen)
+                  (srfi srfi-1)
+                  (srfi srfi-13))
+     (let* ((port (open-input-pipe (string-append #$kmod "/bin/lsmod")))
+            (lines (string-split (read-string port) #\newline))
+            (separators (char-set #\space #\tab))
+            (modules (map (lambda (line)
+                            (string-take line
+                                         (or (string-index line separators)
+                                             0)))
+                          lines))
+            (status (close-pipe port)))
+       (and (= status 0)
+            (and-map (lambda (module)
+                       (member module modules string=?))
+                     '#$modules))))))
 
 (define* (run-loadable-kernel-modules-test module-packages module-names)
-  "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES."
+  "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES
+are loaded in memory."
   (define os
     (marionette-operating-system
      (operating-system
       (inherit (simple-operating-system))
+      (services (cons (service kernel-module-loader-service-type module-names)
+                      (operating-system-user-services
+                       (simple-operating-system))))
       (kernel-loadable-modules module-packages))
      #:imported-modules '((guix combinators))))
   (define vm (virtual-machine os))
@@ -75,7 +93,8 @@ load MODULES."
              marionette))
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-  (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os 
module-names))))
+  (gexp->derivation "loadable-kernel-modules"
+                    (test (modules-loaded?-program os module-names))))
 
 (define %test-loadable-kernel-modules-0
   (system-test