Hi Carlo and guix-developers,
I have this patch below for creating a new
`kernel-loadable-module-service-type`, which can be extended by another service
to add kernel-loadable modules provided by packages, hope for a review.
>From 984602faba1e18b9eb64e62970147aab653d997f Mon Sep 17 00:00:00 2001
From: raid5atemyhomework <raid5atemyhomew...@protonmail.com>
Date: Tue, 5 Jan 2021 22:27:56 +0800
Subject: [PATCH] gnu: Add 'kernel-loadable-module-service-type' for services
to extend with kernel-loadable modules.
---
doc/guix.texi | 6 +++++
gnu/services.scm | 68 ++++++++++++++++++++++++++++++++++++++++++++++++
gnu/system.scm | 36 +++++++------------------
3 files changed, 83 insertions(+), 27 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 0f6e95a65a..78770151e3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32409,6 +32409,12 @@ configuration when you use @command{guix system
reconfigure},
@command{guix system init}, or @command{guix deploy}.
@end defvr
+@defvr {Scheme Variable} kernel-loadable-module-service-type
+Type of the service that collects lists of packages containing
+kernel-loadable modules, and adds them to the set of kernel-loadable
+modules.
+@end defvr
+
@node Shepherd Services
@subsection Shepherd Services
diff --git a/gnu/services.scm b/gnu/services.scm
index 13259dfaee..2c0bbf9725 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -33,6 +33,8 @@
#:use-module (guix diagnostics)
#:autoload (guix openpgp) (openpgp-format-fingerprint)
#:use-module (guix modules)
+ #:use-module (guix packages)
+ #:use-module (guix utils)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages hurd)
@@ -75,6 +77,7 @@
service-back-edges
instantiate-missing-services
fold-services
+ kernel-loadable-module-service
service-error?
missing-value-service-error?
@@ -106,6 +109,7 @@
profile-service-type
firmware-service-type
gc-root-service-type
+ kernel-loadable-module-service-type
%boot-service
%activation-service
@@ -864,6 +868,70 @@ as Wifi cards.")))
will not be reclaimed by the garbage collector.")
(default-value '())))
+;; Configuration for the kernel builder.
+;; Only used by the KERNEL-LOADABLE-MODULE-SERVICE-TYPE.
+(define-record-type* <kernel-builder-configuration>
kernel-builder-configuration
+ make-kernel-builder-configuration
+ kernel-builder-configuration?
+ this-kernel-builder-configuration
+
+ (kernel kernel-builder-configuration-kernel (default #f))
+ (hurd kernel-builder-configuration-hurd (default #f))
+ (modules kernel-builder-configuration-modules (default '())))
+
+(define (package-for-kernel target-kernel module-package)
+ "Return a package like MODULE-PACKAGE, adapted for TARGET-KERNEL, if
+possible (that is if there's a LINUX keyword argument in the build system)."
+ (package
+ (inherit module-package)
+ (arguments
+ (substitute-keyword-arguments (package-arguments module-package)
+ ((#:linux kernel #f)
+ target-kernel)))))
+
+(define (kernel-builder-configuration->system-entry config)
+ "Return the kernel and hurd entries of the 'system' directory of OS."
+ (mbegin %store-monad
+ (let* ((kernel (kernel-builder-configuration-kernel config))
+ (hurd (kernel-builder-configuration-hurd config))
+ (modules (kernel-builder-configuration-modules config))
+ (kernel (if hurd
+ kernel
+ (profile
+ (content (packages->manifest
+ (cons kernel
+ (map (lambda (module)
+ (if (package? module)
+ (package-for-kernel kernel
module)
+ module))
+ modules))))
+ (hooks (list linux-module-database))))))
+ (return `(("kernel" ,kernel)
+ ,@(if hurd `(("hurd" ,hurd)) '()))))))
+(define (kernel-builder-configuration-add-modules config modules)
+ "Constructs a kernel builder configuration that has its modules extended."
+ (kernel-builder-configuration
+ (inherit config)
+ (modules (append (kernel-builder-configuration-modules config) modules))))
+
+(define kernel-loadable-module-service-type
+ (service-type (name 'kernel-loadable-modules)
+ (extensions
+ (list (service-extension system-service-type
+
kernel-builder-configuration->system-entry)))
+ (compose concatenate)
+ (extend kernel-builder-configuration-add-modules)
+ (description
+ "Register packages containing kernel-loadable modules and
adds them
+to the system.")))
+(define (kernel-loadable-module-service kernel hurd modules)
+ "Constructs the service that sets up kernel loadable modules."
+ (service kernel-loadable-module-service-type
+ (kernel-builder-configuration
+ (kernel kernel)
+ (hurd hurd)
+ (modules modules))))
+
;;;
;;; Service folding.
diff --git a/gnu/system.scm b/gnu/system.scm
index c284a18379..a7f2365754 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -600,16 +600,6 @@ OS."
(file-append (operating-system-kernel os)
"/" (system-linux-image-file-name))))
-(define (package-for-kernel target-kernel module-package)
- "Return a package like MODULE-PACKAGE, adapted for TARGET-KERNEL, if
-possible (that is if there's a LINUX keyword argument in the build system)."
- (package
- (inherit module-package)
- (arguments
- (substitute-keyword-arguments (package-arguments module-package)
- ((#:linux kernel #f)
- target-kernel)))))
-
(define %default-modprobe-blacklist
;; List of kernel modules to blacklist by default.
'("usbmouse" ;races with bcm5974, see <https://bugs.gnu.org/35574>
@@ -625,26 +615,10 @@ possible (that is if there's a LINUX keyword argument in
the build system)."
"Return the basic entries of the 'system' directory of OS for use as the
value of the SYSTEM-SERVICE-TYPE service."
(let* ((locale (operating-system-locale-directory os))
- (kernel (operating-system-kernel os))
(hurd (operating-system-hurd os))
- (modules (operating-system-kernel-loadable-modules os))
- (kernel (if hurd
- kernel
- (profile
- (content (packages->manifest
- (cons kernel
- (map (lambda (module)
- (if (package? module)
- (package-for-kernel kernel
- module)
- module))
- modules))))
- (hooks (list linux-module-database)))))
(initrd (and (not hurd) (operating-system-initrd-file os)))
(params (operating-system-boot-parameters-file os)))
- `(("kernel" ,kernel)
- ,@(if hurd `(("hurd" ,hurd)) '())
- ("parameters" ,params)
+ `(("parameters" ,params)
,@(if initrd `(("initrd" ,initrd)) '())
("locale" ,locale)))) ;used by libc
@@ -663,6 +637,10 @@ bookkeeping."
(host-name (host-name-service (operating-system-host-name os)))
(entries (operating-system-directory-base-entries os)))
(cons* (service system-service-type entries)
+ (kernel-loadable-module-service
+ (operating-system-kernel os)
+ (operating-system-hurd os)
+ (operating-system-kernel-loadable-modules os))
%boot-service
;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that
@@ -699,6 +677,10 @@ bookkeeping."
(define (hurd-default-essential-services os)
(let ((entries (operating-system-directory-base-entries os)))
(list (service system-service-type entries)
+ (kernel-loadable-module-service
+ (operating-system-kernel os)
+ (operating-system-hurd os)
+ (operating-system-kernel-loadable-modules os))
%boot-service
%hurd-startup-service
%activation-service
--
2.29.2
