gnu: Allow services to install kernel-loadable modules.
* 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>master
raid5atemyhomework
Danny Milosavljevic
parent
bddad00bff
commit
a3df382525
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")))))
|
||||
|
|
|
|||
Reference in New Issue