[bug#37868,v4] system: Add kernel-module-packages to operating-system.
diff mbox series

Message ID 20200225105549.30115-1-dannym@scratchpost.org
State Accepted
Headers show
Series
  • [bug#37868,v4] system: Add kernel-module-packages to operating-system.
Related show

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Danny Milosavljevic Feb. 25, 2020, 10:55 a.m. UTC
* gnu/system.scm (<operating-system>): Add kernel-module-packages.
(operating-system-directory-base-entries): Use it.
* doc/guix.texi (operating-system Reference): Document KERNEL-LOADABLE-MODULES.
* gnu/build/linux-modules.scm (depmod!): New procedure.
(ensure-linux-module-directory!): New procedure.  Export it.
* guix/profiles.scm (linux-module-database): New procedure.  Export it.
* gnu/tests/linux-modules.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  46 +++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 102 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 6 files changed, 215 insertions(+), 6 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

Comments

Danny Milosavljevic Feb. 25, 2020, 11:32 a.m. UTC | #1
Some extra comments:

* I have to really really prevent myself from just making the <operating-system>
field KERNEL a list.  Because that's what happens at runtime anyway.
It's just an union of those things, then it runs depmod.  The separation
into KERNEL and KERNEL-LOADABLE-MODULES is artificial.

* There's a collision warning:

warning: collision encountered:
  /gnu/store/3ar8aym8khxh1rdjf5gxqsk0hv7r9p96-linux-module-database/lib/modules/5.4.22-gnu/modules.symbols.bin
  /gnu/store/4r0fz0f37bp1zqbqclgrq1l4sm1acy4p-linux-libre-5.4.22/lib/modules/5.4.22-gnu/modules.symbols.bin
warning: choosing /gnu/store/3ar8aym8khxh1rdjf5gxqsk0hv7r9p96-linux-module-database/lib/modules/5.4.22-gnu/modules.symbols.bin

I think that's because the Linux kernel linux-libre we build already has those
files.  Those files in linux-libre are stale cache files when you have extra
modules (because they don't list those extra modules).

@Ludo: You said I should remove the null? case (check if there are no extra modules).

I did, so actually, these modules.*.bin files in linux-libre are useless since
the profile-derivation of linux-module-database will rebuild them anyway (via
depmod), also in the case with no extra modules.

The reason I had the null? case before is in order to leave the case with no
extra modules unchanged from before (defensive programming).

But now that we don't do that, should we make linux-libre not invoke depmod?
Or should we filter those files out manually in the profile hook?

Patch
diff mbox series

diff --git a/doc/guix.texi b/doc/guix.texi
index a66bb3d646..01e2d1ab57 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11197,6 +11197,9 @@  The package object of the operating system kernel to use@footnote{Currently
 only the Linux-libre kernel is supported.  In the future, it will be
 possible to use the GNU@tie{}Hurd.}.
 
+@item @code{kernel-loadable-modules} (default: '())
+A list of objects (usually packages) to collect loadable kernel modules from.
+
 @item @code{kernel-arguments} (default: @code{'("quiet")})
 List of strings or gexps representing additional arguments to pass on
 the command-line of the kernel---e.g., @code{("console=ttyS0")}.
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index a149eff329..004804df36 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -22,12 +22,14 @@ 
   #:use-module (guix elf)
   #:use-module (guix glob)
   #:use-module (guix build syscalls)
-  #:use-module ((guix build utils) #:select (find-files))
+  #:use-module ((guix build utils) #:select (find-files invoke false-if-file-not-found))
+  #:use-module (guix build union)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -56,7 +58,9 @@ 
 
             write-module-name-database
             write-module-alias-database
-            write-module-device-database))
+            write-module-device-database
+
+            ensure-linux-module-directory!))
 
 ;;; Commentary:
 ;;;
@@ -631,4 +635,42 @@  be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x path))
+               inputs)))
+
+(define (depmod! kmod inputs destination-directory output version)
+       (let ((System.maps (input-files inputs "/System.map"))
+             (Module.symverss (input-files inputs "/Module.symvers")))
+         (invoke (string-append kmod "/bin/depmod")
+                 "-e" ; Report symbols that aren't supplied
+                 "-w" ; Warn on duplicates
+                 "-b" output
+                 "-F" (match System.maps
+                       ((System.map) System.map))
+                 "-E" (match Module.symverss
+                       ((Module.symvers) Module.symvers))
+                 version)))
+
+(define (ensure-linux-module-directory! inputs output version kmod)
+  "Ensures that the directory OUTPUT...VERSION can be used by the Linux
+kernel to load modules via KMOD.  The modules to put into
+OUTPUT...VERSION are taken from INPUTS."
+  (let ((destination-directory (string-append output "/lib/modules/"
+                                              version)))
+    (when (not (file-exists? destination-directory)) ; unique
+      (union-build destination-directory
+       ;; All directories with the same version as us.
+       (filter-map (lambda (directory-name)
+                     (if (member version (scandir directory-name))
+                         (string-append directory-name "/" version)
+                         #f))
+                   (input-files inputs "/lib/modules"))
+       #:create-all-directories? #t)
+      (depmod! kmod inputs destination-directory output version))))
+
 ;;; linux-modules.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 857345cfad..b25c3ceea5 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -631,6 +631,7 @@  GNU_SYSTEM_MODULES =				\
   %D%/tests/nfs.scm				\
   %D%/tests/install.scm				\
   %D%/tests/ldap.scm				\
+  %D%/tests/linux-modules.scm			\
   %D%/tests/mail.scm				\
   %D%/tests/messaging.scm			\
   %D%/tests/networking.scm			\
diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa248a2..17b6e667d5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -5,6 +5,7 @@ 
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -164,6 +165,8 @@ 
 
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
+  (kernel-loadable-modules operating-system-kernel-loadable-modules
+                    (default '()))                ; list of packages
   (kernel-arguments operating-system-user-kernel-arguments
                     (default '("quiet")))         ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
@@ -468,9 +471,20 @@  OS."
   "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)))
-    (mlet %store-monad ((kernel -> (operating-system-kernel os))
-                        (initrd -> (operating-system-initrd-file os))
-                        (params    (operating-system-boot-parameters-file os)))
+    (mlet* %store-monad ((kernel -> (operating-system-kernel os))
+                         (modules ->
+                          (operating-system-kernel-loadable-modules os))
+                         (kernel
+                          ;; TODO: system, target.
+                          (profile-derivation
+                           (packages->manifest
+                            (cons kernel modules))
+                           #:hooks (list linux-module-database)
+                           #:locales? #f
+                           #:allow-collisions? #f
+                           #:relative-symlinks? #t))
+                         (initrd -> (operating-system-initrd-file os))
+                         (params    (operating-system-boot-parameters-file os)))
       (return `(("kernel" ,kernel)
                 ("parameters" ,params)
                 ("initrd" ,initrd)
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
new file mode 100644
index 0000000000..f0e92f5c8f
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,102 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests linux-modules)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:export (%test-loadable-kernel-modules-0
+            %test-loadable-kernel-modules-1
+            %test-loadable-kernel-modules-2))
+
+;;; Commentary:
+;;;
+;;; Test in-place system reconfiguration: advancing the system generation on a
+;;; running instance of the Guix System.
+;;;
+;;; Code:
+
+(define* (module-loader-program os modules)
+  "Return an executable store item that, upon being evaluated, will dry-run
+load MODULES."
+  (program-file
+   "load-kernel-modules.scm"
+   (with-imported-modules (source-module-closure '((guix build utils)))
+     #~(begin
+         (use-modules (guix build utils))
+         (for-each (lambda (module)
+                     (invoke (string-append #$kmod "/bin/modprobe") "-n" "--" module))
+                   '#$modules)))))
+
+(define* (run-loadable-kernel-modules-test module-packages module-names)
+  "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES."
+  (define os
+    (marionette-operating-system
+     (operating-system
+      (inherit (simple-operating-system))
+      (kernel-loadable-modules module-packages))
+     #:imported-modules '((guix combinators))))
+  (define vm (virtual-machine os))
+  (define (test script)
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+          (define marionette
+            (make-marionette (list #$vm)))
+          (mkdir #$output)
+          (chdir #$output)
+          (test-begin "loadable-kernel-modules")
+          (test-assert "script successfully evaluated"
+            (marionette-eval
+             '(primitive-load #$script)
+             marionette))
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+  (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names))))
+
+(define %test-loadable-kernel-modules-0
+  (system-test
+   (name "loadable-kernel-modules-0")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with no extra modules.")
+   (value (run-loadable-kernel-modules-test '() '()))))
+
+(define %test-loadable-kernel-modules-1
+  (system-test
+   (name "loadable-kernel-modules-1")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with one extra module.")
+   (value (run-loadable-kernel-modules-test
+           (list ddcci-driver-linux)
+           '("ddcci")))))
+
+(define %test-loadable-kernel-modules-2
+  (system-test
+   (name "loadable-kernel-modules-2")
+   (description "Tests loadable kernel modules facility of <operating-system>
+with two extra modules.")
+   (value (run-loadable-kernel-modules-test
+           (list acpi-call-linux-module ddcci-driver-linux)
+           '("acpi_call" "ddcci")))))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0d38b2513f..5274a7f5c2 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -10,6 +10,7 @@ 
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -139,7 +140,9 @@ 
             %current-profile
             ensure-profile-directory
             canonicalize-profile
-            user-friendly-profile))
+            user-friendly-profile
+
+            linux-module-database))
 
 ;;; Commentary:
 ;;;
@@ -1137,6 +1140,50 @@  for both major versions of GTK+."
                               (hook . gtk-im-modules)))
           (return #f)))))
 
+;; XXX: Dupe in gnu/build/linux-modules.scm .
+(define (input-files inputs path)
+  "Given a list of directories INPUTS, return all entries with PATH in it."
+  ;; TODO: Use filter-map.
+  #~(begin
+      (use-modules (srfi srfi-1))
+      (filter file-exists?
+        (map (lambda (x)
+               (string-append x #$path))
+             '#$inputs))))
+
+(define (linux-module-database manifest)
+  "Return a derivation that unions all the kernel modules in the manifest
+and creates the dependency graph for all these kernel modules."
+  (mlet %store-monad ((kmod (manifest-lookup-package manifest "kmod")))
+    (define build
+      (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules)))
+        #~(begin
+            (use-modules (ice-9 ftw))
+            (use-modules (srfi srfi-1)) ; append-map
+            (use-modules (guix build utils)) ; mkdir-p
+            (use-modules (gnu build linux-modules))
+            (let* ((inputs '#$(manifest-inputs manifest))
+                   (module-directories #$(input-files (manifest-inputs manifest) "/lib/modules"))
+                   (directory-entries
+                    (lambda (directory-name)
+                      (scandir directory-name (lambda (basename)
+                                                (not (string-prefix? "." basename))))))
+                   ;; Note: Should usually result in one entry.
+                   (versions (append-map directory-entries module-directories)))
+                ;; TODO: if len(module-directories) == 1: return module-directories[0]
+                (mkdir-p (string-append #$output "/lib/modules"))
+                ;; Iterate over each kernel version directory (usually one).
+                (for-each (lambda (version)
+                            (ensure-linux-module-directory! inputs #$output version #$kmod))
+                          versions)
+                (exit #t)))))
+    (gexp->derivation "linux-module-database" build
+                      #:local-build? #t
+                      #:substitutable? #f
+                      #:properties
+                      `((type . profile-hook)
+                        (hook . linux-module-database)))))
+
 (define (xdg-desktop-database manifest)
   "Return a derivation that builds the @file{mimeinfo.cache} database from
 desktop files.  It's used to query what applications can handle a given