[bug#42193] [WIP 2/6] services: Add 'kernel-profile-service-type'.

[Brice Waegeneire]

* 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@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@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