me
/
guix
Archived
1
0
Fork 0

gnu: linux-libre: Enable Zstd compression of kernel modules.

This brings the on disk size of the kernel from 164 MiB to 144 MiB, or about
12%.

* gnu/packages/linux.scm (default-extra-linux-options)
[version>=5.13]: Enable CONFIG_MODULE_COMPRESS_ZSTD, else
CONFIG_MODULE_COMPRESS_GZIP.
(make-linux-libre*) [phases] {set-environment}: Set ZSTD_CLEVEL environment
variable to 19.
[native-inputs]: Add zstd.
* gnu/build/linux-modules.scm (module-regex): Add .zst to regexp.  Update doc.
(modinfo-section-contents): Extend support to Zstd compressed module.
(dot-ko): Register the 'zstd compression type.
(ensure-dot-ko, file-name->module-name, load-linux-module*)
(module-name->file-name/guess, write-module-name-database)
(write-module-alias-database, write-module-device-database): Update doc.
(module-name-lookup): Also consider zstd-compressed modules.
* gnu/installer.scm (installer-program): Add guile-zstd extension to gexp.
* gnu/system/linux-initrd.scm (flat-linux-module-directory): Likewise.
Decompress zstd-compressed modules for use in initrd.
* guix/profiles.scm (linux-module-database): Add guile-zstd extension to gexp.

Change-Id: Ide899dc5c58ea5033583b1a91a92c025fc8d901a
master
Maxim Cournoyer 2024-05-12 20:51:50 -04:00
parent b72b6063ce
commit afacfa33ec
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
5 changed files with 57 additions and 32 deletions

View File

@ -3,6 +3,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@
#:use-module ((guix build utils) #:select (find-files invoke)) #:use-module ((guix build utils) #:select (find-files invoke))
#:use-module (guix build union) #:use-module (guix build union)
#:autoload (zlib) (call-with-gzip-input-port) #:autoload (zlib) (call-with-gzip-input-port)
#:autoload (zstd) (call-with-zstd-input-port)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -108,24 +110,29 @@ string list."
(cons (string->symbol (string-take str =)) (cons (string->symbol (string-take str =))
(string-drop str (+ 1 =))))) (string-drop str (+ 1 =)))))
;; Matches kernel modules, without compression, with GZIP compression or with ;; Matches kernel modules, without compression, with GZIP, XZ or ZSTD
;; XZ compression. ;; compression.
(define module-regex "\\.ko(\\.gz|\\.xz)?$") (define module-regex "\\.ko(\\.gz|\\.xz|\\.zst)?$")
(define (modinfo-section-contents file) (define (modinfo-section-contents file)
"Return the contents of the '.modinfo' section of FILE as a list of "Return the contents of the '.modinfo' section of FILE as a list of
key/value pairs.." key/value pairs.."
(define (get-bytevector file) (define (decompress-file decompressor file)
(cond
((string-suffix? ".ko.gz" file)
(let ((port (open-file file "r0"))) (let ((port (open-file file "r0")))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
#t) #t)
(lambda () (lambda ()
(call-with-gzip-input-port port get-bytevector-all)) (decompressor port get-bytevector-all))
(lambda () (lambda ()
(close-port port))))) (close-port port)))))
(define (get-bytevector file)
(cond
((string-suffix? ".ko.gz" file)
(decompress-file call-with-gzip-input-port file))
((string-suffix? ".ko.zst" file)
(decompress-file call-with-zstd-input-port file))
(else (else
(call-with-input-file file get-bytevector-all)))) (call-with-input-file file get-bytevector-all))))
@ -213,11 +220,12 @@ modules that can be postloaded, of the soft dependencies of module FILE."
(let ((suffix (match compression (let ((suffix (match compression
('xz ".ko.xz") ('xz ".ko.xz")
('gzip ".ko.gz") ('gzip ".ko.gz")
('zstd ".ko.zst")
(else ".ko")))) (else ".ko"))))
(string-append name suffix))) (string-append name suffix)))
(define (ensure-dot-ko name compression) (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." it."
(if (string-contains name ".ko") (if (string-contains name ".ko")
name name
@ -235,7 +243,7 @@ underscores."
(define (file-name->module-name file) (define (file-name->module-name file)
"Return the module name corresponding to FILE, stripping the trailing "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)))) (normalize-module-name (strip-extension (basename file))))
(define (find-module-file directory module) (define (find-module-file directory module)
@ -333,11 +341,11 @@ not a file name."
(recursive? #t) (recursive? #t)
(lookup-module dot-ko) (lookup-module dot-ko)
(black-list (module-black-list))) (black-list (module-black-list)))
"Load Linux module from FILE, the name of a '.ko[.gz|.xz]' file; return true "Load Linux module from FILE, the name of a '.ko[.gz|.xz|.zst]' file; return
on success, false otherwise. When RECURSIVE? is true, load its dependencies true on success, false otherwise. When RECURSIVE? is true, load its
first (à la 'modprobe'.) The actual files containing modules depended on are dependencies first (à la 'modprobe'.) The actual files containing modules
obtained by calling LOOKUP-MODULE with the module name. Modules whose name depended on are obtained by calling LOOKUP-MODULE with the module name.
appears in BLACK-LIST are not loaded." Modules whose name appears in BLACK-LIST are not loaded."
(define (black-listed? module) (define (black-listed? module)
(let ((result (member module black-list))) (let ((result (member module black-list)))
(when result (when result
@ -695,7 +703,7 @@ are required to access DEVICE."
"Guess the file name corresponding to NAME, a module name. That doesn't "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., 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 \"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." compression type."
(string-append directory "/" (ensure-dot-ko name compression))) (string-append directory "/" (ensure-dot-ko name compression)))
@ -706,6 +714,8 @@ compression type."
(define (guess-file-name name) (define (guess-file-name name)
(let ((names (list (let ((names (list
(module-name->file-name/guess directory name) (module-name->file-name/guess directory name)
(module-name->file-name/guess directory name
#:compression 'zstd)
(module-name->file-name/guess directory name (module-name->file-name/guess directory name
#:compression 'xz) #:compression 'xz)
(module-name->file-name/guess directory name (module-name->file-name/guess directory name
@ -729,8 +739,8 @@ compression type."
(define (write-module-name-database directory) (define (write-module-name-database directory)
"Write a database that maps \"module names\" as they appear in the relevant "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 ELF section of '.ko[.gz|.xz|.zst]' files, to actual file names. This format
Guix-specific. It aims to deal with inconsistent naming, in particular is Guix-specific. It aims to deal with inconsistent naming, in particular
hyphens vs. underscores." hyphens vs. underscores."
(define mapping (define mapping
(map (lambda (file) (map (lambda (file)
@ -749,8 +759,8 @@ hyphens vs. underscores."
(pretty-print mapping port)))) (pretty-print mapping port))))
(define (write-module-alias-database directory) (define (write-module-alias-database directory)
"Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding "Traverse the '.ko[.gz|.xz|.zst]' files in DIRECTORY and create the
'modules.alias' file." corresponding 'modules.alias' file."
(define aliases (define aliases
(map (lambda (file) (map (lambda (file)
(cons (file-name->module-name file) (module-aliases file))) (cons (file-name->module-name file) (module-aliases file)))
@ -796,9 +806,9 @@ are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f."
(char-set-complement (char-set #\-))) (char-set-complement (char-set #\-)))
(define (write-module-device-database directory) (define (write-module-device-database directory)
"Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding "Traverse the '.ko[.gz|.xz|.zst]' files in DIRECTORY and create the
'modules.devname' file. This file contains information about modules that can corresponding 'modules.devname' file. This file contains information about
be loaded on-demand, such as file system modules." modules that can be loaded on-demand, such as file system modules."
(define aliases (define aliases
(filter-map (lambda (file) (filter-map (lambda (file)
(match (aliases->device-tuple (module-aliases file)) (match (aliases->device-tuple (module-aliases file))

View File

@ -386,6 +386,7 @@ purposes."
guile-json-3 guile-git guile-webutils guile-json-3 guile-git guile-webutils
guile-gnutls guile-gnutls
guile-zlib ;for (gnu build linux-modules) guile-zlib ;for (gnu build linux-modules)
guile-zstd ;for (gnu build linux-modules)
(current-guix)) (current-guix))
(with-imported-modules `(,@(source-module-closure (with-imported-modules `(,@(source-module-closure
`(,@modules `(,@modules

View File

@ -874,6 +874,10 @@ ARCH and optionally VARIANT, or #f if there is no such configuration."
,@(if (version>=? version "5.13") ,@(if (version>=? version "5.13")
'(("BPF_UNPRIV_DEFAULT_OFF" . #t)) '(("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. ;; Some very mild hardening.
("CONFIG_SECURITY_DMESG_RESTRICT" . #t) ("CONFIG_SECURITY_DMESG_RESTRICT" . #t)
;; All kernels should have NAMESPACES options enabled ;; All kernels should have NAMESPACES options enabled
@ -1063,7 +1067,10 @@ ARCH and optionally VARIANT, or #f if there is no such configuration."
"EXTRAVERSION ?=")) "EXTRAVERSION ?="))
(setenv "EXTRAVERSION" (setenv "EXTRAVERSION"
#$(and extra-version #$(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 (replace 'configure
(lambda _ (lambda _
(let ((config (let ((config
@ -1157,7 +1164,9 @@ ARCH and optionally VARIANT, or #f if there is no such configuration."
;; support. ;; support.
dwarves ;for pahole dwarves ;for pahole
python-wrapper python-wrapper
zlib)) zlib
;; For Zstd compression of kernel modules.
zstd))
(home-page "https://www.gnu.org/software/linux-libre/") (home-page "https://www.gnu.org/software/linux-libre/")
(synopsis "100% free redistribution of a cleaned Linux kernel") (synopsis "100% free redistribution of a cleaned Linux kernel")
(description "GNU Linux-Libre is a free (as in freedom) variant of the (description "GNU Linux-Libre is a free (as in freedom) variant of the

View File

@ -128,7 +128,7 @@ MODULES and taken from LINUX."
(define build-exp (define build-exp
(with-imported-modules imported-modules (with-imported-modules imported-modules
(with-extensions (list guile-zlib) (with-extensions (list guile-zlib guile-zstd)
#~(begin #~(begin
(use-modules (gnu build linux-modules) (use-modules (gnu build linux-modules)
(guix build utils) (guix build utils)
@ -168,7 +168,9 @@ MODULES and taken from LINUX."
;; is already gzipped as a whole. ;; is already gzipped as a whole.
(cond (cond
((string-contains file ".ko.gz") ((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) (mkdir #$output)
(for-each (lambda (module) (for-each (lambda (module)

View File

@ -7,7 +7,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@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 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
@ -1487,11 +1487,14 @@ This is meant to be used as a profile hook."
(define guile-zlib (define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) '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 (define build
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((guix build utils) '((guix build utils)
(gnu build linux-modules))) (gnu build linux-modules)))
(with-extensions (list guile-zlib) (with-extensions (list guile-zlib guile-zstd)
#~(begin #~(begin
(use-modules (ice-9 ftw) (use-modules (ice-9 ftw)
(ice-9 match) (ice-9 match)