[bug#42123] [PATCH] linux-libre: Enable module compression.

[Mathieu Othacehe]

Hey,

> I don’t have other ideas, but both solutions sound good to me.  Using
> (guix zlib) is slightly more “elegant” IMO, but no big deal.  I don’t
> expect any significant difference from the use of in-process
> decompression, unless we really have to go and decompress many modules
> in a row.

Creating the initrd implies to create the module name database, and it
ends-up decompressing every single module. Using the in-process method
it takes 2 seconds, using the second method 30 seconds.

So, I opted for the first solution as you suggested. Here's an attached
patch that fixes the situation.

Thanks,

Mathieu

>From 8bbf343510091fad4a08758e0115a70410c1c8d7 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 6 Jul 2020 16:04:21 +0200
Subject: [PATCH] self: Add with-imported-modules+config and use it.

Introduce "with-imported-modules+config" and use it to replace every call to
"with-imported-modules" that would trigger an import of (guix config) module.

* guix/self.scm (not-config?): New procedure,
(with-imported-modules+config): new macro.
* guix/profiles.scm (linux-module-database): Replace with-imported-modules by
with-imported-modules+config.
* gnu/system/shadow.scm (account-shepherd-service): Ditto.
* gnu/system/linux-initrd.scm (raw-initrd): Ditto.
* gnu/services/base.scm (default-serial-port): Ditto,
(file-system-shepherd-service): ditto,
(udev-shepherd-service): ditto.
* gnu/services.scm (activation-script): Ditto.
* gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto.
---
 gnu/machine/ssh.scm         |  8 ++++----
 gnu/services.scm            |  6 +++---
 gnu/services/base.scm       | 11 +++++------
 gnu/system/linux-initrd.scm | 12 ++++++------
 gnu/system/shadow.scm       |  6 +++---
 guix/profiles.scm           |  6 +++---
 guix/self.scm               | 24 ++++++++++++++++++++++++
 7 files changed, 48 insertions(+), 25 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 4148639292..7369eb2136 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -33,6 +33,7 @@
   #:use-module (guix records)
   #:use-module (guix remote)
   #:use-module (guix scripts system reconfigure)
+  #:use-module (guix self)
   #:use-module (guix ssh)
   #:use-module (guix store)
   #:use-module (guix utils)
@@ -246,10 +247,9 @@ not available in the initrd."
   (define (missing-modules fs)
     (define remote-exp
       (let ((device (file-system-device fs)))
-        (with-imported-modules (source-module-closure
-                                '((gnu build file-systems)
-                                  (gnu build linux-modules)
-                                  (gnu system uuid)))
+        (with-imported-modules+config '((gnu build file-systems)
+                                        (gnu build linux-modules)
+                                        (gnu system uuid))
           #~(begin
               (use-modules (gnu build file-systems)
                            (gnu build linux-modules)
diff --git a/gnu/services.scm b/gnu/services.scm
index f6dc56d940..4d7371cd78 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -28,6 +28,7 @@
   #:use-module (guix combinators)
   #:use-module (guix channels)
   #:use-module (guix describe)
+  #:use-module (guix self)
   #:use-module (guix sets)
   #:use-module (guix ui)
   #:use-module ((guix utils) #:select (source-properties->location))
@@ -542,9 +543,8 @@ ACTIVATION-SCRIPT-TYPE."
     (map (cut program-file "activate-service.scm" <>) gexps))
 
   (program-file "activate.scm"
-                (with-imported-modules (source-module-closure
-                                        '((gnu build activation)
-                                          (guix build utils)))
+                (with-imported-modules+config '((gnu build activation)
+                                                (guix build utils))
                   #~(begin
                       (use-modules (gnu build activation)
                                    (guix build utils))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6ea7ef8e7e..94dfeb2315 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -30,6 +30,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services base)
+  #:use-module (guix self)
   #:use-module (guix store)
   #:use-module (guix deprecation)
   #:use-module (gnu services)
@@ -832,8 +833,8 @@ the message of the day, among other things."
 (define (default-serial-port)
   "Return a gexp that determines a reasonable default serial port
 to use as the tty.  This is primarily useful for headless systems."
-  (with-imported-modules (source-module-closure
-                          '((gnu build linux-boot))) ;for 'find-long-options'
+  (with-imported-modules+config
+      '((gnu build linux-boot)) ;for 'find-long-options'
     #~(begin
         ;; console=device,options
         ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
@@ -886,8 +887,7 @@ to use as the tty.  This is primarily useful for headless 
systems."
 
          (modules '((ice-9 match) (gnu build linux-boot)))
          (start
-          (with-imported-modules  (source-module-closure
-                                   '((gnu build linux-boot)))
+          (with-imported-modules+config '((gnu build linux-boot))
             #~(lambda args
                 (let ((defaulted-tty #$(or tty (default-serial-port))))
                   (apply
@@ -1935,8 +1935,7 @@ item of @var{packages}."
 
          (documentation "Populate the /dev directory, dynamically.")
          (start
-          (with-imported-modules (source-module-closure
-                                  '((gnu build linux-boot)))
+          (with-imported-modules+config '((gnu build linux-boot))
             #~(lambda ()
                 (define udevd
                   ;; 'udevd' from eudev.
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 99ec82246b..8779ef58d7 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -28,6 +28,7 @@
   #:use-module ((guix derivations)
                 #:select (derivation->output-path))
   #:use-module (guix modules)
+  #:use-module (guix self)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages linux)
@@ -214,12 +215,11 @@ upon error."
     (flat-linux-module-directory linux linux-modules))
 
   (expression->initrd
-   (with-imported-modules (source-module-closure
-                           '((gnu build linux-boot)
-                             (guix build utils)
-                             (guix build bournish)
-                             (gnu system file-systems)
-                             (gnu build file-systems)))
+   (with-imported-modules+config '((gnu build linux-boot)
+                                   (guix build utils)
+                                   (guix build bournish)
+                                   (gnu system file-systems)
+                                   (gnu build file-systems))
      #~(begin
          (use-modules (gnu build linux-boot)
                       (gnu system file-systems)
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index a69339bc07..e140f06913 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -22,6 +22,7 @@
 (define-module (gnu system shadow)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (guix self)
   #:use-module (guix store)
   #:use-module (guix modules)
   #:use-module (guix sets)
@@ -321,9 +322,8 @@ accounts among ACCOUNTS+GROUPS."
          (one-shot? #t)
          (modules '((gnu build activation)
                     (gnu system accounts)))
-         (start (with-imported-modules (source-module-closure
-                                        '((gnu build activation)
-                                          (gnu system accounts)))
+         (start (with-imported-modules+config '((gnu build activation)
+                                                (gnu system accounts))
                   #~(lambda ()
                       (activate-user-home
                        (map sexp->user-account
diff --git a/guix/profiles.scm b/guix/profiles.scm
index f34f73e17e..f11e400dd3 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -40,6 +40,7 @@
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix monads)
+  #:use-module (guix self)
   #:use-module (guix store)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
@@ -1205,9 +1206,8 @@ This is meant to be used as a profile hook."
   (define kmod                                    ; lazy reference
     (module-ref (resolve-interface '(gnu packages linux)) 'kmod))
   (define build
-    (with-imported-modules (source-module-closure
-                            '((guix build utils)
-                              (gnu build linux-modules)))
+    (with-imported-modules+config '((guix build utils)
+                                    (gnu build linux-modules))
       #~(begin
           (use-modules (ice-9 ftw)
                        (ice-9 match)
diff --git a/guix/self.scm b/guix/self.scm
index e1350a7403..82bb55f8e7 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -33,6 +33,8 @@
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:export (make-config.scm
+            not-config?
+            with-imported-modules+config
             whole-package                     ;for internal use in 'guix pull'
             compiled-guix
             guix-derivation))
@@ -1063,6 +1065,24 @@ Info manual."
                ;; made relative to a nonexistent anonymous module.
                #:splice? #t))
 
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (rest #f)))
+
+(define-syntax-rule (with-imported-modules+config modules exp ...)
+  "Import the closure of MODULES and evaluate EXP within this context.  If the
+(guix config) module is part of the closure, it is not selected.  This module
+is always replaced by a mocked-one, created by MAKE-CONFIG.SCM pocedure."
+  (with-imported-modules `(,@(source-module-closure
+                              modules
+                              #:select? not-config?)
+                           ((guix config) => ,(make-config.scm)))
+    exp ...))
+

 ;;;
 ;;; Building.
@@ -1213,3 +1233,7 @@ is not supported."
       (if guix
           (lower-object guix)
           (return #f)))))
+
+;; Local Variables:
+;; eval: (put 'with-imported-modules+config 'scheme-indent-function 2)
+;; End:
-- 
2.24.0