Message ID | 20200227122519.3226-1-dannym@scratchpost.org |
---|---|
State | Accepted |
Headers | show |
Series | [bug#37868,v6] system: Add kernel-module-packages to operating-system. | expand |
Context | Check | Description |
---|---|---|
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
Hi! Danny Milosavljevic <dannym@scratchpost.org> skribis: > * 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. > (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. [...] > +@item @code{kernel-loadable-modules} (default: '()) > +A list of objects (usually packages) to collect loadable kernel modules from. Perhaps you can add an example. > +(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))) “Input” in Guix is usually used to describe association lists. To avoid confusion, I propose: (define (existing-files directories base) "Return the absolute file name of every file named BASE under the DIRECTORIES." (filter-map (lambda (directory) (let ((file (string-append directory "/" base))) (and (file-exists? file) file))) inputs) > +(define (depmod! kmod inputs version destination-directory output) There’s shouldn’t be a bang, by convention. Also please add a docstring. > + (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") Generally, for this kind of utility function, we assume that the tool is in $PATH, which allows us to avoid carrying its file name throughout the API. I’d suggest doing the same here. > +(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." Perhaps be more specific as to the fact that it’s creating ‘System.maps’ etc. databases? > (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)) I think the system and target will be correct, but perhaps you can double-check why doing ‘guix system build -s … -d’ and checking the relevant .drv. :-) I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks? are needed, so I’d recommend removing them. > +++ b/gnu/tests/linux-modules.scm Nice! > +;; 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)))) Same comment as above. :-) > +(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." Perhaps explicitly write “This is meant to be used as a profile hook.” or similar. > + (define build > + (with-imported-modules (source-module-closure '((guix build utils) (gnu build linux-modules))) 80 chars please. :-) > + #~(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)) Please make it only one ‘use-modules’ form. > + (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)))))) 80 chars please, and also one-word identifiers are preferred for local variables. > + ;; 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))))) No need for ‘exit’, but perhaps and ‘error’ call in the unmatched case? Thanks, and apologies for the delay! Ludo’.
Hi Ludo, On Sun, 15 Mar 2020 22:00:04 +0100 Ludovic Courtès <ludo@gnu.org> wrote: > I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks? > are needed, so I’d recommend removing them. Removing allow-collisions. Otherwise the defaults are different. I'm pretty sure that we don't need locales for Linux kernel modules, for example :) That said, I can do it--but it would increase build dependencies. > > + (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)))))) > > also one-word identifiers are preferred for local > variables. I'd like to do that but it would lose information here. "modules" would be too vague. "directories" would be non-unique. (What "module-directories" means is "'/lib/modules'-directories", literally) "entries" would be too vague too. Entries of what? (Especially since that's a procedure). I'll make it say "directory" instead of "directory-name" there. Note: The "existing-files" procedure exists only in order to allow us to build Linux kernels without any modules (neither in linux-libre nor anywhere else) and have the profile hook succeed. Maybe it's written in an overly general way for that? What do you think? (It's actually kinda bad that I ignore kernel-loadable-modules which have no "/lib/modules" in it (better would be an error)--but I wasn't sure whether manifest-inputs is guaranteed to keep the original order of the entries--which would be: linux-libre first)
Hi Danny, Danny Milosavljevic <dannym@scratchpost.org> skribis: > On Sun, 15 Mar 2020 22:00:04 +0100 > Ludovic Courtès <ludo@gnu.org> wrote: > >> I don’t think #:allow-collisions?, #:locales? and #:relative-symlinks? >> are needed, so I’d recommend removing them. > > Removing allow-collisions. > > Otherwise the defaults are different. > > I'm pretty sure that we don't need locales for Linux kernel modules, > for example :) #:locales? tells whether to install locales in the Guile process that builds the profile so that it can handle non-ASCII file names, for example. > That said, I can do it--but it would increase build dependencies. IMO it matters less than maintainability and conciseness in this case. :-) >> > + (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)))))) >> >> also one-word identifiers are preferred for local >> variables. > > I'd like to do that but it would lose information here. > > "modules" would be too vague. "directories" would be non-unique. > (What "module-directories" means is "'/lib/modules'-directories", literally) > > "entries" would be too vague too. Entries of what? > (Especially since that's a procedure). > > I'll make it say "directory" instead of "directory-name" there. Your call. My point is: if we keep with the general guideline of keeping functions small, then one-word identifiers are usually good enough because in the context of the function it should be clear and non-ambiguous. > Note: > > The "existing-files" procedure exists only in order to allow us to > build Linux kernels without any modules (neither in linux-libre nor anywhere > else) and have the profile hook succeed. > > Maybe it's written in an overly general way for that? What do you think? Yeah, maybe. It certainly looks weird to me to have a top-level procedure for something that’s in fact quite specific to the problem at hand (I realized when attempting to write a docstring that it’s a weird interface, and that’s because it’s in fact very specific to what we’re doing here.) > (It's actually kinda bad that I ignore kernel-loadable-modules > which have no "/lib/modules" in it (better would be an error)--but I wasn't > sure whether manifest-inputs is guaranteed to keep the original order of > the entries--which would be: linux-libre first) Dunno, I guess it would be fine to error out when ‘kernel-loadable-modules’ is passed a package that doesn’t have any modules. Thanks, Ludo’.
Hi Mark, should it be possible to have a kernel without module support in Guix? Is there a system test already that tests that case? I ask because I don't know what depmod would do when passed such a kernel. (I'm trying pretty hard here to not break that case--but actually I don't even know whether it works in the first place) Is it easily possible to build such a kernel?
Hi Ludo, On Sun, 15 Mar 2020 22:00:04 +0100 Ludovic Courtès <ludo@gnu.org> wrote: > > + (invoke (string-append kmod "/bin/depmod") > > Generally, for this kind of utility function, we assume that the tool is > in $PATH, which allows us to avoid carrying its file name throughout the > API. I’d suggest doing the same here. Hmm, does that mean I should also change PATH in the profile hook?
Hi Danny, Danny Milosavljevic <dannym@scratchpost.org> skribis: > On Sun, 15 Mar 2020 22:00:04 +0100 > Ludovic Courtès <ludo@gnu.org> wrote: > >> > + (invoke (string-append kmod "/bin/depmod") >> >> Generally, for this kind of utility function, we assume that the tool is >> in $PATH, which allows us to avoid carrying its file name throughout the >> API. I’d suggest doing the same here. > > Hmm, does that mean I should also change PATH in the profile hook? Yes, I think that’s the only change you have to do: (setenv "PATH" #+(file-append kmod "/bin")) in the profile hook. HTH, Ludo’.
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 <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..6d4aee3586 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,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