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/machine/ssh.scm | 35 +++++++++++++++++++----------------
 1 file changed, 19 insertions(+), 16 deletions(-)

(limited to 'gnu/machine')

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 4e31baa4b9..ee5032e281 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu machine)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
+  #:autoload   (gnu packages guile) (guile-zlib)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
@@ -248,22 +249,24 @@ not available in the initrd."
                                 '((gnu build file-systems)
                                   (gnu build linux-modules)
                                   (gnu system uuid)))
-          #~(begin
-              (use-modules (gnu build file-systems)
-                           (gnu build linux-modules)
-                           (gnu system uuid))
-
-              (define dev
-                #$(cond ((string? device) device)
-                        ((uuid? device) #~(find-partition-by-uuid
-                                           (string->uuid
-                                            #$(uuid->string device))))
-                        ((file-system-label? device)
-                         #~(find-partition-by-label
-                            #$(file-system-label->string device)))))
-
-              (missing-modules dev '#$(operating-system-initrd-modules
-                                       (machine-operating-system machine)))))))
+          (with-extensions (list guile-zlib)
+            #~(begin
+                (use-modules (gnu build file-systems)
+                             (gnu build linux-modules)
+                             (gnu system uuid))
+
+                (define dev
+                  #$(cond ((string? device) device)
+                          ((uuid? device) #~(find-partition-by-uuid
+                                             (string->uuid
+                                              #$(uuid->string device))))
+                          ((file-system-label? device)
+                           #~(find-partition-by-label
+                              #$(file-system-label->string device)))))
+
+                (missing-modules dev
+                                 '#$(operating-system-initrd-modules
+                                     (machine-operating-system machine))))))))
 
     (remote-let ((missing remote-exp))
       (unless (null? missing)
-- 
cgit v1.2.3