system: Add kernel-loadable-modules to operating-system.
* gnu/system.scm (<operating-system>): Add kernel-loadable-modules. (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. [native-inputs]: Remove kmod.
This commit is contained in:
Danny Milosavljevic
parent
66a198c807
commit
5c79f23863
|
|
@ -11221,6 +11221,10 @@ 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--e.g. @code{(list ddcci-driver-linux)}.
|
||||
|
||||
@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")}.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")))))
|
||||
|
|
@ -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,51 @@ for both major versions of GTK+."
|
|||
(hook . gtk-im-modules)))
|
||||
(return #f)))))
|
||||
|
||||
(define (linux-module-database manifest)
|
||||
"Return a derivation that unites all the kernel modules of the manifest
|
||||
and creates the dependency graph of all these kernel modules.
|
||||
|
||||
This is meant to be used as a profile hook."
|
||||
(define kmod ; lazy reference
|
||||
(module-ref (resolve-interface '(gnu packages linux)) 'kmod))
|
||||
(define build
|
||||
(with-imported-modules
|
||||
(source-module-closure '((guix build utils)
|
||||
(gnu build linux-modules)))
|
||||
#~(begin
|
||||
(use-modules (ice-9 ftw)
|
||||
(ice-9 match)
|
||||
(srfi srfi-1) ; append-map
|
||||
(gnu build linux-modules))
|
||||
(let* ((inputs '#$(manifest-inputs manifest))
|
||||
(module-directories
|
||||
(map (lambda (directory)
|
||||
(string-append directory "/lib/modules"))
|
||||
inputs))
|
||||
(directory-entries
|
||||
(lambda (directory)
|
||||
(scandir directory (lambda (basename)
|
||||
(not
|
||||
(string-prefix? "." basename))))))
|
||||
;; Note: Should usually result in one entry.
|
||||
(versions (delete-duplicates
|
||||
(append-map directory-entries
|
||||
module-directories))))
|
||||
(match versions
|
||||
((version)
|
||||
(let ((old-path (getenv "PATH")))
|
||||
(setenv "PATH" #+(file-append kmod "/bin"))
|
||||
(make-linux-module-directory inputs version #$output)
|
||||
(setenv "PATH" old-path)))
|
||||
(_ (error "Specified Linux kernel and Linux kernel modules
|
||||
are not all of the same version")))))))
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in New Issue