Toggle diff (302 lines)
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index 7ea30a1270..9773dd5072 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -45,7 +45,22 @@
kernel-module-loader-service-type
- modprobe-service-type))
+ modprobe-service-type
+
+ kernel-module
+ kernel-module?
+ kernel-module-name
+ kernel-module-package
+ kernel-module-aliases
+ kernel-module-install
+ kernel-module-remove
+ kernel-module-pre-dependencies
+ kernel-module-post-dependencies
+ kernel-module-blacklist?
+ kernel-module-load?
+ kernel-module-is-builtin?
+ kernel-module->kernel-arguments
+ kernel-module-configuration-service-type))
;;;
@@ -151,6 +166,9 @@ representation."
(rnrs io ports)
,@%default-modules))
(start
+ ;; TODO Verify that we are loading a loadable kernel and not a builtin
+ ;; one looking in
+ ;; /run/booted-system/kernel/lib/modules/5.4.39/modules.builtin
#~(lambda _
(cond
((null? '#$kernel-modules) #t)
@@ -227,3 +245,149 @@ files."
modprobe-environment)))
(compose concatenate)
(extend append)))
+
+
+;;;
+;;; Kernel module configuration.
+;;;
+
+;; NOTE Maybe have sperate records betwwen <kernel-builtin-module> and
+;; <kernel-lodable-module>
+(define-record-type* <kernel-module>
+ kernel-module make-kernel-module
+ kernel-module?
+ (name kernel-module-name) ; string
+ ;; For out-of-tree modules
+ (package kernel-module-package
+ (default #f)) ; #f | <package>
+ ;; NOTE Maybe use an alist instead
+ (options kernel-module-options
+ (default '())) ; list of strings
+ (aliases kernel-module-aliases
+ (default '())) ; list of strings
+ (install kernel-module-install
+ (default #f)) ; #f | string
+ (remove kernel-module-remove
+ (default #f)) ; #f | string
+ (pre-dependencies kernel-module-pre-dependencies
+ (default '())) ; list of strings
+ (post-dependencies kernel-module-post-dependencies
+ (default '())) ; list of strings
+ (blacklist? kernel-module-blacklist?
+ (default #f)) ; boolean
+ ;; NOTE Only possible if it's not built-in
+ ;; TODO maybe trow an error when it's set to true on a built-in module
+ (load? kernel-module-load?
+ (default #f))) ; boolean
+
+;; FIXME use 'modules.builtin' instead
+(define (kernel-module-is-builtin? module)
+ (if (kernel-module-package module) #f
+ #t))
+
+(define (kernel-module->kernel-arguments module)
+ "Return a list of kernel arguments for MODULE."
+ (match-record module <kernel-module>
+ (name options blacklist?)
+ (filter (lambda (s) (not (string-null? s)))
+ (list (if blacklist? (string-append name ".blacklist=yes") "")
+ (if (null? options) ""
+ (map (lambda (option)
+ (string-append name "." option))
+ options))))))
+
+(define (kernel-module->config module)
+ "Return a config string for MODULE."
+ (match-record module <kernel-module>
+ (name options aliases install remove pre-dependencies
+ post-dependencies blacklist?)
+ (string-concatenate
+ (list (if (null? options) ""
+ (format #f "options ~a~{ ~a~}\n" name options))
+ (if blacklist? (format #f "blacklist ~a\n" name)
+ "")
+ (if (null? aliases) ""
+ (map (lambda (alias)
+ (format #f "alias ~a ~a\n" alias name))
+ aliases))
+ (if install (format #f "install ~a ~a\n" name install)
+ "")
+ (if remove (format #f "remove ~a ~a\n" name remove)
+ "")
+ (if (null? pre-dependencies) ""
+ (map (lambda (dependency)
+ (format #f "softdep ~a :pre ~a\n"
+ name dependency))
+ pre-dependencies))
+ (if (null? post-dependencies) ""
+ (map (lambda (dependency)
+ (format #f "softdep ~a :post ~a\n"
+ name dependency))
+ post-dependencies))))))
+
+(define (string-underscorize s)
+ "Replace '-' characters by '_' in string S."
+ (string-map (lambda (c) (if (char=? c #\-) #\_ c)) s))
+
+(define (kernel-modules->config-files modules)
+ "Return a list of pairs of file name and gexp, to be used by 'file-union',
+from MODULES."
+ (define (kernel-module->filename-gexp module)
+ (let ((config (kernel-module->config module))
+ (name (kernel-module-name module)))
+ (if (string-null? config) #f
+ (list (string-append name ".conf")
+ (plain-file (string-append name ".conf") config)))))
+ (filter-map
+ (lambda (module)
+ (let ((module (kernel-module
+ (inherit module)
+ ;; XXX The kernel replace '-' by '_' in module name, we do
+ ;; the same to make name collision visible, that would
+ ;; otherwise be hidden.
+ (name (string-underscorize (kernel-module-name module))))))
+ (if (kernel-module-is-builtin? module) #f
+ (kernel-module->filename-gexp module))))
+ modules))
+
+(define (kernel-modules->packages modules)
+ "Return a list of packages from MODULES."
+ (filter-map (lambda (module)
+ (kernel-module-package module))
+ modules))
+
+(define (kernel-modules-to-load modules)
+ "Return a list of loadable module names, from MODULES, to be loaded."
+ (filter-map (lambda (module)
+ (if (and (not (kernel-module-is-builtin? module))
+ (kernel-module-load? module))
+ (kernel-module-name module)
+ #f))
+ modules))
+
+(define kernel-module-configuration-service-type
+ (service-type
+ (name 'kernel-module-configuration)
+ (description
+ "Configure kernel modules, in similar manner as @file{modprobe.d}.")
+ (default-value '())
+ (extensions
+ (list (service-extension modprobe-service-type
+ kernel-modules->config-files)
+ (service-extension kernel-profile-service-type
+ kernel-modules->packages)
+ (service-extension kernel-module-loader-service-type
+ kernel-modules-to-load)))
+ (compose concatenate)
+ (extend append)))
+
+;; TODO Make a naked modprobe call use MODPROBE_OPTIONS environment or
+;; /proc/sys/kernel/modprobe
+
+;; TODO write a helper to load a module from guile using modprobe command from
+;; '/proc/sys/kernel/modprobe' or %modprobe-wrapper. See linux-module-builder
+;; maybe.
+
+;; NOTE Throw an error when kernel-module-name isn't unique? It may already
+;; do it by itself already because 2 loadable module will try to create
+;; separeta config file with the same name.
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 22e9a0c65c..296066e68f 100644
--- a/gnu/tests/linux-modules.scm
+++ b/gnu/tests/linux-modules.scm
@@ -32,6 +32,7 @@
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (srfi srfi-1)
#:export (%test-loadable-kernel-modules-0
%test-loadable-kernel-modules-1
%test-loadable-kernel-modules-2))
@@ -66,19 +67,18 @@ that MODULES are actually loaded."
(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 verify that MODULE-NAMES
-are loaded in memory."
+(define* (run-loadable-kernel-modules-test modules)
+ "Run a test of an OS having MODULES and verify that they 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)
- (simple-service 'kernel-module-packages
- kernel-profile-service-type
- module-packages)
- (operating-system-user-services
- (simple-operating-system)))))
+ (inherit (simple-operating-system))
+ (services (cons* (service kernel-module-loader-service-type)
+ (service kernel-module-configuration-service-type
+ modules)
+ (operating-system-user-services
+ (simple-operating-system)))))
#:imported-modules '((guix combinators))))
(define vm (virtual-machine os))
(define (test script)
@@ -97,15 +97,20 @@ are loaded in memory."
marionette))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (gexp->derivation "loadable-kernel-modules"
- (test (modules-loaded?-program os module-names))))
+ (let ((modules (filter-map (lambda (module)
+ (if (kernel-module-load? module)
+ (kernel-module-name module)
+ #f))
+ modules)))
+ (gexp->derivation "loadable-kernel-modules"
+ (test (modules-loaded?-program os modules)))))
(define %test-loadable-kernel-modules-0
(system-test
(name "loadable-kernel-modules-0")
(description "Tests loadable kernel modules facility of <operating-system>
with no extra modules.")
- (value (run-loadable-kernel-modules-test '() '()))))
+ (value (run-loadable-kernel-modules-test '()))))
(define %test-loadable-kernel-modules-1
(system-test
@@ -113,8 +118,11 @@ with no extra modules.")
(description "Tests loadable kernel modules facility of <operating-system>
with one extra module.")
(value (run-loadable-kernel-modules-test
- (list ddcci-driver-linux)
- '("ddcci")))))
+ (list (kernel-module
+ (name "ddcci")
+ (package ddcci-driver-linux)
+ (options '("delay=606"))
+ (load? #t)))))))
(define %test-loadable-kernel-modules-2
(system-test
@@ -122,12 +130,23 @@ with one extra module.")
(description "Tests loadable kernel modules facility of <operating-system>
with two extra modules.")
(value (run-loadable-kernel-modules-test
- (list acpi-call-linux-module
- (package
- (inherit ddcci-driver-linux)
- (arguments
- `(#:linux #f
- ,@(strip-keyword-arguments '(#:linux)
- (package-arguments
- ddcci-driver-linux))))))
- '("acpi_call" "ddcci")))))
+ (list (kernel-module
+ (name "ddcci")
+ ;; XXX Verify that kernel modules are built with the correct
+ ;; kernel
+ (package (package
+ (inherit ddcci-driver-linux)
+ (arguments
+ `(#:linux #f
+ ,@(strip-keyword-arguments '(#:linux)
+ (package-arguments
+ ddcci-driver-linux))))))
+ (load? #t))
+ (kernel-module
+ (name "acpi_call")
+ (package acpi-call-linux-module)
+ (load? #t))
+ ;; TODO Test that a module isn't loaded
+ (kernel-module
+ (name "radeon")
+ (blacklist? #t)))))))
--
2.26.2
