diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/linux-modules.scm | 46 | ||||
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/packages/linux.scm | 26 | ||||
| -rw-r--r-- | gnu/system.scm | 16 | ||||
| -rw-r--r-- | gnu/tests/linux-modules.scm | 103 |
5 files changed, 182 insertions, 10 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index a149eff329..aa1c7cfeae 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)) + #: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,42 @@ be loaded on-demand, such as file system modules." module devname type major minor))) aliases)))) +(define (depmod version directory) + "Given an (existing) DIRECTORY, invoke depmod on it for +kernel version VERSION." + (let ((destination-directory (string-append directory "/lib/modules/" + version)) + ;; Note: "System.map" is an input file. + (maps-file (string-append directory "/System.map")) + ;; Note: "Module.symvers" is an input file. + (symvers-file (string-append directory "/Module.symvers"))) + ;; These files will be regenerated by depmod below. + (for-each (lambda (basename) + (when (and (string-prefix? "modules." basename) + ;; Note: "modules.builtin" is an input file. + (not (string=? "modules.builtin" basename)) + ;; Note: "modules.order" is an input file. + (not (string=? "modules.order" basename))) + (delete-file (string-append destination-directory "/" + basename)))) + (scandir destination-directory)) + (invoke "depmod" + "-e" ; Report symbols that aren't supplied + ;"-w" ; Warn on duplicates + "-b" directory + "-F" maps-file + ;"-E" symvers-file ; using both "-E" and "-F" is not possible. + version))) + +(define (make-linux-module-directory inputs version output) + "Create a new directory OUTPUT and ensure that the directory +OUTPUT/lib/modules/VERSION can be used as a source of Linux +kernel modules for the first kmod in PATH now to eventually +load. Take modules to put into OUTPUT from INPUTS. + +Right now that means it creates @code{modules.*.bin} which +@command{modprobe} will use to find loadable modules." + (union-build output inputs #:create-all-directories? #t) + (depmod version output)) + ;;; linux-modules.scm ends here diff --git a/gnu/local.mk b/gnu/local.mk index e391903473..a080745220 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -635,6 +635,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 ffc4776f94..c39c411e3d 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -654,7 +654,6 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration." `(("perl" ,perl) ("bc" ,bc) ("openssl" ,openssl) - ("kmod" ,kmod) ("elfutils" ,elfutils) ; Needed to enable CONFIG_STACK_VALIDATION ("flex" ,flex) ("bison" ,bison) @@ -678,6 +677,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 @@ -750,8 +750,7 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration." (lambda* (#:key inputs native-inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (moddir (string-append out "/lib/modules")) - (dtbdir (string-append out "/lib/dtbs")) - (kmod (assoc-ref (or native-inputs inputs) "kmod"))) + (dtbdir (string-append out "/lib/dtbs"))) ;; Install kernel image, kernel configuration and link map. (for-each (lambda (file) (install-file file out)) (find-files "." "^(\\.config|bzImage|zImage|Image|vmlinuz|System\\.map|Module\\.symvers)$")) @@ -763,12 +762,29 @@ 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)))) + ;; There are symlinks to the build and source directory, + ;; both of which will point to target /tmp/guix-build* + ;; and thus not be useful in a profile. Delete the symlinks. + (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 06c58c27ba..c90d8c6cbc 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. ;;; @@ -168,6 +169,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> @@ -472,9 +475,16 @@ 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 + (profile-derivation + (packages->manifest + (cons kernel modules)) + #:hooks (list linux-module-database))) + (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..39e11587c6 --- /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 <operating-system> kernel-loadable-modules. +;;; +;;; 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"))))) |