From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:38340) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j6Xtg-0003hI-Q6 for guix-patches@gnu.org; Tue, 25 Feb 2020 05:57:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j6Xte-0003jK-F0 for guix-patches@gnu.org; Tue, 25 Feb 2020 05:57:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:48498) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j6Xte-0003iE-AP for guix-patches@gnu.org; Tue, 25 Feb 2020 05:57:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j6Xte-0003ro-8j for guix-patches@gnu.org; Tue, 25 Feb 2020 05:57:02 -0500 Subject: [bug#37868] [PATCH v4] system: Add kernel-module-packages to operating-system. Resent-Message-ID: From: Danny Milosavljevic Date: Tue, 25 Feb 2020 11:55:49 +0100 Message-Id: <20200225105549.30115-1-dannym@scratchpost.org> In-Reply-To: <20200218094207.6196-1-dannym@scratchpost.org> References: <20200218094207.6196-1-dannym@scratchpost.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 37868@debbugs.gnu.org, ludo@gnu.org, Mark H Weaver Cc: Danny Milosavljevic * gnu/system.scm (): 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 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 ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Meiyo Peng +;;; Copyright © 2020 Danny Milosavljevic ;;; ;;; 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) ; @@ -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 +;;; +;;; 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 . + +(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 +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 +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 +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 ;;; Copyright © 2019 Kyle Meyer ;;; Copyright © 2019 Mathieu Othacehe +;;; Copyright © 2020 Danny Milosavljevic ;;; ;;; 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