[bug#70962] [PATCH 13/14] gnu: linux-libre: Enable Zstd compression of kernel modules.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

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
---

 gnu/build/linux-modules.scm | 62 +++++++++++++++++++++----------------
 gnu/installer.scm           |  1 +
 gnu/packages/linux.scm      | 13 ++++++--
 gnu/system/linux-initrd.scm |  6 ++--
 guix/profiles.scm           |  7 +++--
 5 files changed, 57 insertions(+), 32 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 68c32ff873..32baf6c525 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -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))
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 3b06b4f01b..3792fc7e35 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -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
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index d2b9344296..7147a6b41a 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -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
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index d448c78918..f902637e48 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -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)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index d41802422b..864ed02b6d 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -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)
-- 
2.41.0