From 755f365b02b42a5d1e8ef3000dadef069553a478 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Sun, 5 Jul 2020 12:23:21 +0200
Subject: linux-libre: Support module compression.

This commit adds support for GZIP compression for linux-libre kernel
modules. The initrd modules are kept uncompressed as the initrd is already
compressed as a whole.

The linux-libre kernel also supports XZ compression, but as Guix does not have
any available bindings for now, and the compression time is far more
significant, GZIP seems to be a better option.

* gnu/build/linux-modules.scm (modinfo-section-contents): Use
'call-with-gzip-input-port' to read from a module file using '.gz' extension,
(strip-extension): new procedure,
(dot-ko): adapt to support compression,
(ensure-dot-ko): ditto,
(file-name->module-name): ditto,
(find-module-file): ditto,
(load-linux-module*): ditto,
(module-name->file-name/guess): ditto,
(module-name-lookup): ditto,
(write-module-name-database): ditto,
(write-module-alias-database): ditto,
(write-module-device-database): ditto.
* gnu/installer.scm (installer-program): Add "guile-zlib" to the extensions.
* gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto.
* gnu/services.scm (activation-script): Ditto.
* gnu/services/base.scm (default-serial-port): Ditto,
(agetty-shepherd-service): ditto,
(udev-service-type): ditto.
* gnu/system/image.scm (gcrypt-sqlite3&co): Ditto.
* gnu/system/linux-initrd.scm (flat-linux-module-directory): Add "guile-zlib"
to the extensions and make sure that the initrd only contains
uncompressed module files.
* gnu/system/shadow.scm (account-shepherd-service): Add "guile-zlib" to the
extensions.
* guix/profiles.scm (linux-module-database): Ditto.
---
 gnu/system/linux-initrd.scm | 72 ++++++++++++++++++++++++++++-----------------
 1 file changed, 45 insertions(+), 27 deletions(-)

(limited to 'gnu/system/linux-initrd.scm')

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 0971ec29e2..b8a30c0abc 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -77,6 +77,9 @@ (define init
     (program-file "init" exp #:guile guile))
 
   (define builder
+    ;; Do not use "guile-zlib" extension here, otherwise it would drag the
+    ;; non-static "zlib" package to the initrd closure.  It is not needed
+    ;; anyway because the modules are stored uncompressed within the initrd.
     (with-imported-modules (source-module-closure
                             '((gnu build linux-initrd)))
       #~(begin
@@ -111,34 +114,49 @@ (define builder
 (define (flat-linux-module-directory linux modules)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
-  (define build-exp
-    (with-imported-modules (source-module-closure
-                            '((gnu build linux-modules)))
-      #~(begin
-          (use-modules (gnu build linux-modules)
-                       (srfi srfi-1)
-                       (srfi srfi-26))
-
-          (define module-dir
-            (string-append #$linux "/lib/modules"))
+  (define imported-modules
+    (source-module-closure '((gnu build linux-modules)
+                             (guix build utils))))
 
-          (define modules
-            (let* ((lookup  (cut find-module-file module-dir <>))
-                   (modules (map lookup '#$modules)))
-              (append modules
-                      (recursive-module-dependencies modules
-                                                     #:lookup-module lookup))))
-
-          (mkdir #$output)
-          (for-each (lambda (module)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename module))))
-                    (delete-duplicates modules))
-
-          ;; Hyphen or underscore?  This database tells us.
-          (write-module-name-database #$output))))
+  (define build-exp
+    (with-imported-modules imported-modules
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (gnu build linux-modules)
+                         (guix build utils)
+                         (srfi srfi-1)
+                         (srfi srfi-26))
+
+            (define module-dir
+              (string-append #$linux "/lib/modules"))
+
+            (define modules
+              (let* ((lookup  (cut find-module-file module-dir <>))
+                     (modules (map lookup '#$modules)))
+                (append modules
+                        (recursive-module-dependencies
+                         modules
+                         #:lookup-module lookup))))
+
+            (define (maybe-uncompress file)
+              ;; If FILE is a compressed module, uncompress it, as the initrd
+              ;; is already gzipped as a whole.
+              (cond
+               ((string-contains file ".ko.gz")
+                (invoke #+(file-append gzip "/bin/gunzip") file))))
+
+            (mkdir #$output)
+            (for-each (lambda (module)
+                        (let ((out-module
+                               (string-append #$output "/"
+                                              (basename module))))
+                          (format #t "copying '~a'...~%" module)
+                          (copy-file module out-module)
+                          (maybe-uncompress out-module)))
+                      (delete-duplicates modules))
+
+            ;; Hyphen or underscore?  This database tells us.
+            (write-module-name-database #$output)))))
 
   (computed-file "linux-modules" build-exp))
 
-- 
cgit v1.2.3