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

Message ID 20200226195929.3615-1-dannym@scratchpost.org
State Accepted
Headers show
Series
  • [bug#37868,v5] 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. 26, 2020, 7:59 p.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.
* gnu/packages/linux.scm (make-linux-libre*)[arguments]<#:phases>[install]:
Disable depmod.  Remove "build" and "source" symlinks.
---
 doc/guix.texi               |   3 ++
 gnu/build/linux-modules.scm |  54 ++++++++++++++++++-
 gnu/local.mk                |   1 +
 gnu/packages/linux.scm      |  19 ++++++-
 gnu/system.scm              |  20 +++++--
 gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++
 guix/profiles.scm           |  49 ++++++++++++++++-
 7 files changed, 241 insertions(+), 8 deletions(-)
 create mode 100644 gnu/tests/linux-modules.scm

Comments

Danny Milosavljevic Feb. 27, 2020, 11:15 a.m. UTC | #1
> +                ;; Iterate over each kernel version directory (usually one).

It might make sense not to iterate but rather to insist that there be only one
kernel version directory in that profile derivation.

The reason is that it would catch misconfiguration (modules for the wrong
kernel would not be able to be configured into guix system, instead of failing
at runtime because it's in the wrong directory)

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..69a4b75a08 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,50 @@  be loaded on-demand, such as file system modules."
                            module devname type major minor)))
                 aliases))))
 
+(define (input-files inputs file)
+  "Given a list of directories INPUTS, return all entries with FILE in it."
+  ;; TODO: Use filter-map.
+  (filter file-exists?
+          (map (lambda (x)
+                 (string-append x file))
+               inputs)))
+
+(define (depmod! kmod inputs destination-directory output version)
+       (let ((maps-files (input-files inputs "/System.map"))
+             (symvers-files (input-files inputs "/Module.symvers")))
+         (for-each (lambda (basename)
+                     (when (and (string-prefix? "modules." basename)
+                                (not (string=? "modules.builtin" basename))
+                                (not (string=? "modules.order" basename)))
+                       (false-if-file-not-found
+                        (delete-file
+                         (string-append destination-directory "/" basename)))))
+                   (scandir destination-directory))
+         (invoke (string-append kmod "/bin/depmod")
+                 "-e" ; Report symbols that aren't supplied
+                 "-w" ; Warn on duplicates
+                 "-b" output
+                 "-F" (match maps-files
+                       ((System.map) System.map))
+                 "-E" (match symvers-files
+                       ((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/packages/linux.scm b/gnu/packages/linux.scm
index 78182555c1..32b802bab4 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -675,6 +675,7 @@  for ARCH and optionally VARIANT, or #f if there is no such configuration."
                   (guix build utils)
                   (srfi srfi-1)
                   (srfi srfi-26)
+                  (ice-9 ftw)
                   (ice-9 match))
        #:phases
        (modify-phases %standard-phases
@@ -760,12 +761,26 @@  for ARCH and optionally VARIANT, or #f if there is no such configuration."
                ;; Install kernel modules
                (mkdir-p moddir)
                (invoke "make"
-                       (string-append "DEPMOD=" kmod "/bin/depmod")
+                       ;; Disable depmod because the Guix system's module directory
+                       ;; is an union of potentially multiple packages.  It is not
+                       ;; possible to use depmod to usefully calculate a dependency
+                       ;; graph while building only one of those packages.
+                       "DEPMOD=true"
                        (string-append "MODULE_DIR=" moddir)
                        (string-append "INSTALL_PATH=" out)
                        (string-append "INSTALL_MOD_PATH=" out)
                        "INSTALL_MOD_STRIP=1"
-                       "modules_install")))))
+                       "modules_install")
+               (let* ((versions (filter (lambda (name)
+                                          (not (string-prefix? "." name)))
+                                        (scandir moddir)))
+                      (version (match versions
+                                ((x) x))))
+                 (false-if-file-not-found
+                  (delete-file (string-append moddir "/" version "/build")))
+                 (false-if-file-not-found
+                  (delete-file (string-append moddir "/" version "/source"))))
+               #t))))
        #:tests? #f))
     (home-page "https://www.gnu.org/software/linux-libre/")
     (synopsis "100% free redistribution of a cleaned Linux kernel")
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..4a79ed5550
--- /dev/null
+++ b/gnu/tests/linux-modules.scm
@@ -0,0 +1,103 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.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