summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorBrice Waegeneire <brice@waegenei.re>2020-04-05 07:28:03 +0200
committerDanny Milosavljevic <dannym@scratchpost.org>2020-04-05 13:07:13 +0200
commit044d1478c9a63a64547c9cc320008f8d8fbf6791 (patch)
tree622a7ba842a075a3cc4ac8b433a2161e8bbc8400 /gnu/services
parent8c88e242292db9b35b4ae6ad788a0f8f3c94bb53 (diff)
downloadguix-044d1478c9a63a64547c9cc320008f8d8fbf6791.tar.gz
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 <dannym@scratchpost.org>
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/linux.scm57
1 files changed, 56 insertions, 1 deletions
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index caa0326c31..781a61973c 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 <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; 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 '())))