diff mbox series

[bug#45692,1/4] gnu: Allow services to install kernel-loadable modules.

Message ID 2yOs7mxigs8_Vx_yi858pxAkoyXmU8IidizK5grcmX4M92O5QK-_Ywo9nrHMHvzLGj4U7B9ysl26eNbiPmzmeOQsuFvp5VjouVptRfwxKng=@protonmail.com
State Accepted
Headers show
Series Even Better ZFS Support on Guix | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

raid5atemyhomework Jan. 6, 2021, 3:54 p.m. UTC 
From 4beb73c62995cf236b402dad8e1c36016027c781 Mon Sep 17 00:00:00 2001
From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
Date: Tue, 5 Jan 2021 22:27:56 +0800
Subject: [PATCH 1/4] gnu: Allow services to install kernel-loadable modules.

* gnu/system.scm (operating-system-directory-base-entries): Remove code
to handle generation of "kernel" and "hurd".
(operating-system-default-essential-services): Instantiate
kernel-loadable-module-service.
(hurd-default-essential-services): Instantiate
kernel-loadable-module-service.
(package-for-kernel): Move ...
* gnu/services.scm: ... to here.
(kernel-loadable-module-service-type): New variable.
(kernel-loadable-module-service): New procedure.
* 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 kernel-loadable-module-service-type.
---
 doc/guix.texi               |  6 +++
 gnu/services.scm            | 70 ++++++++++++++++++++++++++++++++
 gnu/system.scm              | 37 +++++------------
 gnu/tests/linux-modules.scm | 81 ++++++++++++++++++++++++++++++++-----
 4 files changed, 157 insertions(+), 37 deletions(-)

--
2.29.2

Comments

raid5atemyhomework Jan. 8, 2021, 4:16 p.m. UTC | #1 
Is this patch acceptable? https://lists.nongnu.org/archive/html/guix-devel/2021-01/msg00070.html I reported that I compared a `guix system build` result of an `operating-system` that used the existing `(kernel-loadable-modules ...)` field, with and without this patch.

The resulting builds resulted in different hashes, but with exactly the same contents in the build --- `diff -r` very quickly reported no differences because it saw that nearly all the symlinks pointed to the same gnu store items.
Ludovic Courtès Feb. 10, 2021, 2:13 p.m. UTC | #2 
raid5atemyhomework <raid5atemyhomework@protonmail.com> skribis:

> +(define (kernel-builder-configuration->system-entry config)
> +  "Return the kernel and hurd entries of the 'system' directory."
> +  (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)) '()))))))

It may be clearer to avoid ‘mbegin’ and instead write it this way:

  (define (kernel-builder-configuration-modules config)
    (let* …
      (with-monad %store-monad
        (return …))))

Both work but I find this variant slightly clearer.

Ludo’.
Ludovic Courtès Feb. 10, 2021, 3:44 p.m. UTC | #3 
Hi,

raid5atemyhomework <raid5atemyhomework@protonmail.com> skribis:

>>From 4beb73c62995cf236b402dad8e1c36016027c781 Mon Sep 17 00:00:00 2001
> From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
> Date: Tue, 5 Jan 2021 22:27:56 +0800
> Subject: [PATCH 1/4] gnu: Allow services to install kernel-loadable modules.
>
> * gnu/system.scm (operating-system-directory-base-entries): Remove code
> to handle generation of "kernel" and "hurd".
> (operating-system-default-essential-services): Instantiate
> kernel-loadable-module-service.
> (hurd-default-essential-services): Instantiate
> kernel-loadable-module-service.
> (package-for-kernel): Move ...
> * gnu/services.scm: ... to here.
> (kernel-loadable-module-service-type): New variable.
> (kernel-loadable-module-service): New procedure.
> * 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 kernel-loadable-module-service-type.

[…]

> +@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

Would be nice to expound a bit here, in particular by adding an example
(along the lines of those used in system tests maybe?).  Otherwise it
can be hard to fathom how this is meant to be used.

> +;; Configuration for the kernel builder.
> +(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 '())))

How about <linux-build-configuration> instead?

In general, throughout the project, we do not use “kernel” and “Linux”
interchangeably.  Since this is a Linux-only feature, let’s call it that
way and remove the ‘hurd’ field (the Hurd has no notion of in-kernel
modules since pretty much everything happens in user-space.)

> +(define kernel-loadable-module-service-type
> +  (service-type (name 'kernel-loadable-modules)

Same here: ‘linux-loadable-module-service-type’.

But… it’s not clear at first sight how this differs from the existing
‘kernel-module-loader’.  Perhaps ‘linux-build-service-type’ would be
more accurate?  Or am I missing something?

Thanks,
Ludo’.
raid5atemyhomework Feb. 10, 2021, 4:49 p.m. UTC | #4 
> > +;; Configuration for the kernel builder.
> > +(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 '())))
>
> How about <linux-build-configuration> instead?
>
> In general, throughout the project, we do not use “kernel” and “Linux”
> interchangeably. Since this is a Linux-only feature, let’s call it that
> way and remove the ‘hurd’ field (the Hurd has no notion of in-kernel
> modules since pretty much everything happens in user-space.)

The `operating-system` record uses `kernel-loadable-modules` as the record field name.  I suggest changing that first, if you truly want to differentiate "kernel" from "linux" "throughout the project".  Or deprecate it entirely and instead use the new `linux-loadable-modules-service-type`, in principle the only field needed in `operating-system` should be `services`.

>
> > +(define kernel-loadable-module-service-type
> >
> > -   (service-type (name 'kernel-loadable-modules)
>
> Same here: ‘linux-loadable-module-service-type’.
>
> But… it’s not clear at first sight how this differs from the existing
> ‘kernel-module-loader’. Perhaps ‘linux-build-service-type’ would be
> more accurate? Or am I missing something?


`kernel-module-loader` explicitly loads a module at startup, it does not make a non-Linux-libre-built-in module actually *loadable*.  So there is a need for something to augment the `linux-loadable-modules` record field of `operating-system`.

Thanks
raid5atemyhomework
diff mbox series

Patch

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..d7332a46b2 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 © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,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 +78,7 @@ 
             service-back-edges
             instantiate-missing-services
             fold-services
+            kernel-loadable-module-service

             service-error?
             missing-value-service-error?
@@ -106,6 +110,7 @@ 
             profile-service-type
             firmware-service-type
             gc-root-service-type
+            kernel-loadable-module-service-type

             %boot-service
             %activation-service
@@ -864,6 +869,71 @@  as Wifi cards.")))
 will not be reclaimed by the garbage collector.")
                 (default-value '())))

+;; Configuration for the kernel builder.
+(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."
+  (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..5c530f176e 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -12,6 +12,7 @@ 
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -600,16 +601,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 +616,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 +638,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 +678,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
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 953b132ef7..9739e4124d 100644
--- a/gnu/tests/linux-modules.scm
+++ b/gnu/tests/linux-modules.scm
@@ -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,37 @@  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 KERNEL-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 kernel-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 kernel-module-loader-service-type module-names)
+                       (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 +158,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")))))