From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:35832) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j7IEu-000670-Jm for guix-patches@gnu.org; Thu, 27 Feb 2020 07:26:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j7IEr-0002p9-Ru for guix-patches@gnu.org; Thu, 27 Feb 2020 07:26:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:52832) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1j7IEr-0002oS-NC for guix-patches@gnu.org; Thu, 27 Feb 2020 07:26:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1j7IEr-000455-Jp for guix-patches@gnu.org; Thu, 27 Feb 2020 07:26:01 -0500 Subject: [bug#37868] [PATCH v6] system: Add kernel-module-packages to operating-system. Resent-Message-ID: From: Danny Milosavljevic Date: Thu, 27 Feb 2020 13:25:19 +0100 Message-Id: <20200227122519.3226-1-dannym@scratchpost.org> In-Reply-To: <20200226195929.3615-1-dannym@scratchpost.org> References: <20200226195929.3615-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. (make-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 | 45 +++++++++++++++- gnu/local.mk | 1 + gnu/packages/linux.scm | 19 ++++++- gnu/system.scm | 20 +++++-- gnu/tests/linux-modules.scm | 103 ++++++++++++++++++++++++++++++++++++ guix/profiles.scm | 51 +++++++++++++++++- 7 files changed, 234 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..bbdf14fab7 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 + + make-linux-module-directory)) ;;; Commentary: ;;; @@ -631,4 +635,41 @@ 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 version destination-directory output) + (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))) + (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 (make-linux-module-directory kmod inputs version output) + "Ensures that the directory OUTPUT...VERSION can be used by the Linux +kernel to load modules via KMOD. The modules to put into +OUTPUT are taken from INPUTS." + (let ((destination-directory (string-append output "/lib/modules"))) + (union-build destination-directory (input-files inputs "/lib/modules") + #:create-all-directories? #t) + (depmod! kmod inputs version destination-directory output))) + ;;; 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 ;;; 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..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 +;;; Copyright © 2020 Danny Milosavljevic +;;; +;;; 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..6d4aee3586 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,52 @@ 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 (ice-9 match)) + (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 (delete-duplicates + (append-map directory-entries + module-directories)))) + ;; TODO: if len(module-directories) == 1: return module-directories[0] + (mkdir-p (string-append #$output "/lib")) + (match versions + ((version) + (make-linux-module-directory #$kmod inputs version #$output))) + (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