kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

gnu: Allow services to install kernel-loadable modules.

Browse Source 
* gnu/system.scm (operating-system-directory-base-entries): Remove code
to handle generation of "kernel" for linux-libre kernels.
(operating-system-default-essential-services): Instantiate
linux-builder-service-type.
(package-for-kernel): Move ...
* gnu/services.scm: ... to here.
(linux-builder-service-type): New variable.
(linux-builder-configuration): New type.
(linux-loadable-module-service-type): New variable.
* gnu/tests/linux-modules.scm (run-loadable-kernel-modules-test): Move
code to ...
(run-loadable-kernel-modules-test-base): ... new procedure here.
(run-loadable-kernel-modules-service-test): New procedure.
(%test-loadable-kernel-modules-service-0): New variable.
(%test-loadable-kernel-modules-service-1): New variable.
(%test-loadable-kernel-modules-service-2): New variable.
* doc/guix.texi: Document linux-loadable-module-service-type.

Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org>
This commit is contained in:
raid5atemyhomework 2021-03-22 11:23:32 +08:00 committed by Danny Milosavljevic
parent bddad00bff
commit a3df382525
No known key found for this signature in database
GPG Key ID: E71A35542C30BAA5
4 changed files with 191 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
doc/guix.texi
View File

@ -34280,6 +34280,28 @@ configuration when you use @command{guix system reconfigure},
@command{guix system init}, or @command{guix deploy}.
@end defvr
@defvr {Scheme Variable} linux-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.
This service type is intended to be extended by other service types,
such as below:
@lisp
(define module-installing-service-type
(service-type
(name 'module-installing-service)
(extensions (list (service-extension linux-loadable-module-service-type
(const (list module-to-install-1
module-to-install-2)))))
(default-value #f)))
@end lisp
This does not actually load modules at bootup, only adds it to the
kernel profile so that it @emph{can} be loaded by other means.
@end defvr
@node Shepherd Services
@subsection Shepherd Services

90
gnu/services.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -34,6 +35,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)
@ -107,6 +110,12 @@
profile-service-type
firmware-service-type
gc-root-service-type
linux-builder-service-type
linux-builder-configuration
linux-builder-configuration?
linux-builder-configuration-kernel
linux-builder-configuration-modules
linux-loadable-module-service-type
%boot-service
%activation-service
@ -883,6 +892,87 @@ as Wifi cards.")))
will not be reclaimed by the garbage collector.")
(default-value '())))
;; Configuration for the Linux kernel builder.
(define-record-type* <linux-builder-configuration>
linux-builder-configuration
make-linux-builder-configuration
linux-builder-configuration?
this-linux-builder-configuration
(kernel linux-builder-configuration-kernel) ; package
(modules linux-builder-configuration-modules (default '()))) ; list of packages
(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 (linux-builder-configuration->system-entry config)
"Return the kernel entry of the 'system' directory."
(let* ((kernel (linux-builder-configuration-kernel config))
(modules (linux-builder-configuration-modules config))
(kernel (profile
(content (packages->manifest
(cons kernel
(map (lambda (module)
(cond
((package? module)
(package-for-kernel kernel module))
;; support (,package "kernel-module-output")
((and (list? module) (package? (car module)))
(cons (package-for-kernel kernel
(car module))
(cdr module)))
(else
module)))
modules))))
(hooks (list linux-module-database)))))
(with-monad %store-monad
(return `(("kernel" ,kernel))))))
(define linux-builder-service-type
(service-type (name 'linux-builder)
(extensions
(list (service-extension system-service-type
linux-builder-configuration->system-entry)))
(default-value '())
(compose identity)
(extend (lambda (config modifiers)
(if (null? modifiers)
config
((apply compose modifiers) config))))
(description "Builds the linux-libre kernel profile, containing
the kernel itself and any linux-loadable kernel modules. This can be extended
with a function that accepts the current configuration and returns a new
configuration.")))
(define (linux-loadable-module-builder-modifier modules)
"Extends linux-builder-service-type by appending the given MODULES to the
configuration of linux-builder-service-type."
(lambda (config)
(linux-builder-configuration
(inherit config)
(modules (append (linux-builder-configuration-modules config)
modules)))))
(define linux-loadable-module-service-type
(service-type (name 'linux-loadable-modules)
(extensions
(list (service-extension linux-builder-service-type
linux-loadable-module-builder-modifier)))
(default-value '())
(compose concatenate)
(extend append)
(description "Adds packages and package outputs as modules
included in the booted linux-libre profile. Other services can extend this
service type to add particular modules to the set of linux-loadable modules.")))
;;;
;;; Service folding.

34
gnu/system.scm
View File

@ -13,6 +13,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -601,16 +602,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>
@ -628,23 +619,12 @@ 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)) '())
`(,@(if hurd
`(("hurd" ,hurd)
("kernel" ,kernel))
'())
("parameters" ,params)
,@(if initrd `(("initrd" ,initrd)) '())
("locale" ,locale)))) ;used by libc
@ -664,6 +644,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)
(service linux-builder-service-type
(linux-builder-configuration
(kernel (operating-system-kernel os))
(modules (operating-system-kernel-loadable-modules os))))
%boot-service
;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that

80
gnu/tests/linux-modules.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -34,7 +35,10 @@
#:use-module (guix utils)
#:export (%test-loadable-kernel-modules-0
%test-loadable-kernel-modules-1
%test-loadable-kernel-modules-2))
%test-loadable-kernel-modules-2
%test-loadable-kernel-modules-service-0
%test-loadable-kernel-modules-service-1
%test-loadable-kernel-modules-service-2))
;;; Commentary:
;;;
@ -66,17 +70,11 @@ 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-base base-os module-names)
"Run a test of BASE-OS, verifying 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))
base-os
#:imported-modules '((guix combinators))))
(define vm (virtual-machine os))
(define (test script)
@ -98,6 +96,36 @@ are loaded in memory."
(gexp->derivation "loadable-kernel-modules"
(test (modules-loaded?-program os module-names))))
(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."
(run-loadable-kernel-modules-test-base
(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))
module-names))
(define* (run-loadable-kernel-modules-service-test module-packages module-names)
"Run a test of an OS having MODULE-PACKAGES, which are loaded by creating a
service that extends LINUXL-LOADABLE-MODULE-SERVICE-TYPE. Then verify that
MODULE-NAMES are loaded in memory."
(define module-installing-service-type
(service-type
(name 'module-installing-service)
(extensions (list (service-extension linux-loadable-module-service-type
(const module-packages))))
(default-value #f)))
(run-loadable-kernel-modules-test-base
(operating-system
(inherit (simple-operating-system))
(services (cons* (service module-installing-service-type)
(operating-system-user-services
(simple-operating-system)))))
module-names))
(define %test-loadable-kernel-modules-0
(system-test
(name "loadable-kernel-modules-0")
@ -129,3 +157,35 @@ with two extra modules.")
(package-arguments
ddcci-driver-linux))))))
'("acpi_call" "ddcci")))))
(define %test-loadable-kernel-modules-service-0
(system-test
(name "loadable-kernel-modules-service-0")
(description "Tests loadable kernel modules extensible service with no
extra modules.")
(value (run-loadable-kernel-modules-service-test '() '()))))
(define %test-loadable-kernel-modules-service-1
(system-test
(name "loadable-kernel-modules-service-1")
(description "Tests loadable kernel modules extensible service with one
extra module.")
(value (run-loadable-kernel-modules-service-test
(list ddcci-driver-linux)
'("ddcci")))))
(define %test-loadable-kernel-modules-service-2
(system-test
(name "loadable-kernel-modules-service-2")
(description "Tests loadable kernel modules extensible service with two
extra modules.")
(value (run-loadable-kernel-modules-service-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")))))