Package: guix-patches;
Reported by: Brice Waegeneire <brice <at> waegenei.re>
Date: Sat, 4 Jul 2020 18:53:02 UTC
Severity: normal
View this message in rfc822 format
From: Brice Waegeneire <brice <at> waegenei.re> To: 42193 <at> debbugs.gnu.org Subject: [bug#42193] [WIP 2/6] services: Add 'kernel-profile-service-type'. Date: Sat, 4 Jul 2020 20:54:27 +0200
* gnu/system.scm (operating-system-default-essential-services): Use
'kernel-profile-service-type'.
(operating-system-default-essential-services): Remove kernel profile.
(package-for-kernel): Move it to …
* gnu/services.scm (package-for-kernel): … here.
(kernel-profile-configuration,
kernel-profile-configuration->profile-entry,
kernel-profile-service-type): New variables.
* gnu/tests/linux-modules.scm (run-loadable-kernel-modules-test): Test
'kernel-profile-service-type'.
---
gnu/services.scm | 66 ++++++++++++++++++++++++++++++++++++-
gnu/system.scm | 14 +++-----
gnu/tests/linux-modules.scm | 10 +++---
3 files changed, 75 insertions(+), 15 deletions(-)
diff --git a/gnu/services.scm b/gnu/services.scm
index f6dc56d940..b5ec222207 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke <at> gnu.org>
+;;; Copyright © 2020 Brice Waegeneire <brice <at> waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,9 +31,11 @@
#:use-module (guix describe)
#:use-module (guix sets)
#:use-module (guix ui)
- #:use-module ((guix utils) #:select (source-properties->location))
+ #:use-module ((guix utils) #:select (source-properties->location
+ substitute-keyword-arguments))
#:autoload (guix openpgp) (openpgp-format-fingerprint)
#:use-module (guix modules)
+ #:use-module (guix packages)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages hurd)
@@ -105,6 +108,12 @@
firmware-service-type
gc-root-service-type
+ kernel-profile-configuration
+ kernel-profile-configuration?
+ kernel-profile-configuration-kernel
+ kernel-profile-configuration-packages
+ kernel-profile-service-type
+
%boot-service
%activation-service
etc-service))
@@ -474,6 +483,61 @@ channels in use and CONFIG-FILE, if it is true."
itself: the channels used when building the system, and its configuration
file, when available.")))
+
+;;;
+;;; Kernel profile.
+;;;
+
+(define-record-type* <kernel-profile-configuration>
+ kernel-profile-configuration make-kernel-profile-configuration
+ kernel-profile-configuration?
+ (kernel kernel-profile-configuration-kernel) ; <package>
+ (packages kernel-profile-configuration-packages ; list of <package>
+ (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-profile-configuration->profile-entry config)
+ "Return a system entry for the kernel profile CONFIG."
+ (let* ((kernel (kernel-profile-configuration-kernel config))
+ (packages (map (lambda (package)
+ (if (package? package)
+ (package-for-kernel kernel
+ package)
+ package))
+ (kernel-profile-configuration-packages config))))
+ (with-monad %store-monad
+ (return `(("kernel"
+ ,(profile
+ (content (packages->manifest
+ (cons kernel
+ (delete-duplicates packages eq?))))
+ (hooks (list linux-module-database)))))))))
+
+(define kernel-profile-service-type
+ (service-type (name 'kernel-profile)
+ (description "This is the @dfn{kernel profile}, available as
+@file{/run/current-system/kernel}.")
+ (extensions
+ (list (service-extension
+ system-service-type
+ kernel-profile-configuration->profile-entry)))
+ (compose concatenate)
+ (extend (lambda (config additional-packages)
+ (match-record config <kernel-profile-configuration>
+ (kernel packages)
+ (kernel-profile-configuration
+ (kernel kernel) ;the kernel package to use
+ (packages (append packages additional-packages))))))))
+
;;;
;;; Cleanup.
diff --git a/gnu/system.scm b/gnu/system.scm
index bfbcb6fbdd..ff374dddda 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -511,16 +511,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>
@@ -574,6 +564,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 kernel-profile-service-type
+ (kernel-profile-configuration
+ (kernel (operating-system-kernel os))
+ (packages (operating-system-kernel-loadable-modules os))))
%boot-service
;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 953b132ef7..22e9a0c65c 100644
--- a/gnu/tests/linux-modules.scm
+++ b/gnu/tests/linux-modules.scm
@@ -73,10 +73,12 @@ are loaded in memory."
(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))
+ (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)))))
#:imported-modules '((guix combinators))))
(define vm (virtual-machine os))
(define (test script)
--
2.26.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.