@@ -3,6 +3,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,6 +27,7 @@ (define-module (gnu build linux-modules)
#:use-module ((guix build utils) #:select (find-files invoke))
#:use-module (guix build union)
#:autoload (zlib) (call-with-gzip-input-port)
+ #:autoload (zstd) (call-with-zstd-input-port)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
@@ -108,24 +110,29 @@ (define (key=value->pair str)
(cons (string->symbol (string-take str =))
(string-drop str (+ 1 =)))))
-;; Matches kernel modules, without compression, with GZIP compression or with
-;; XZ compression.
-(define module-regex "\\.ko(\\.gz|\\.xz)?$")
+;; Matches kernel modules, without compression, with GZIP, XZ or ZSTD
+;; compression.
+(define module-regex "\\.ko(\\.gz|\\.xz|\\.zst)?$")
(define (modinfo-section-contents file)
"Return the contents of the '.modinfo' section of FILE as a list of
key/value pairs.."
+ (define (decompress-file decompressor file)
+ (let ((port (open-file file "r0")))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (decompressor port get-bytevector-all))
+ (lambda ()
+ (close-port port)))))
+
(define (get-bytevector file)
(cond
((string-suffix? ".ko.gz" file)
- (let ((port (open-file file "r0")))
- (dynamic-wind
- (lambda ()
- #t)
- (lambda ()
- (call-with-gzip-input-port port get-bytevector-all))
- (lambda ()
- (close-port port)))))
+ (decompress-file call-with-gzip-input-port file))
+ ((string-suffix? ".ko.zst" file)
+ (decompress-file call-with-zstd-input-port file))
(else
(call-with-input-file file get-bytevector-all))))
@@ -213,11 +220,12 @@ (define* (dot-ko name #:optional compression)
(let ((suffix (match compression
('xz ".ko.xz")
('gzip ".ko.gz")
+ ('zstd ".ko.zst")
(else ".ko"))))
(string-append name suffix)))
(define (ensure-dot-ko name compression)
- "Return NAME with a '.ko[.gz|.xz]' suffix appended, unless it already has
+ "Return NAME with a '.ko[.gz|.xz|.zst]' suffix appended, unless it already has
it."
(if (string-contains name ".ko")
name
@@ -235,7 +243,7 @@ (define (normalize-module-name module)
(define (file-name->module-name file)
"Return the module name corresponding to FILE, stripping the trailing
-'.ko[.gz|.xz]' and normalizing it."
+'.ko[.gz|.xz|.zst]' and normalizing it."
(normalize-module-name (strip-extension (basename file))))
(define (find-module-file directory module)
@@ -333,11 +341,11 @@ (define* (load-linux-module* file
(recursive? #t)
(lookup-module dot-ko)
(black-list (module-black-list)))
- "Load Linux module from FILE, the name of a '.ko[.gz|.xz]' file; return true
-on success, false otherwise. When RECURSIVE? is true, load its dependencies
-first (à la 'modprobe'.) The actual files containing modules depended on are
-obtained by calling LOOKUP-MODULE with the module name. Modules whose name
-appears in BLACK-LIST are not loaded."
+ "Load Linux module from FILE, the name of a '.ko[.gz|.xz|.zst]' file; return
+true on success, false otherwise. When RECURSIVE? is true, load its
+dependencies first (à la 'modprobe'.) The actual files containing modules
+depended on are obtained by calling LOOKUP-MODULE with the module name.
+Modules whose name appears in BLACK-LIST are not loaded."
(define (black-listed? module)
(let ((result (member module black-list)))
(when result
@@ -695,7 +703,7 @@ (define* (module-name->file-name/guess directory name
"Guess the file name corresponding to NAME, a module name. That doesn't
always work because sometimes underscores in NAME map to hyphens (e.g.,
\"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\"). If the module is
-compressed then COMPRESSED can be set to 'xz or 'gzip, depending on the
+compressed then COMPRESSED can be set to 'zstd, 'xz or 'gzip, depending on the
compression type."
(string-append directory "/" (ensure-dot-ko name compression)))
@@ -706,6 +714,8 @@ (define (module-name-lookup directory)
(define (guess-file-name name)
(let ((names (list
(module-name->file-name/guess directory name)
+ (module-name->file-name/guess directory name
+ #:compression 'zstd)
(module-name->file-name/guess directory name
#:compression 'xz)
(module-name->file-name/guess directory name
@@ -729,8 +739,8 @@ (define (module-name-lookup directory)
(define (write-module-name-database directory)
"Write a database that maps \"module names\" as they appear in the relevant
-ELF section of '.ko[.gz|.xz]' files, to actual file names. This format is
-Guix-specific. It aims to deal with inconsistent naming, in particular
+ELF section of '.ko[.gz|.xz|.zst]' files, to actual file names. This format
+is Guix-specific. It aims to deal with inconsistent naming, in particular
hyphens vs. underscores."
(define mapping
(map (lambda (file)
@@ -749,8 +759,8 @@ (define (write-module-name-database directory)
(pretty-print mapping port))))
(define (write-module-alias-database directory)
- "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
-'modules.alias' file."
+ "Traverse the '.ko[.gz|.xz|.zst]' files in DIRECTORY and create the
+corresponding 'modules.alias' file."
(define aliases
(map (lambda (file)
(cons (file-name->module-name file) (module-aliases file)))
@@ -796,9 +806,9 @@ (define %not-dash
(char-set-complement (char-set #\-)))
(define (write-module-device-database directory)
- "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
-'modules.devname' file. This file contains information about modules that can
-be loaded on-demand, such as file system modules."
+ "Traverse the '.ko[.gz|.xz|.zst]' files in DIRECTORY and create the
+corresponding 'modules.devname' file. This file contains information about
+modules that can be loaded on-demand, such as file system modules."
(define aliases
(filter-map (lambda (file)
(match (aliases->device-tuple (module-aliases file))
@@ -386,6 +386,7 @@ (define (installer-program)
guile-json-3 guile-git guile-webutils
guile-gnutls
guile-zlib ;for (gnu build linux-modules)
+ guile-zstd ;for (gnu build linux-modules)
(current-guix))
(with-imported-modules `(,@(source-module-closure
`(,@modules
@@ -847,6 +847,10 @@ (define (default-extra-linux-options version)
,@(if (version>=? version "5.13")
'(("BPF_UNPRIV_DEFAULT_OFF" . #t))
'())
+ ;; Compress kernel modules via Zstd.
+ ,(if (version>=? version "5.13")
+ '("CONFIG_MODULE_COMPRESS_ZSTD" . #t)
+ '("CONFIG_MODULE_COMPRESS_GZIP" . #t))
;; Some very mild hardening.
("CONFIG_SECURITY_DMESG_RESTRICT" . #t)
;; All kernels should have NAMESPACES options enabled
@@ -1036,7 +1040,10 @@ (define* (make-linux-libre* version gnu-revision source supported-systems
"EXTRAVERSION ?="))
(setenv "EXTRAVERSION"
#$(and extra-version
- (string-append "-" extra-version)))))
+ (string-append "-" extra-version)))
+ ;; Use the maximum compression available for Zstd-compressed
+ ;; modules.
+ (setenv "ZSTD_CLEVEL" "19")))
(replace 'configure
(lambda _
(let ((config
@@ -1130,7 +1137,9 @@ (define* (make-linux-libre* version gnu-revision source supported-systems
;; support.
dwarves ;for pahole
python-wrapper
- zlib))
+ zlib
+ ;; For Zstd compression of kernel modules.
+ zstd))
(home-page "https://www.gnu.org/software/linux-libre/")
(synopsis "100% free redistribution of a cleaned Linux kernel")
(description "GNU Linux-Libre is a free (as in freedom) variant of the
@@ -128,7 +128,7 @@ (define (flat-linux-module-directory linux modules)
(define build-exp
(with-imported-modules imported-modules
- (with-extensions (list guile-zlib)
+ (with-extensions (list guile-zlib guile-zstd)
#~(begin
(use-modules (gnu build linux-modules)
(guix build utils)
@@ -168,7 +168,9 @@ (define (flat-linux-module-directory linux modules)
;; is already gzipped as a whole.
(cond
((string-contains file ".ko.gz")
- (invoke #+(file-append gzip "/bin/gunzip") file))))
+ (invoke #+(file-append gzip "/bin/gunzip") file))
+ ((string-contains file ".ko.zst")
+ (invoke #+(file-append zstd "/bin/zstd") "-d" file))))
(mkdir #$output)
(for-each (lambda (module)
@@ -7,7 +7,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
-;;; Copyright © 2017, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2021, 2024 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>
@@ -1487,11 +1487,14 @@ (define* (linux-module-database manifest #:optional system)
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+ (define guile-zstd
+ (module-ref (resolve-interface '(gnu packages guile)) 'guile-zstd))
+
(define build
(with-imported-modules (source-module-closure
'((guix build utils)
(gnu build linux-modules)))
- (with-extensions (list guile-zlib)
+ (with-extensions (list guile-zlib guile-zstd)
#~(begin
(use-modules (ice-9 ftw)
(ice-9 match)