From: Danny Milosavljevic <dannym@scratchpost.org>
To: 37868@debbugs.gnu.org, ludo@gnu.org, Mark H Weaver <mhw@netris.org>
Cc: Danny Milosavljevic <dannym@scratchpost.org>
Subject: [bug#37868] [PATCH v5] system: Add kernel-module-packages to operating-system.
Date: Wed, 26 Feb 2020 20:59:29 +0100 [thread overview]
Message-ID: <20200226195929.3615-1-dannym@scratchpost.org> (raw)
In-Reply-To: <20200225105549.30115-1-dannym@scratchpost.org>
* 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
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
next prev parent reply other threads:[~2020-02-26 20:00 UTC|newest]
Thread overview: 54+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-10-22 15:22 [bug#37868] [PATCH] guix: Allow multiple packages to provide Linux modules in the system profile Danny Milosavljevic
2019-11-12 16:20 ` Danny Milosavljevic
2019-11-12 17:47 ` Giovanni Biscuolo
2019-11-12 18:11 ` Giovanni Biscuolo
2019-11-13 13:30 ` Ludovic Courtès
2019-11-14 16:21 ` Danny Milosavljevic
2020-02-17 17:10 ` Danny Milosavljevic
2020-02-18 8:31 ` Ludovic Courtès
2019-11-14 17:48 ` Mark H Weaver
2020-02-18 9:42 ` [bug#37868] [PATCH v2 0/2] system: Add kernel-module-packages to operating-system and use it Danny Milosavljevic
2020-02-18 9:42 ` [bug#37868] [PATCH v2 1/2] build-system/linux-module: Disable depmod Danny Milosavljevic
2020-02-23 16:22 ` Ludovic Courtès
2020-02-25 10:11 ` Danny Milosavljevic
2020-02-18 9:42 ` [bug#37868] [PATCH v2 2/2] system: Add kernel-module-packages to operating-system Danny Milosavljevic
2020-02-18 12:31 ` Mathieu Othacehe
2020-02-23 16:36 ` Ludovic Courtès
2020-02-24 16:18 ` Danny Milosavljevic
2020-02-25 10:21 ` [bug#37868] [PATCH v3] " Danny Milosavljevic
2020-02-25 10:55 ` [bug#37868] [PATCH v4] " Danny Milosavljevic
2020-02-25 11:32 ` Danny Milosavljevic
2020-02-25 13:34 ` Danny Milosavljevic
2020-02-26 19:59 ` Danny Milosavljevic [this message]
2020-02-27 11:15 ` [bug#37868] [PATCH v5] " Danny Milosavljevic
2020-02-27 12:25 ` [bug#37868] [PATCH v6] " Danny Milosavljevic
2020-02-27 13:51 ` [bug#37868] [PATCH v7] " Danny Milosavljevic
2020-02-27 15:50 ` [bug#37868] [PATCH v8] " Danny Milosavljevic
2020-03-14 18:40 ` Danny Milosavljevic
2020-03-15 10:28 ` Mathieu Othacehe
2020-03-15 10:33 ` Mathieu Othacehe
2020-03-15 18:17 ` Danny Milosavljevic
2020-03-16 9:55 ` Mathieu Othacehe
2020-03-16 20:10 ` Danny Milosavljevic
2020-03-17 9:29 ` Ludovic Courtès
2020-03-18 14:50 ` Mathieu Othacehe
2020-03-18 16:06 ` Danny Milosavljevic
2020-03-18 17:00 ` Danny Milosavljevic
2020-03-18 17:35 ` Ludovic Courtès
2020-03-20 10:19 ` Danny Milosavljevic
2020-03-20 10:32 ` Mathieu Othacehe
2020-03-20 15:13 ` Mathieu Othacehe
2020-03-20 17:52 ` Mathieu Othacehe
2020-03-21 10:06 ` Danny Milosavljevic
2020-03-22 13:36 ` Danny Milosavljevic
2020-03-22 21:11 ` Ludovic Courtès
2020-03-15 21:02 ` Ludovic Courtès
2020-03-15 21:00 ` [bug#37868] [PATCH v6] " Ludovic Courtès
2020-03-15 22:09 ` Danny Milosavljevic
2020-03-16 8:55 ` Ludovic Courtès
2020-03-16 20:04 ` Danny Milosavljevic
2020-03-16 20:31 ` Danny Milosavljevic
2020-03-17 9:20 ` Ludovic Courtès
2020-03-16 20:17 ` [bug#37868] [PATCH v9] system: Add kernel-loadable-modules " Danny Milosavljevic
2020-03-19 14:22 ` [bug#37868] [PATCH v10] " Danny Milosavljevic
2020-03-22 12:01 ` bug#37868: " Danny Milosavljevic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200226195929.3615-1-dannym@scratchpost.org \
--to=dannym@scratchpost.org \
--cc=37868@debbugs.gnu.org \
--cc=ludo@gnu.org \
--cc=mhw@netris.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.