all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [bug#42123] [PATCH] linux-libre: Enable module compression.
@ 2020-06-29 14:24 Mathieu Othacehe
  2020-06-30  7:31 ` Mathieu Othacehe
  2020-07-02 10:23 ` Ludovic Courtès
  0 siblings, 2 replies; 16+ messages in thread
From: Mathieu Othacehe @ 2020-06-29 14:24 UTC (permalink / raw)
  To: 42123; +Cc: Mathieu Othacehe

This commit enables GZIP compression for linux-libre kernel modules, reducing
the size of linux-libre by 63% (165MB). 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/packages/aux-files/linux-libre/5.4-arm.conf: Enable GZ compression.
* gnu/packages/aux-files/linux-libre/5.4-arm64.conf: Ditto.
* gnu/packages/aux-files/linux-libre/5.4-i686.conf: Ditto.
* gnu/packages/aux-files/linux-libre/5.4-x86_64.conf: Ditto.
* 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/system/linux-initrd.scm (flat-linux-module-directory): Make sure that
zlib bindings are available because they may be used in
'write-module-device-database'. Also make sure that the initrd only contains
uncompressed module files.
---
Hello,

I think the commit message pretty much describes this change. Just wanted to
add that it passes the loadable-kernel-modules-X tests.

Thanks,

Mathieu

 gnu/build/linux-modules.scm                   | 102 ++++++++++++------
 .../aux-files/linux-libre/5.4-arm.conf        |   4 +-
 .../aux-files/linux-libre/5.4-arm64.conf      |   4 +-
 .../aux-files/linux-libre/5.4-i686.conf       |   4 +-
 .../aux-files/linux-libre/5.4-x86_64.conf     |   4 +-
 gnu/system/linux-initrd.scm                   |  38 +++++--
 6 files changed, 111 insertions(+), 45 deletions(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index aa1c7cfeae..7c6945a881 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
 (define-module (gnu build linux-modules)
   #:use-module (guix elf)
   #:use-module (guix glob)
+  #:use-module (guix zlib)
   #:use-module (guix build syscalls)
   #:use-module ((guix build utils) #:select (find-files invoke))
   #:use-module (guix build union)
@@ -97,7 +98,16 @@ string list."
 (define (modinfo-section-contents file)
   "Return the contents of the '.modinfo' section of FILE as a list of
 key/value pairs.."
-  (let* ((bv      (call-with-input-file file get-bytevector-all))
+  (define (get-bytevector file)
+    (cond
+     ((string-contains file ".ko.gz")
+      (call-with-input-file file
+        (lambda (port)
+          (call-with-gzip-input-port port get-bytevector-all))))
+     (else
+      (call-with-input-file file get-bytevector-all))))
+
+  (let* ((bv      (get-bytevector file))
          (elf     (parse-elf bv))
          (section (elf-section-by-name elf ".modinfo"))
          (modinfo (section-contents elf section)))
@@ -110,7 +120,7 @@ key/value pairs.."
 (define (module-formal-name file)
   "Return the module name of FILE as it appears in its info section.  Usually
 the module name is the same as the base name of FILE, modulo hyphens and minus
-the \".ko\" extension."
+the \".ko[.gz|.xz]\" extension."
   (match (assq 'name (modinfo-section-contents file))
     (('name . name) name)
     (#f #f)))
@@ -171,14 +181,25 @@ modules that can be postloaded, of the soft dependencies of module FILE."
                  (_ #f))
                 (modinfo-section-contents file))))
 
-(define dot-ko
-  (cut string-append <> ".ko"))
-
-(define (ensure-dot-ko name)
-  "Return NAME with a '.ko' prefix appended, unless it already has it."
-  (if (string-suffix? ".ko" name)
+(define (strip-extension filename)
+  (let ((extension (string-index filename #\.)))
+    (if extension
+        (string-take filename extension)
+        filename)))
+
+(define (dot-ko name compression)
+  (let ((suffix (match compression
+                  ('xz   ".ko.xz")
+                  ('gzip ".ko.gz")
+                  (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
+it."
+  (if (string-contains name ".ko")
       name
-      (dot-ko name)))
+      (dot-ko name compression)))
 
 (define (normalize-module-name module)
   "Return the \"canonical\" name for MODULE, replacing hyphens with
@@ -191,9 +212,9 @@ underscores."
               module))
 
 (define (file-name->module-name file)
-  "Return the module name corresponding to FILE, stripping the trailing '.ko'
-and normalizing it."
-  (normalize-module-name (basename file ".ko")))
+  "Return the module name corresponding to FILE, stripping the trailing
+'.ko[.gz|.xz]' and normalizing it."
+  (normalize-module-name (strip-extension (basename file))))
 
 (define (find-module-file directory module)
   "Lookup module NAME under DIRECTORY, and return its absolute file name.
@@ -208,19 +229,19 @@ whereas file names often, but not always, use hyphens.  Examples:
     ;; List of possible file names.  XXX: It would of course be cleaner to
     ;; have a database that maps module names to file names and vice versa,
     ;; but everyone seems to be doing hacks like this one.  Oh well!
-    (map ensure-dot-ko
-         (delete-duplicates
-          (list module
-                (normalize-module-name module)
-                (string-map (lambda (chr) ;converse of 'normalize-module-name'
-                              (case chr
-                                ((#\_) #\-)
-                                (else chr)))
-                            module)))))
+    (delete-duplicates
+     (list module
+           (normalize-module-name module)
+           (string-map (lambda (chr) ;converse of 'normalize-module-name'
+                         (case chr
+                           ((#\_) #\-)
+                           (else chr)))
+                       module))))
 
   (match (find-files directory
                      (lambda (file stat)
-                       (member (basename file) names)))
+                       (member (strip-extension
+                                (basename file)) names)))
     ((file)
      file)
     (()
@@ -290,8 +311,8 @@ not a file name."
                              (recursive? #t)
                              (lookup-module dot-ko)
                              (black-list (module-black-list)))
-  "Load Linux module from FILE, the name of a '.ko' file; return true on
-success, false otherwise.  When RECURSIVE? is true, load its dependencies
+  "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."
@@ -523,16 +544,27 @@ are required to access DEVICE."
 ;;; Module databases.
 ;;;
 
-(define (module-name->file-name/guess directory name)
+(define* (module-name->file-name/guess directory name
+                                       #:key compression)
   "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\")."
-  (string-append directory "/" (ensure-dot-ko name)))
+  (string-append directory "/" (ensure-dot-ko name compression)))
 
 (define (module-name-lookup directory)
   "Return a one argument procedure that takes a module name (e.g.,
 \"input_leds\") and returns its absolute file name (e.g.,
 \"/.../input-leds.ko\")."
+  (define (guess-file-name name)
+    (let ((names (list
+                  (module-name->file-name/guess directory name)
+                  (module-name->file-name/guess directory name
+                                                #:compression 'xz)
+                  (module-name->file-name/guess directory name
+                                                #:compression 'gzip))))
+      (or (find file-exists? names)
+          (first names))))
+
   (catch 'system-error
     (lambda ()
       (define mapping
@@ -541,23 +573,23 @@ always work because sometimes underscores in NAME map to hyphens (e.g.,
 
       (lambda (name)
         (or (assoc-ref mapping name)
-            (module-name->file-name/guess directory name))))
+            (guess-file-name name))))
     (lambda args
       (if (= ENOENT (system-error-errno args))
-          (cut module-name->file-name/guess directory <>)
+          (cut guess-file-name <>)
           (apply throw args)))))
 
 (define (write-module-name-database directory)
   "Write a database that maps \"module names\" as they appear in the relevant
-ELF section of '.ko' files, to actual file names.  This format is
+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
 hyphens vs. underscores."
   (define mapping
     (map (lambda (file)
            (match (module-formal-name file)
-             (#f   (cons (basename file ".ko") file))
+             (#f   (cons (strip-extension (basename file)) file))
              (name (cons name file))))
-         (find-files directory "\\.ko$")))
+         (find-files directory "\\.ko.*$")))
 
   (call-with-output-file (string-append directory "/modules.name")
     (lambda (port)
@@ -569,12 +601,12 @@ hyphens vs. underscores."
       (pretty-print mapping port))))
 
 (define (write-module-alias-database directory)
-  "Traverse the '.ko' files in DIRECTORY and create the corresponding
+  "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
 'modules.alias' file."
   (define aliases
     (map (lambda (file)
            (cons (file-name->module-name file) (module-aliases file)))
-         (find-files directory "\\.ko$")))
+         (find-files directory "\\.ko.*$")))
 
   (call-with-output-file (string-append directory "/modules.alias")
     (lambda (port)
@@ -616,7 +648,7 @@ are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f."
   (char-set-complement (char-set #\-)))
 
 (define (write-module-device-database directory)
-  "Traverse the '.ko' files in DIRECTORY and create the corresponding
+  "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."
   (define aliases
@@ -624,7 +656,7 @@ be loaded on-demand, such as file system modules."
                   (match (aliases->device-tuple (module-aliases file))
                     (#f #f)
                     (tuple (cons (file-name->module-name file) tuple))))
-                (find-files directory "\\.ko$")))
+                (find-files directory "\\.ko.*$")))
 
   (call-with-output-file (string-append directory "/modules.devname")
     (lambda (port)
diff --git a/gnu/packages/aux-files/linux-libre/5.4-arm.conf b/gnu/packages/aux-files/linux-libre/5.4-arm.conf
index a54228643b..7c9ab94719 100644
--- a/gnu/packages/aux-files/linux-libre/5.4-arm.conf
+++ b/gnu/packages/aux-files/linux-libre/5.4-arm.conf
@@ -880,7 +880,9 @@ CONFIG_MODULE_FORCE_UNLOAD=y
 CONFIG_MODVERSIONS=y
 # CONFIG_MODULE_SRCVERSION_ALL is not set
 # CONFIG_MODULE_SIG is not set
-# CONFIG_MODULE_COMPRESS is not set
+CONFIG_MODULE_COMPRESS=y
+CONFIG_MODULE_COMPRESS_GZIP=y
+# CONFIG_MODULE_COMPRESS_XZ is not set
 # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set
 # CONFIG_UNUSED_SYMBOLS is not set
 # CONFIG_TRIM_UNUSED_KSYMS is not set
diff --git a/gnu/packages/aux-files/linux-libre/5.4-arm64.conf b/gnu/packages/aux-files/linux-libre/5.4-arm64.conf
index fabd25c6a4..6520d1ddf2 100644
--- a/gnu/packages/aux-files/linux-libre/5.4-arm64.conf
+++ b/gnu/packages/aux-files/linux-libre/5.4-arm64.conf
@@ -781,7 +781,9 @@ CONFIG_MODVERSIONS=y
 CONFIG_ASM_MODVERSIONS=y
 # CONFIG_MODULE_SRCVERSION_ALL is not set
 # CONFIG_MODULE_SIG is not set
-# CONFIG_MODULE_COMPRESS is not set
+CONFIG_MODULE_COMPRESS=y
+CONFIG_MODULE_COMPRESS_GZIP=y
+# CONFIG_MODULE_COMPRESS_XZ is not set
 # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set
 # CONFIG_UNUSED_SYMBOLS is not set
 # CONFIG_TRIM_UNUSED_KSYMS is not set
diff --git a/gnu/packages/aux-files/linux-libre/5.4-i686.conf b/gnu/packages/aux-files/linux-libre/5.4-i686.conf
index 50a41f6cc9..3727f9d486 100644
--- a/gnu/packages/aux-files/linux-libre/5.4-i686.conf
+++ b/gnu/packages/aux-files/linux-libre/5.4-i686.conf
@@ -850,7 +850,9 @@ CONFIG_MODVERSIONS=y
 CONFIG_ASM_MODVERSIONS=y
 CONFIG_MODULE_SRCVERSION_ALL=y
 # CONFIG_MODULE_SIG is not set
-# CONFIG_MODULE_COMPRESS is not set
+CONFIG_MODULE_COMPRESS=y
+CONFIG_MODULE_COMPRESS_GZIP=y
+# CONFIG_MODULE_COMPRESS_XZ is not set
 # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set
 CONFIG_UNUSED_SYMBOLS=y
 CONFIG_MODULES_TREE_LOOKUP=y
diff --git a/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf b/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf
index 30fdc4e86a..be7a603af1 100644
--- a/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf
+++ b/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf
@@ -849,7 +849,9 @@ CONFIG_MODVERSIONS=y
 CONFIG_ASM_MODVERSIONS=y
 CONFIG_MODULE_SRCVERSION_ALL=y
 # CONFIG_MODULE_SIG is not set
-# CONFIG_MODULE_COMPRESS is not set
+CONFIG_MODULE_COMPRESS=y
+CONFIG_MODULE_COMPRESS_GZIP=y
+# CONFIG_MODULE_COMPRESS_XZ is not set
 # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set
 CONFIG_UNUSED_SYMBOLS=y
 CONFIG_MODULES_TREE_LOOKUP=y
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 0971ec29e2..99ec82246b 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -111,11 +111,29 @@ the derivations referenced by EXP are automatically copied to the initrd."
 (define (flat-linux-module-directory linux modules)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
+  (define zlib
+    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
+
+  (define config.scm
+    (scheme-file "config.scm"
+                 #~(begin
+                     (define-module (guix config)
+                       #:export (%libz))
+
+                     (define %libz
+                       #+(file-append zlib "/lib/libz")))))
+
+  (define imported-modules
+    (cons `((guix config) => ,config.scm)
+          (delete '(guix config)
+                  (source-module-closure '((gnu build linux-modules)
+                                           (guix build utils))))))
+
   (define build-exp
-    (with-imported-modules (source-module-closure
-                            '((gnu build linux-modules)))
+    (with-imported-modules imported-modules
       #~(begin
           (use-modules (gnu build linux-modules)
+                       (guix build utils)
                        (srfi srfi-1)
                        (srfi srfi-26))
 
@@ -129,12 +147,20 @@ MODULES and taken from LINUX."
                       (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)
-                      (format #t "copying '~a'...~%" module)
-                      (copy-file module
-                                 (string-append #$output "/"
-                                                (basename 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.
-- 
2.26.2





^ permalink raw reply related	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-06-29 14:24 [bug#42123] [PATCH] linux-libre: Enable module compression Mathieu Othacehe
@ 2020-06-30  7:31 ` Mathieu Othacehe
  2020-07-02 10:23 ` Ludovic Courtès
  1 sibling, 0 replies; 16+ messages in thread
From: Mathieu Othacehe @ 2020-06-30  7:31 UTC (permalink / raw)
  To: 42123


Hello,

There's at least one issue with this one. When running the
"installation-os" test, I have this backtrace:

--8<---------------cut here---------------start------------->8---
+ guix system init /mnt/etc/config.scm /mnt --no-substitutes
The following derivations will be built:
   /gnu/store/rlq93i0ahllyvmjxk14w3snmqsv7bsvg-system.drv
   /gnu/store/28cfjshgch8jyixmwv3q0x1ybniwlvf5-parameters.drv
   /gnu/store/vk3rw7qwm7p0ldy34cadzgczxx2hc5xf-raw-initrd.drv
   /gnu/store/w219h1ia74bkplvr622f0b8qxyi9xw7y-provenance.drv
   /gnu/store/z56pp4bw5hif9mh856cckqvfnvykaybh-profile.drv
   /gnu/store/xalv7fm73cpyyi3zyvy1zlb26nfi1fb6-module-import-compiled.drv
   /gnu/store/rmpwh65ypvv1805zwmcir8gk9b53c4gz-module-import-compiled.drv
   /gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv
The following profile hook will be built:
   /gnu/store/92giwj2f8jyq90l20q19vcvds18v9xf4-linux-module-database.drv
building /gnu/store/w219h1ia74bkplvr622f0b8qxyi9xw7y-provenance.drv...
building /gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv...
\builder for `/gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv' failed to produce output path `/gnu/store/f99fblkzb6ip268sg096shhs7wzjyp55-Python-3.5.9.tar.xz'
build of /gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv failed
View build log at '/var/log/guix/drvs/k4/m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv.bz2'.
cannot build derivation `/gnu/store/9l09n8d6ick1nsjvchysys3hdgq7ynfr-Python-3.5.9.tar.xz.drv': 1 dependencies couldn't be built
building /gnu/store/wd9giqyfcfm1wgc6rscl3m9i30hg6rcs-bash-2.05b.tar.gz.drv...
cannot build derivation `/gnu/store/66q0r5cr3j1cbwckx5zvi0wv4cp3kxgl-python-minimal-3.5.9.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/c2ly303cbslks8hx3811wa91wahqr295-glibc-2.31.drv': 1 dependencies couldn't be built
building /gnu/store/h1p3962y3bmv1zgwsng1gb4c7caryj82-config.scm.drv...
cannot build derivation `/gnu/store/97vna9jgn19hyfx24s2kd6c3wywg22wl-e2fsprogs-1.45.6.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/r4dg2iypidr067kyddg90z07arrxp3h6-e2fsck-static-1.45.6.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/64f1y8njbd8bppl61fm6dhljnlgmh3h2-init.drv': 1 dependencies couldn't be built
building /gnu/store/6v5f1ry0pbhm2a1v5v8b773qpncnf6rr-module-import-compiled.drv...
cannot build derivation `/gnu/store/vk3rw7qwm7p0ldy34cadzgczxx2hc5xf-raw-initrd.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv': 1 dependencies couldn't be built
guix system: error: build of `/gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv' failed
environment variable `PATH' set to `/gnu/store/a2b10x6h8j8qgsrcqip06xhnbssa0k25-qemu-minimal-5.0.0/bin'
--8<---------------cut here---------------end--------------->8---

For some reason, something triggers a build of the initrd (instead of using
the gcrooted one). I guess it's related to the addition of "zlib" and
"gzip" to the initrd inputs, but I don't understand why.

Someone?

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-06-29 14:24 [bug#42123] [PATCH] linux-libre: Enable module compression Mathieu Othacehe
  2020-06-30  7:31 ` Mathieu Othacehe
@ 2020-07-02 10:23 ` Ludovic Courtès
  2020-07-06  8:48   ` Mathieu Othacehe
  1 sibling, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-02 10:23 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: Mathieu Othacehe, 42123

Hi!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> This commit enables GZIP compression for linux-libre kernel modules, reducing
> the size of linux-libre by 63% (165MB). 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/packages/aux-files/linux-libre/5.4-arm.conf: Enable GZ compression.
> * gnu/packages/aux-files/linux-libre/5.4-arm64.conf: Ditto.
> * gnu/packages/aux-files/linux-libre/5.4-i686.conf: Ditto.
> * gnu/packages/aux-files/linux-libre/5.4-x86_64.conf: Ditto.
> * 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/system/linux-initrd.scm (flat-linux-module-directory): Make sure that
> zlib bindings are available because they may be used in
> 'write-module-device-database'. Also make sure that the initrd only contains
> uncompressed module files.

Nice!

I do think that gzip is more appropriate than xz here, also in terms of
memory requirements.

Perhaps you can do this in two patches: first the linux-initrd bits, and
2nd the linux-libre changes.

> diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
> index aa1c7cfeae..7c6945a881 100644
> --- a/gnu/build/linux-modules.scm
> +++ b/gnu/build/linux-modules.scm
> @@ -21,6 +21,7 @@
>  (define-module (gnu build linux-modules)
>    #:use-module (guix elf)
>    #:use-module (guix glob)
> +  #:use-module (guix zlib)
>    #:use-module (guix build syscalls)
>    #:use-module ((guix build utils) #:select (find-files invoke))
>    #:use-module (guix build union)
> @@ -97,7 +98,16 @@ string list."
>  (define (modinfo-section-contents file)
>    "Return the contents of the '.modinfo' section of FILE as a list of
>  key/value pairs.."
> -  (let* ((bv      (call-with-input-file file get-bytevector-all))
> +  (define (get-bytevector file)
> +    (cond
> +     ((string-contains file ".ko.gz")

‘string-suffix?’ would be more accurate.

> +      (call-with-input-file file
> +        (lambda (port)
> +          (call-with-gzip-input-port port get-bytevector-all))))

‘call-with-input-file’ creates a buffered port, which could be
problematic, although ‘make-gzip-input-port’ checks that.

To be safe, you’d do (open-file file "r0") with a dynwind.

> +(define* (module-name->file-name/guess directory name
> +                                       #:key compression)
>    "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\")."

Please mention COMPRESSION in the docstring.

>  (define (write-module-alias-database directory)
> -  "Traverse the '.ko' files in DIRECTORY and create the corresponding
> +  "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding
>  'modules.alias' file."
>    (define aliases
>      (map (lambda (file)
>             (cons (file-name->module-name file) (module-aliases file)))
> -         (find-files directory "\\.ko$")))
> +         (find-files directory "\\.ko.*$")))

Should we refine this regexp (there are a couple of places like this)?

There other Scheme bits LGTM!

(I don’t really know about Linux-libre but you do!)

Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-02 10:23 ` Ludovic Courtès
@ 2020-07-06  8:48   ` Mathieu Othacehe
  2020-07-06 12:20     ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-07-06  8:48 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123


Hey Ludo,

> There other Scheme bits LGTM!
>
> (I don’t really know about Linux-libre but you do!)

Thanks a lot for reviewing :) I took all your remarks into
account. Regarding the test issue I'm describing in this thread, I now
have an understanding of the situation.

Adding (guix zlib) as a dependency of (gnu build linux-modules) also
drags (guix config). That's an issue because there are a lot of
derivations including (gnu build linux-modules) without deleting/mocking
(guix config).

That's for instance the case with "expression->initrd", and it explains
why the installation test is trying to rebuild the initrd.

I see two solutions here:

* Delete/mock (guix config) in every derivation including (gnu build
linux-modules) or any other build module that includes it. Not ideal
because there are quite numerous.

* Do not use (guix zlib) but a raw "gzip -cd" pipe in (gnu build
linux-modules). It works but it way slower.
  
A third solution would be nice here :)

WDYT?

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-06  8:48   ` Mathieu Othacehe
@ 2020-07-06 12:20     ` Ludovic Courtès
  2020-07-06 14:23       ` Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-06 12:20 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hello!

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Adding (guix zlib) as a dependency of (gnu build linux-modules) also
> drags (guix config). That's an issue because there are a lot of
> derivations including (gnu build linux-modules) without deleting/mocking
> (guix config).
>
> That's for instance the case with "expression->initrd", and it explains
> why the installation test is trying to rebuild the initrd.
>
> I see two solutions here:
>
> * Delete/mock (guix config) in every derivation including (gnu build
> linux-modules) or any other build module that includes it. Not ideal
> because there are quite numerous.
>
> * Do not use (guix zlib) but a raw "gzip -cd" pipe in (gnu build
> linux-modules). It works but it way slower.

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.

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-06 12:20     ` Ludovic Courtès
@ 2020-07-06 14:23       ` Mathieu Othacehe
  2020-07-06 20:13         ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-07-06 14:23 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123

[-- Attachment #1: Type: text/plain, Size: 648 bytes --]


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

[-- Attachment #2: import.patch --]
[-- Type: text/x-diff, Size: 10330 bytes --]

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 ...))
+
 \f
 ;;;
 ;;; 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


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-06 14:23       ` Mathieu Othacehe
@ 2020-07-06 20:13         ` Ludovic Courtès
  2020-07-07  7:32           ` Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-06 20:13 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

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

Woow, interesting.

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

[...]

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

[...]

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

Two remarks: I feel that this is not the best place for it, and I think
we should add (guix config) if and only if it’s actually part of the
closure.

For the name I’m tempted by a simpler but less descriptive option.

That would give us:

  (define-syntax-rule (with-imported-modules* modules exp ...)
    (let ((closure (source-module-closure modules #:select? not-config?)))
      (with-imported-modules (map (match-lambda
                                    (('guix 'config) …)
                                    (module module))
                                  closure)
        exp ...)))

WDYT?

As for the location… I think the reason things are like this is to avoid
having everything depend on (guix self), but maybe that’s OK after all?

If the zlib bindings were an external package, things would be easier
because we wouldn’t have to do this (guix config) dance.

More generally, we should look at all the uses of (guix config) and see
whether/how we can get rid of them.

But I digress… Thoughts?

Thank you,
Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-06 20:13         ` Ludovic Courtès
@ 2020-07-07  7:32           ` Mathieu Othacehe
  2020-07-09  7:56             ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-07-07  7:32 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123


Hey Ludo!

> As for the location… I think the reason things are like this is to avoid
> having everything depend on (guix self), but maybe that’s OK after all?
>
> If the zlib bindings were an external package, things would be easier
> because we wouldn’t have to do this (guix config) dance.
>
> More generally, we should look at all the uses of (guix config) and see
> whether/how we can get rid of them.
>
> But I digress… Thoughts?

Thanks for your quick feedback. Given the time I spent debugging this
issue, I agree that this (guix config) module thing is hard to deal
with.

If it works for you, I could create three new Guile libraries:

* Guile-libz
* Guile-liblz
* Guile-xz

or maybe just,

* Guile-compression

It would help us getting rid of (guix config) as you proposed.

WDYT?

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-07  7:32           ` Mathieu Othacehe
@ 2020-07-09  7:56             ` Ludovic Courtès
  2020-07-27 16:24               ` Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-09  7:56 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> If it works for you, I could create three new Guile libraries:
>
> * Guile-libz
> * Guile-liblz
> * Guile-xz

If I may :-), it should be guile-zlib and guile-lzlib to match upstream
names.

(We don’t have bindings to XZ though.)

> or maybe just,
>
> * Guile-compression

Yeah it’s tempting, though OTOH users would be forced to pull everything
even if they only care about one of these.  Dunno.

Hall should come in handy to build those libs!  I guess people will be
happy to have them available outside Guix.

> It would help us getting rid of (guix config) as you proposed.

Yeah.

Thank you!

Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-09  7:56             ` Ludovic Courtès
@ 2020-07-27 16:24               ` Mathieu Othacehe
  2020-07-28 22:16                 ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-07-27 16:24 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123

[-- Attachment #1: Type: text/plain, Size: 512 bytes --]


Hey hey,

> Hall should come in handy to build those libs!  I guess people will be
> happy to have them available outside Guix.
>
>> It would help us getting rid of (guix config) as you proposed.

So as you suggested I created "guile-zlib" and "guile-lzlib" which was
the easy part. The other part is the hard to digest, attached patch.

I tested it running "make check", "make as-derivation", "./pre-inst-env
guix build guix". Hope I didn't miss something.

Please, tell me what you think :)

Thanks,

Mathieu

[-- Attachment #2: 0001-Use-guile-zlib-and-guile-lzlib-instead-of-guix-confi.patch --]
[-- Type: text/x-diff, Size: 84548 bytes --]

From d0f23078d1963f9aa8facda0fb3ae40e1e8c3cf2 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 27 Jul 2020 16:36:39 +0200
Subject: [PATCH] Use "guile-zlib" and "guile-lzlib" instead of (guix config).

* Makefile.am (MODULES): Remove guix/zlib.scm and guix/lzlib.scm,
(SCM_TESTS): remove tests/zlib.scm, tests/lzlib.scm.
* build-aux/build-self.scm (make-config.scm): Remove unused %libz variable.
* configure.ac: Remove LIBZ and LIBLZ variables and check instead for
Guile-zlib and Guile-lzlib.
* doc/guix.texi ("Requirements"): Remove zlib requirement and add Guile-zlib
and Guile-lzlib instead.
* gnu/packages/package-management.scm (guix)[native-inputs]: Add "guile-zlib"
and "guile-lzlib",
[inputs]: remove "zlib" and "lzlib",
[propagated-inputs]: ditto,
[arguments]: add "guile-zlib" and "guile-lzlib" to Guile load path.
* guix/build/download-nar.scm: Use (zlib) instead of (guix zlib).
* guix/config.scm.in (%libz, %liblz): Remove them.
* guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported
modules list, instead add "guile-zlib" to the extension list.
* guix/git-download.scm (git-fetch): Ditto.
* guix/gnu-maintenance.scm: Use (zlib) instead of (guix zlib).
* guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported
modules list, instead add "guile-zlib" to the extension list.
* guix/lzlib.scm: Remove it.
* guix/man-db.scm: Use (zlib) instead of (guix zlib).
* guix/profiles.scm (manual-database): Do not stub (guix config) in imported
modules list, instead add "guile-zlib" to the extension list.
* guix/scripts/publish.scm: Use (zlib) instead of (guix zlib) and (lzlib)
instead of (guix lzlib),
(string->compression-type, effective-compression): do not check for zlib and
lzlib availability.
* guix/scripts/substitute.scm (%compression-methods): Do not check for lzlib
availability.
* guix/self.scm (specification->package): Add "guile-zlib" and "guile-lzlib"
and remove "zlib" and "lzlib",
(compiled-guix): remove "zlib" and "lzlib" arguments and add guile-zlib and
guile-lzlib to the dependencies, also do not pass "zlib" and "lzlib" to
"make-config.scm" procedure,
(make-config.scm): remove "zlib" and "lzlib" arguments as well as %libz and
%liblz variables.
* guix/utils.scm (lzip-port): Use (lzlib) instead of (guix lzlib) and do not
check for lzlib availability.
* guix/zlib.scm: Remove it.
* m4/guix.m4 (GUIX_LIBZ_LIBDIR, GUIX_LIBLZ_FILE_NAME): Remove them.
* tests/lzlib.scm: Use (zlib) instead of (guix zlib) and (lzlib)
instead of (guix lzlib), and do not check for zlib and lzlib availability.
* tests/publish.scm: Ditto.
* tests/substitute.scm: Do not check for lzlib availability.
* tests/utils.scm: Ditto.
* tests/zlib.scm: Remove it.
---
 Makefile.am                         |   6 +-
 build-aux/build-self.scm            |   8 +-
 configure.ac                        |  33 +-
 doc/guix.texi                       |   3 +-
 gnu/packages/package-management.scm |  13 +-
 guix/build/download-nar.scm         |   2 +-
 guix/config.scm.in                  |   8 -
 guix/cvs-download.scm               |  39 +-
 guix/git-download.scm               |  29 +-
 guix/gnu-maintenance.scm            |   2 +-
 guix/hg-download.scm                |  37 +-
 guix/lzlib.scm                      | 709 ----------------------------
 guix/man-db.scm                     |   2 +-
 guix/profiles.scm                   |  23 +-
 guix/scripts/publish.scm            |  15 +-
 guix/scripts/substitute.scm         |   3 +-
 guix/self.scm                       |  32 +-
 guix/utils.scm                      |   9 +-
 guix/zlib.scm                       | 241 ----------
 m4/guix.m4                          |  26 -
 tests/lzlib.scm                     | 120 -----
 tests/publish.scm                   |  28 +-
 tests/substitute.scm                |   4 +-
 tests/utils.scm                     |   3 +-
 tests/zlib.scm                      |  62 ---
 25 files changed, 100 insertions(+), 1357 deletions(-)
 delete mode 100644 guix/lzlib.scm
 delete mode 100644 guix/zlib.scm
 delete mode 100644 tests/lzlib.scm
 delete mode 100644 tests/zlib.scm

diff --git a/Makefile.am b/Makefile.am
index 1e2c26f5ac..24654db471 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -109,8 +109,6 @@ MODULES =					\
   guix/cache.scm				\
   guix/cve.scm					\
   guix/workers.scm				\
-  guix/zlib.scm					\
-  guix/lzlib.scm				\
   guix/build-system.scm				\
   guix/build-system/android-ndk.scm		\
   guix/build-system/ant.scm			\
@@ -423,7 +421,6 @@ SCM_TESTS =					\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
-  tests/lzlib.scm				\
   tests/modules.scm				\
   tests/monads.scm				\
   tests/nar.scm				\
@@ -462,8 +459,7 @@ SCM_TESTS =					\
   tests/upstream.scm				\
   tests/utils.scm				\
   tests/uuid.scm				\
-  tests/workers.scm				\
-  tests/zlib.scm
+  tests/workers.scm
 
 SH_TESTS =					\
   tests/guix-build.sh				\
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index e2495919d5..4b6e2bfae5 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -71,7 +71,7 @@
                                       (variables rest ...))))))
     (variables %localstatedir %storedir %sysconfdir %system)))
 
-(define* (make-config.scm #:key zlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
@@ -133,11 +133,7 @@
                      (define %bzip2
                        #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                      (define %xz
-                       #+(and xz (file-append xz "/bin/xz")))
-
-                     (define %libz
-                       #+(and zlib
-                              (file-append zlib "/lib/libz")))))))
+                       #+(and xz (file-append xz "/bin/xz")))))))
 
 \f
 ;;;
diff --git a/configure.ac b/configure.ac
index 7675eef7c4..5d549cc3af 100644
--- a/configure.ac
+++ b/configure.ac
@@ -141,6 +141,18 @@ if test "x$guix_cv_have_recent_guile_gcrypt" != "xyes"; then
   AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.])
 fi
 
+dnl Check for Guile-zlib.
+GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)])
+if test "x$have_guile_zlib" != "xyes"; then
+  AC_MSG_ERROR([Guile-zlib is missing; please install it.])
+fi
+
+dnl Check for Guile-lzlib.
+GUILE_MODULE_AVAILABLE([have_guile_lzlib], [(lzlib)])
+if test "x$have_guile_lzlib" != "xyes"; then
+  AC_MSG_ERROR([Guile-lzlib is missing; please install it.])
+fi
+
 dnl Guile-newt is used by the graphical installer.
 GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])
 
@@ -245,27 +257,6 @@ esac
 AC_SUBST([LIBGCRYPT_PREFIX])
 AC_SUBST([LIBGCRYPT_LIBDIR])
 
-dnl Library name of zlib suitable for 'dynamic-link'.
-GUIX_LIBZ_LIBDIR([libz_libdir])
-if test "x$libz_libdir" = "x"; then
-  LIBZ="libz"
-else
-  LIBZ="$libz_libdir/libz"
-fi
-AC_MSG_CHECKING([for zlib's shared library name])
-AC_MSG_RESULT([$LIBZ])
-AC_SUBST([LIBZ])
-
-dnl Library name of lzlib suitable for 'dynamic-link'.
-GUIX_LIBLZ_FILE_NAME([LIBLZ])
-if test "x$LIBLZ" = "x"; then
-  LIBLZ="liblz"
-else
-  # Strip the .so or .so.1 extension since that's what 'dynamic-link' expects.
-  LIBLZ="`echo $LIBLZ | sed -es'/\.so\(\.[[0-9.]]\+\)\?//g'`"
-fi
-AC_SUBST([LIBLZ])
-
 dnl Check for Guile-SSH, for the (guix ssh) module.
 GUIX_CHECK_GUILE_SSH
 AM_CONDITIONAL([HAVE_GUILE_SSH],
diff --git a/doc/guix.texi b/doc/guix.texi
index d4557b360a..502dd7547b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -778,12 +778,13 @@ Guile,, gnutls-guile, GnuTLS-Guile});
 @item
 @uref{https://notabug.org/guile-sqlite3/guile-sqlite3, Guile-SQLite3}, version 0.1.0
 or later;
+@item @uref{https://notabug.org/guile-zlib/guile-zlib, Guile-zlib};
+@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
 @item
 @c FIXME: Specify a version number once a release has been made.
 @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
 2017 or later;
 @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 3.x;
-@item @url{https://zlib.net, zlib};
 @item @url{https://www.gnu.org/software/make/, GNU Make}.
 @end itemize
 
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 277b125809..7c42f842cb 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -278,6 +278,8 @@ $(prefix)/etc/init.d\n")))
                                (gcrypt (assoc-ref inputs "guile-gcrypt"))
                                (json   (assoc-ref inputs "guile-json"))
                                (sqlite (assoc-ref inputs "guile-sqlite3"))
+                               (zlib   (assoc-ref inputs "guile-zlib"))
+                               (lzlib  (assoc-ref inputs "guile-lzlib"))
                                (git    (assoc-ref inputs "guile-git"))
                                (bs     (assoc-ref inputs
                                                   "guile-bytestructures"))
@@ -285,7 +287,7 @@ $(prefix)/etc/init.d\n")))
                                (gnutls (assoc-ref inputs "gnutls"))
                                (locales (assoc-ref inputs "glibc-utf8-locales"))
                                (deps   (list gcrypt json sqlite gnutls
-                                             git bs ssh))
+                                             git bs ssh zlib lzlib))
                                (effective
                                 (read-line
                                  (open-pipe* OPEN_READ
@@ -325,6 +327,8 @@ $(prefix)/etc/init.d\n")))
                        ("guile-gcrypt" ,guile-gcrypt)
                        ("guile-json" ,guile-json-4)
                        ("guile-sqlite3" ,guile-sqlite3)
+                       ("guile-zlib" ,guile-zlib)
+                       ("guile-lzlib" ,guile-lzlib)
                        ("guile-ssh" ,guile-ssh)
                        ("guile-git" ,guile-git)
 
@@ -341,9 +345,6 @@ $(prefix)/etc/init.d\n")))
       (inputs
        `(("bzip2" ,bzip2)
          ("gzip" ,gzip)
-         ("zlib" ,zlib)              ;for 'guix publish'
-         ("lzlib" ,lzlib)            ;for 'guix publish' and 'guix substitute'
-
          ("sqlite" ,sqlite)
          ("libgcrypt" ,libgcrypt)
 
@@ -377,7 +378,9 @@ $(prefix)/etc/init.d\n")))
          ("guile-json" ,guile-json-4)
          ("guile-sqlite3" ,guile-sqlite3)
          ("guile-ssh" ,guile-ssh)
-         ("guile-git" ,guile-git)))
+         ("guile-git" ,guile-git)
+         ("guile-zlib" ,guile-zlib)
+         ("guile-lzlib" ,guile-lzlib)))
 
       (home-page "https://www.gnu.org/software/guix/")
       (synopsis "Functional package manager for installed software packages and versions")
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 377e428341..8f67bc9c9c 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -20,7 +20,7 @@
   #:use-module (guix build download)
   #:use-module (guix build utils)
   #:use-module ((guix serialization) #:hide (dump-port*))
-  #:use-module (guix zlib)
+  #:use-module (zlib)
   #:use-module (guix progress)
   #:use-module (web uri)
   #:use-module (srfi srfi-11)
diff --git a/guix/config.scm.in b/guix/config.scm.in
index 0ada0f3c38..b2901735d8 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -33,8 +33,6 @@
             %config-directory
 
             %system
-            %libz
-            %liblz
             %gzip
             %bzip2
             %xz))
@@ -88,12 +86,6 @@
 (define %system
   "@guix_system@")
 
-(define %libz
-  "@LIBZ@")
-
-(define %liblz
-  "@LIBLZ@")
-
 (define %gzip
   "@GZIP@")
 
diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index cb42103aae..76b3eac739 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <cvs-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build cvs)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build cvs)
+                                     (guix build download-nar)))))
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build cvs)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build cvs)
+                         (guix build download-nar))
 
-          (or (cvs-fetch '#$(cvs-reference-root-directory ref)
-                         '#$(cvs-reference-module ref)
-                         '#$(cvs-reference-revision ref)
-                         #$output
-                         #:cvs-command (string-append #+cvs "/bin/cvs"))
-              (download-nar #$output)))))
+            (or (cvs-fetch '#$(cvs-reference-root-directory ref)
+                           '#$(cvs-reference-module ref)
+                           '#$(cvs-reference-revision ref)
+                           #$output
+                           #:cvs-command (string-append #+cvs "/bin/cvs"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "cvs-checkout") build
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 71ea1031c5..90634a8c4c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -84,35 +84,26 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
           ("tar" ,(module-ref (resolve-interface '(gnu packages base))
                               'tar)))))
 
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
   (define guile-json
     (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
 
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+
   (define gnutls
     (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
 
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
-
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build git)
-                                           (guix build utils)
-                                           (guix build download-nar)
-                                           (guix swh))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build git)
+                                     (guix build utils)
+                                     (guix build download-nar)
+                                     (guix swh)))))
 
   (define build
     (with-imported-modules modules
-      (with-extensions (list guile-json gnutls)   ;for (guix swh)
+      (with-extensions (list guile-json gnutls   ;for (guix swh)
+                             guile-zlib)
         #~(begin
             (use-modules (guix build git)
                          (guix build utils)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index cd7109002b..08b2bcf758 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -36,7 +36,7 @@
   #:use-module (guix records)
   #:use-module (guix upstream)
   #:use-module (guix packages)
-  #:use-module (guix zlib)
+  #:use-module (zlib)
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
diff --git a/guix/hg-download.scm b/guix/hg-download.scm
index 4cdc1a780a..694105ceba 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <hg-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build hg)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build hg)
+                                     (guix build download-nar)))))
 
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build hg)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build hg)
+                         (guix build download-nar))
 
-          (or (hg-fetch '#$(hg-reference-url ref)
-                        '#$(hg-reference-changeset ref)
-                        #$output
-                        #:hg-command (string-append #+hg "/bin/hg"))
-              (download-nar #$output)))))
+            (or (hg-fetch '#$(hg-reference-url ref)
+                          '#$(hg-reference-changeset ref)
+                          #$output
+                          #:hg-command (string-append #+hg "/bin/hg"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "hg-checkout") build
diff --git a/guix/lzlib.scm b/guix/lzlib.scm
deleted file mode 100644
index 2fc326ba34..0000000000
--- a/guix/lzlib.scm
+++ /dev/null
@@ -1,709 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix lzlib)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs arithmetic bitwise)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 match)
-  #:use-module (system foreign)
-  #:use-module (guix config)
-  #:use-module (srfi srfi-11)
-  #:export (lzlib-available?
-            make-lzip-input-port
-            make-lzip-output-port
-            make-lzip-input-port/compressed
-            call-with-lzip-input-port
-            call-with-lzip-output-port
-            %default-member-length-limit
-            %default-compression-level
-            dictionary-size+match-length-limit))
-
-;;; Commentary:
-;;;
-;;; Bindings to the lzlib / liblz API.  Some convenience functions are also
-;;; provided (see the export).
-;;;
-;;; While the bindings are complete, the convenience functions only support
-;;; single member archives.  To decompress single member archives, we loop
-;;; until lz-decompress-read returns 0.  This is simpler.  To support multiple
-;;; members properly, we need (among others) to call lz-decompress-finish and
-;;; loop over lz-decompress-read until lz-decompress-finished? returns #t.
-;;; Otherwise a multi-member archive starting with an empty member would only
-;;; decompress the empty member and stop there, resulting in truncated output.
-
-;;; Code:
-
-(define %lzlib
-  ;; File name of lzlib's shared library.  When updating via 'guix pull',
-  ;; '%liblz' might be undefined so protect against it.
-  (delay (dynamic-link (if (defined? '%liblz)
-                           %liblz
-                           "liblz"))))
-
-(define (lzlib-available?)
-  "Return true if lzlib is available, #f otherwise."
-  (false-if-exception (force %lzlib)))
-
-(define (lzlib-procedure ret name parameters)
-  "Return a procedure corresponding to C function NAME in liblz, or #f if
-either lzlib or the function could not be found."
-  (match (false-if-exception (dynamic-func name (force %lzlib)))
-    ((? pointer? ptr)
-     (pointer->procedure ret ptr parameters))
-    (#f
-     #f)))
-
-(define-wrapped-pointer-type <lz-decoder>
-  ;; Scheme counterpart of the 'LZ_Decoder' opaque type.
-  lz-decoder?
-  pointer->lz-decoder
-  lz-decoder->pointer
-  (lambda (obj port)
-    (format port "#<lz-decoder ~a>"
-            (number->string (object-address obj) 16))))
-
-(define-wrapped-pointer-type <lz-encoder>
-  ;; Scheme counterpart of the 'LZ_Encoder' opaque type.
-  lz-encoder?
-  pointer->lz-encoder
-  lz-encoder->pointer
-  (lambda (obj port)
-    (format port "#<lz-encoder ~a>"
-            (number->string (object-address obj) 16))))
-
-;; From lzlib.h
-(define %error-number-ok 0)
-(define %error-number-bad-argument 1)
-(define %error-number-mem-error 2)
-(define %error-number-sequence-error 3)
-(define %error-number-header-error 4)
-(define %error-number-unexpected-eof 5)
-(define %error-number-data-error 6)
-(define %error-number-library-error 7)
-
-\f
-;; Compression bindings.
-
-(define lz-compress-open
-  (let ((proc (lzlib-procedure '* "LZ_compress_open" (list int int uint64)))
-        ;; member-size is an "unsigned long long", and the C standard guarantees
-        ;; a minimum range of 0..2^64-1.
-        (unlimited-size (- (expt 2 64) 1)))
-    (lambda* (dictionary-size match-length-limit #:optional (member-size unlimited-size))
-      "Initialize the internal stream state for compression and returns a
-pointer that can only be used as the encoder argument for the other
-lz-compress functions, or a null pointer if the encoder could not be
-allocated.
-
-See the manual: (lzlib) Compression functions."
-      (let ((encoder-ptr (proc dictionary-size match-length-limit member-size)))
-        (if (not (= (lz-compress-error encoder-ptr) -1))
-            (pointer->lz-encoder encoder-ptr)
-            (throw 'lzlib-error 'lz-compress-open))))))
-
-(define lz-compress-close
-  (let ((proc (lzlib-procedure int "LZ_compress_close" '(*))))
-    (lambda (encoder)
-      "Close encoder.  ENCODER can no longer be used as an argument to any
-lz-compress function. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-close ret)
-            ret)))))
-
-(define lz-compress-finish
-  (let ((proc (lzlib-procedure int "LZ_compress_finish" '(*))))
-    (lambda (encoder)
-      "Tell that all the data for this member have already been written (with
-the `lz-compress-write' function).  It is safe to call `lz-compress-finish' as
-many times as needed.  After all the produced compressed data have been read
-with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a new
-member can be started with 'lz-compress-restart-member'."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-finish (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-restart-member
-  (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* uint64))))
-    (lambda (encoder member-size)
-      "Start a new member in a multimember data stream.
-Call this function only after `lz-compress-member-finished?' indicates that the
-current member has been fully read (with the `lz-compress-read' function)."
-      (let ((ret (proc (lz-encoder->pointer encoder) member-size)))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-restart-member
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-sync-flush
-  (let ((proc (lzlib-procedure int "LZ_compress_sync_flush" (list '*))))
-    (lambda (encoder)
-      "Make available to `lz-compress-read' all the data already written with
-the `LZ-compress-write' function.  First call `lz-compress-sync-flush'.  Then
-call 'lz-compress-read' until it returns 0.
-
-Repeated use of `LZ-compress-sync-flush' may degrade compression ratio,
-so use it only when needed. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-sync-flush
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-read
-  (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int))))
-    (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv)))
-      "Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV.
-Return the number of uncompressed bytes written, a positive integer."
-      (let ((ret (proc (lz-encoder->pointer encoder)
-                       (bytevector->pointer lzfile-bv start)
-                       count)))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-read (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-write
-  (let ((proc (lzlib-procedure int "LZ_compress_write" (list '* '* int))))
-    (lambda* (encoder bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV to the encoder stream.  Return the
-number of uncompressed bytes written, a strictly positive integer."
-      (let ((ret (proc (lz-encoder->pointer encoder)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-compress-write (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-write-size
-  (let ((proc (lzlib-procedure int "LZ_compress_write_size" '(*))))
-    (lambda (encoder)
-      "The maximum number of bytes that can be immediately written through the
-`lz-compress-write' function.
-
-It is guaranteed that an immediate call to `lz-compress-write' will accept a
-SIZE up to the returned number of bytes. "
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-write-size (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-error
-  (let ((proc (lzlib-procedure int "LZ_compress_errno" '(*))))
-    (lambda (encoder)
-      "ENCODER can be a Scheme object or a pointer."
-      (let* ((error-number (proc (if (lz-encoder? encoder)
-                                     (lz-encoder->pointer encoder)
-                                     encoder))))
-        error-number))))
-
-(define lz-compress-finished?
-  (let ((proc (lzlib-procedure int "LZ_compress_finished" '(*))))
-    (lambda (encoder)
-      "Return #t if all the data have been read and `lz-compress-close' can
-be safely called. Otherwise return #f."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-compress-finished? (lz-compress-error encoder))))))))
-
-(define lz-compress-member-finished?
-  (let ((proc (lzlib-procedure int "LZ_compress_member_finished" '(*))))
-    (lambda (encoder)
-      "Return #t if the current member, in a multimember data stream, has
-been fully read and 'lz-compress-restart-member' can be safely called.
-Otherwise return #f."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-compress-member-finished? (lz-compress-error encoder))))))))
-
-(define lz-compress-data-position
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_data_position" '(*))))
-    (lambda (encoder)
-      "Return the number of input bytes already compressed in the current
-member."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-data-position
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-member-position
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_member_position" '(*))))
-    (lambda (encoder)
-      "Return the number of compressed bytes already produced, but perhaps
-not yet read, in the current member."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-member-position
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-total-in-size
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_total_in_size" '(*))))
-    (lambda (encoder)
-      "Return the total number of input bytes already compressed."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-total-in-size
-                   (lz-compress-error encoder))
-            ret)))))
-
-(define lz-compress-total-out-size
-  (let ((proc (lzlib-procedure uint64 "LZ_compress_total_out_size" '(*))))
-    (lambda (encoder)
-      "Return the total number of compressed bytes already produced, but
-perhaps not yet read."
-      (let ((ret (proc (lz-encoder->pointer encoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-compress-total-out-size
-                   (lz-compress-error encoder))
-            ret)))))
-
-\f
-;; Decompression bindings.
-
-(define lz-decompress-open
-  (let ((proc (lzlib-procedure '* "LZ_decompress_open" '())))
-    (lambda ()
-      "Initializes the internal stream state for decompression and returns a
-pointer that can only be used as the decoder argument for the other
-lz-decompress functions, or a null pointer if the decoder could not be
-allocated.
-
-See the manual: (lzlib) Decompression functions."
-      (let ((decoder-ptr (proc)))
-        (if (not (= (lz-decompress-error decoder-ptr) -1))
-            (pointer->lz-decoder decoder-ptr)
-            (throw 'lzlib-error 'lz-decompress-open))))))
-
-(define lz-decompress-close
-  (let ((proc (lzlib-procedure int "LZ_decompress_close" '(*))))
-    (lambda (decoder)
-      "Close decoder.  DECODER can no longer be used as an argument to any
-lz-decompress function. "
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-close ret)
-            ret)))))
-
-(define lz-decompress-finish
-  (let ((proc (lzlib-procedure int "LZ_decompress_finish" '(*))))
-    (lambda (decoder)
-      "Tell that all the data for this stream have already been written (with
-the `lz-decompress-write' function).  It is safe to call
-`lz-decompress-finish' as many times as needed."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-finish (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-reset
-  (let ((proc (lzlib-procedure int "LZ_decompress_reset" '(*))))
-    (lambda (decoder)
-      "Reset the internal state of DECODER as it was just after opening it
-with the `lz-decompress-open' function.  Data stored in the internal buffers
-is discarded.  Position counters are set to 0."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-reset
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-sync-to-member
-  (let ((proc (lzlib-procedure int "LZ_decompress_sync_to_member" '(*))))
-    (lambda (decoder)
-      "Reset the error state of DECODER and enters a search state that lasts
-until a new member header (or the end of the stream) is found.  After a
-successful call to `lz-decompress-sync-to-member', data written with
-`lz-decompress-write' will be consumed and 'lz-decompress-read' will return 0
-until a header is found.
-
-This function is useful to discard any data preceding the first member, or to
-discard the rest of the current member, for example in case of a data
-error.  If the decoder is already at the beginning of a member, this function
-does nothing."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-sync-to-member
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-read
-  (let ((proc (lzlib-procedure int "LZ_decompress_read" (list '* '* int))))
-    (lambda* (decoder file-bv #:optional (start 0) (count (bytevector-length file-bv)))
-      "Read up to COUNT bytes from the decoder stream, storing the results in FILE-BV.
-Return the number of uncompressed bytes written, a non-negative positive integer."
-      (let ((ret (proc (lz-decoder->pointer decoder)
-                       (bytevector->pointer file-bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-decompress-read (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-write
-  (let ((proc (lzlib-procedure int "LZ_decompress_write" (list '* '* int))))
-    (lambda* (decoder bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV to the decoder stream.  Return the
-number of uncompressed bytes written, a non-negative integer."
-      (let ((ret (proc (lz-decoder->pointer decoder)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'lzlib-error 'lz-decompress-write (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-write-size
-  (let ((proc (lzlib-procedure int "LZ_decompress_write_size" '(*))))
-    (lambda (decoder)
-      "Return the maximum number of bytes that can be immediately written
-through the `lz-decompress-write' function.
-
-It is guaranteed that an immediate call to `lz-decompress-write' will accept a
-SIZE up to the returned number of bytes. "
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-error
-  (let ((proc (lzlib-procedure int "LZ_decompress_errno" '(*))))
-    (lambda (decoder)
-      "DECODER can be a Scheme object or a pointer."
-      (let* ((error-number (proc (if (lz-decoder? decoder)
-                                     (lz-decoder->pointer decoder)
-                                     decoder))))
-        error-number))))
-
-(define lz-decompress-finished?
-  (let ((proc (lzlib-procedure int "LZ_decompress_finished" '(*))))
-    (lambda (decoder)
-      "Return #t if all the data have been read and `lz-decompress-close' can
-be safely called.  Otherwise return #f."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-decompress-finished? (lz-decompress-error decoder))))))))
-
-(define lz-decompress-member-finished?
-  (let ((proc (lzlib-procedure int "LZ_decompress_member_finished" '(*))))
-    (lambda (decoder)
-      "Return #t if the current member, in a multimember data stream, has
-been fully read and `lz-decompress-restart-member' can be safely called.
-Otherwise return #f."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (match ret
-          (1 #t)
-          (0 #f)
-          (_ (throw 'lzlib-error 'lz-decompress-member-finished? (lz-decompress-error decoder))))))))
-
-(define lz-decompress-member-version
-  (let ((proc (lzlib-procedure int "LZ_decompress_member_version" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the version of current member from member header."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-data-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-dictionary-size
-  (let ((proc (lzlib-procedure int "LZ_decompress_dictionary_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the dictionary size of current member from member header."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-data-crc
-  (let ((proc (lzlib-procedure unsigned-int "LZ_decompress_data_crc" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the 32 bit Cyclic Redundancy Check of the data decompressed
-from the current member.  The returned value is valid only when
-`lz-decompress-member-finished' returns #t. "
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-data-position
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_data_position" '(*))))
-    (lambda (decoder)
-      "Return the number of decompressed bytes already produced, but perhaps
-not yet read, in the current member."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-data-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-member-position
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_member_position" '(*))))
-    (lambda (decoder)
-      "Return the number of input bytes already decompressed in the current
-member."
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-member-position
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-total-in-size
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_in_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the total number of input bytes already compressed."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-total-in-size
-                   (lz-decompress-error decoder))
-            ret)))))
-
-(define lz-decompress-total-out-size
-  (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_out_size" '(*))))
-    (lambda (decoder)
-      (let ((ret (proc (lz-decoder->pointer decoder))))
-        "Return the total number of compressed bytes already produced, but
-perhaps not yet read."
-        (if (= ret -1)
-            (throw 'lzlib-error 'lz-decompress-total-out-size
-                   (lz-decompress-error decoder))
-            ret)))))
-
-\f
-;; High level functions.
-
-(define* (lzread! decoder port bv
-                  #:optional (start 0) (count (bytevector-length bv)))
-  "Read up to COUNT bytes from PORT into BV at offset START.  Return the
-number of uncompressed bytes actually read; it is zero if COUNT is zero or if
-the end-of-stream has been reached."
-  (define (feed-decoder! decoder)
-    ;; Feed DECODER with data read from PORT.
-    (match (get-bytevector-n port (lz-decompress-write-size decoder))
-      ((? eof-object? eof) eof)
-      (bv (lz-decompress-write decoder bv))))
-
-  (let loop ((read 0)
-             (start start))
-    (cond ((< read count)
-           (match (lz-decompress-read decoder bv start (- count read))
-             (0 (cond ((lz-decompress-finished? decoder)
-                       read)
-                      ((eof-object? (feed-decoder! decoder))
-                       (lz-decompress-finish decoder)
-                       (loop read start))
-                      (else                       ;read again
-                       (loop read start))))
-             (n (loop (+ read n) (+ start n)))))
-          (else
-           read))))
-
-(define (lzwrite! encoder source source-offset source-count
-                  target target-offset target-count)
-  "Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to
-TARGET-COUNT bytes into TARGET at TARGET-OFFSET.  Return two values: the
-number of bytes read from SOURCE, and the number of bytes written to TARGET,
-possibly zero."
-  (define read
-    (if (> (lz-compress-write-size encoder) 0)
-        (match (lz-compress-write encoder source source-offset source-count)
-          (0 (lz-compress-finish encoder) 0)
-          (n n))
-        0))
-
-  (define written
-    (lz-compress-read encoder target target-offset target-count))
-
-  (values read written))
-
-(define* (lzwrite encoder bv lz-port
-                  #:optional (start 0) (count (bytevector-length bv)))
-  "Write up to COUNT bytes from BV at offset START into LZ-PORT.  Return
-the number of uncompressed bytes written, a non-negative integer."
-  (let ((written 0)
-        (read 0))
-    (while (and (< 0 (lz-compress-write-size encoder))
-                (< written count))
-      (set! written (+ written
-                       (lz-compress-write encoder bv (+ start written) (- count written)))))
-    (when (= written 0)
-      (lz-compress-finish encoder))
-    (let ((lz-bv (make-bytevector written)))
-      (let loop ((rd 0))
-        (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv)))
-        (put-bytevector lz-port lz-bv 0 rd)
-        (set! read (+ read rd))
-        (unless (= rd 0)
-          (loop rd))))
-    ;; `written' is the total byte count of uncompressed data.
-    written))
-
-\f
-;;;
-;;; Port interface.
-;;;
-
-;; Alist of (levels (dictionary-size match-length-limit)).  0 is the fastest.
-;; See bbexample.c in lzlib's source.
-(define %compression-levels
-  `((0 65535 16)
-    (1 ,(bitwise-arithmetic-shift-left 1 20) 5)
-    (2 ,(bitwise-arithmetic-shift-left 3 19) 6)
-    (3 ,(bitwise-arithmetic-shift-left 1 21) 8)
-    (4 ,(bitwise-arithmetic-shift-left 3 20) 12)
-    (5 ,(bitwise-arithmetic-shift-left 1 22) 20)
-    (6 ,(bitwise-arithmetic-shift-left 1 23) 36)
-    (7 ,(bitwise-arithmetic-shift-left 1 24) 68)
-    (8 ,(bitwise-arithmetic-shift-left 3 23) 132)
-    (9 ,(bitwise-arithmetic-shift-left 1 25) 273)))
-
-(define %default-compression-level
-  6)
-
-(define (dictionary-size+match-length-limit level)
-  "Return two values: the dictionary size for LEVEL, and its match-length
-limit.  LEVEL must be a compression level, an integer between 0 and 9."
-  (match (assv-ref %compression-levels level)
-    ((dictionary-size match-length-limit)
-     (values dictionary-size match-length-limit))))
-
-(define* (make-lzip-input-port port)
-  "Return an input port that decompresses data read from PORT, a file port.
-PORT is automatically closed when the resulting port is closed."
-  (define decoder (lz-decompress-open))
-
-  (define (read! bv start count)
-    (lzread! decoder port bv start count))
-
-  (make-custom-binary-input-port "lzip-input" read! #f #f
-                                 (lambda ()
-                                   (lz-decompress-close decoder)
-                                   (close-port port))))
-
-(define* (make-lzip-output-port port
-                                #:key
-                                (level %default-compression-level))
-  "Return an output port that compresses data at the given LEVEL, using PORT,
-a file port, as its sink.  PORT is automatically closed when the resulting
-port is closed."
-  (define encoder
-    (call-with-values (lambda () (dictionary-size+match-length-limit level))
-      lz-compress-open))
-
-  (define (write! bv start count)
-    (lzwrite encoder bv port start count))
-
-  (make-custom-binary-output-port "lzip-output" write! #f #f
-                                  (lambda ()
-                                    (lz-compress-finish encoder)
-                                    ;; "lz-read" the trailing metadata added by `lz-compress-finish'.
-                                    (let ((lz-bv (make-bytevector (* 64 1024))))
-                                      (let loop ((rd 0))
-                                        (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv)))
-                                        (put-bytevector port lz-bv 0 rd)
-                                        (unless (= rd 0)
-                                          (loop rd))))
-                                    (lz-compress-close encoder)
-                                    (close-port port))))
-
-(define* (make-lzip-input-port/compressed port
-                                          #:key
-                                          (level %default-compression-level))
-  "Return an input port that compresses data read from PORT, with the given LEVEL.
-PORT is automatically closed when the resulting port is closed."
-  (define encoder
-    (call-with-values (lambda () (dictionary-size+match-length-limit level))
-      lz-compress-open))
-
-  (define input-buffer (make-bytevector 8192))
-  (define input-len 0)
-  (define input-offset 0)
-
-  (define input-eof? #f)
-
-  (define (read! bv start count)
-    (cond
-     (input-eof?
-      (match (lz-compress-read encoder bv start count)
-        (0 (if (lz-compress-finished? encoder)
-               0
-               (read! bv start count)))
-        (n n)))
-     ((= input-offset input-len)
-      (match (get-bytevector-n! port input-buffer 0
-                                (bytevector-length input-buffer))
-        ((? eof-object?)
-         (set! input-eof? #t)
-         (lz-compress-finish encoder))
-        (count
-         (set! input-offset 0)
-         (set! input-len count)))
-      (read! bv start count))
-     (else
-      (let-values (((read written)
-                    (lzwrite! encoder
-                              input-buffer input-offset
-                              (- input-len input-offset)
-                              bv start count)))
-        (set! input-offset (+ input-offset read))
-
-        ;; Make sure we don't return zero except on EOF.
-        (if (= 0 written)
-            (read! bv start count)
-            written)))))
-
-  (make-custom-binary-input-port "lzip-input/compressed"
-                                 read! #f #f
-                                 (lambda ()
-                                   (close-port port))))
-
-(define* (call-with-lzip-input-port port proc)
-  "Call PROC with a port that wraps PORT and decompresses data read from it.
-PORT is closed upon completion."
-  (let ((lzip (make-lzip-input-port port)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc lzip))
-      (lambda ()
-        (close-port lzip)))))
-
-(define* (call-with-lzip-output-port port proc
-                                     #:key
-                                     (level %default-compression-level))
-  "Call PROC with an output port that wraps PORT and compresses data.  PORT is
-close upon completion."
-  (let ((lzip (make-lzip-output-port port
-                                     #:level level)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc lzip))
-      (lambda ()
-        (close-port lzip)))))
-
-;;; lzlib.scm ends here
diff --git a/guix/man-db.scm b/guix/man-db.scm
index 4cef874f8b..a6528e4431 100644
--- a/guix/man-db.scm
+++ b/guix/man-db.scm
@@ -17,7 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix man-db)
-  #:use-module (guix zlib)
+  #:use-module (zlib)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (gdbm)                             ;gdbm-ffi
   #:use-module (srfi srfi-9)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0619e735fb..6b2344270e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1412,27 +1412,18 @@ the entries in MANIFEST."
     (module-ref (resolve-interface '(gnu packages guile))
                 'guile-gdbm-ffi))
 
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module #$'(guix config) ;placate Geiser
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure `((guix build utils)
-                                           (guix man-db))))))
+    (delete '(guix config)
+            (source-module-closure `((guix build utils)
+                                     (guix man-db)))))
 
   (define build
     (with-imported-modules modules
-      (with-extensions (list gdbm-ffi)            ;for (guix man-db)
+      (with-extensions (list gdbm-ffi           ;for (guix man-db)
+                             guile-zlib)
         #~(begin
             (use-modules (guix man-db)
                          (guix build utils)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a00f08f9d9..61542f83a0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -50,10 +50,9 @@
   #:use-module (guix workers)
   #:use-module (guix store)
   #:use-module ((guix serialization) #:select (write-file))
-  #:use-module (guix zlib)
-  #:autoload   (guix lzlib) (lzlib-available?
-                             call-with-lzip-output-port
-                             make-lzip-output-port)
+  #:use-module (zlib)
+  #:autoload   (lzlib) (call-with-lzip-output-port
+                        make-lzip-output-port)
   #:use-module (guix cache)
   #:use-module (guix ui)
   #:use-module (guix scripts)
@@ -880,8 +879,8 @@ blocking."
   "Return a symbol denoting the compression method expressed by STRING; return
 #f if STRING doesn't match any supported method."
   (match string
-    ("gzip" (and (zlib-available?) 'gzip))
-    ("lzip" (and (lzlib-available?) 'lzip))
+    ("gzip" 'gzip)
+    ("lzip" 'lzip)
     (_      #f)))
 
 (define (effective-compression requested-type compressions)
@@ -1032,9 +1031,7 @@ methods, return the applicable compression."
                                             opts)
                            (()
                             ;; Default to fast & low compression.
-                            (list (if (zlib-available?)
-                                      %default-gzip-compression
-                                      %no-compression)))
+                            (list %default-gzip-compression))
                            (lst (reverse lst))))
            (address (let ((addr (assoc-ref opts 'address)))
                       (make-socket-address (sockaddr:fam addr)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index ba2b2d2d4e..f9d19fd735 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -41,7 +41,6 @@
   #:use-module (guix progress)
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
-  #:autoload   (guix lzlib) (lzlib-available?)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
@@ -912,7 +911,7 @@ authorized substitutes."
   ;; Known compression methods and a thunk to determine whether they're
   ;; supported.  See 'decompressed-port' in (guix utils).
   `(("gzip"  . ,(const #t))
-    ("lzip"  . ,lzlib-available?)
+    ("lzip"  . ,(const #t))
     ("xz"    . ,(const #t))
     ("bzip2" . ,(const #t))
     ("none"  . ,(const #t))))
diff --git a/guix/self.scm b/guix/self.scm
index f70b1ecdd8..6a1640acdf 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -53,10 +53,10 @@
       ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
       ("guile-git"  (ref '(gnu packages guile) 'guile-git))
       ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+      ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
+      ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'guile3.0-gnutls))
-      ("zlib"       (ref '(gnu packages compression) 'zlib))
-      ("lzlib"      (ref '(gnu packages compression) 'lzlib))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
@@ -727,8 +727,6 @@ Info manual."
                         (name (string-append "guix-" version))
                         (guile-version (effective-version))
                         (guile-for-build (default-guile))
-                        (zlib (specification->package "zlib"))
-                        (lzlib (specification->package "lzlib"))
                         (gzip (specification->package "gzip"))
                         (bzip2 (specification->package "bzip2"))
                         (xz (specification->package "xz"))
@@ -746,6 +744,12 @@ Info manual."
   (define guile-sqlite3
     (specification->package "guile-sqlite3"))
 
+  (define guile-zlib
+    (specification->package "guile-zlib"))
+
+  (define guile-lzlib
+    (specification->package "guile-lzlib"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
@@ -757,7 +761,7 @@ Info manual."
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
                        (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3))
+                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
@@ -884,9 +888,7 @@ Info manual."
                  '()
                  #:extra-modules
                  `(((guix config)
-                    => ,(make-config.scm #:zlib zlib
-                                         #:lzlib lzlib
-                                         #:gzip gzip
+                    => ,(make-config.scm #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
                                          #:package-name
@@ -983,7 +985,7 @@ Info manual."
                                       (variables rest ...))))))
     (variables %localstatedir %storedir %sysconfdir)))
 
-(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
@@ -1004,8 +1006,6 @@ Info manual."
                                %state-directory
                                %store-database-directory
                                %config-directory
-                               %libz
-                               %liblz
                                %gzip
                                %bzip2
                                %xz))
@@ -1048,15 +1048,7 @@ Info manual."
                    (define %bzip2
                      #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                    (define %xz
-                     #+(and xz (file-append xz "/bin/xz")))
-
-                   (define %libz
-                     #+(and zlib
-                            (file-append zlib "/lib/libz")))
-
-                   (define %liblz
-                     #+(and lzlib
-                            (file-append lzlib "/lib/liblz"))))
+                     #+(and xz (file-append xz "/bin/xz"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are
diff --git a/guix/utils.scm b/guix/utils.scm
index 436c5cd093..1eb42944a9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -206,13 +206,8 @@ buffered data is lost."
 (define (lzip-port proc port . args)
   "Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
 Raise an error if lzlib support is missing."
-  (let* ((lzlib       (false-if-exception (resolve-interface '(guix lzlib))))
-         (supported?  (and lzlib
-                           ((module-ref lzlib 'lzlib-available?)))))
-    (if supported?
-        (let ((make-port (module-ref lzlib proc)))
-          (values (make-port port) '()))
-        (error "lzip compression not supported" lzlib))))
+  (let ((make-port (module-ref (resolve-interface '(lzlib)) proc)))
+    (values (make-port port) '())))
 
 (define (decompressed-port compression input)
   "Return an input port where INPUT is decompressed according to COMPRESSION,
diff --git a/guix/zlib.scm b/guix/zlib.scm
deleted file mode 100644
index 3bd0ad86c9..0000000000
--- a/guix/zlib.scm
+++ /dev/null
@@ -1,241 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix zlib)
-  #:use-module (rnrs bytevectors)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 match)
-  #:use-module (system foreign)
-  #:use-module (guix config)
-  #:export (zlib-available?
-            make-gzip-input-port
-            make-gzip-output-port
-            call-with-gzip-input-port
-            call-with-gzip-output-port
-            %default-buffer-size
-            %default-compression-level))
-
-;;; Commentary:
-;;;
-;;; Bindings to the gzip-related part of zlib's API.  The main limitation of
-;;; this API is that it requires a file descriptor as the source or sink.
-;;;
-;;; Code:
-
-(define %zlib
-  ;; File name of zlib's shared library.  When updating via 'guix pull',
-  ;; '%libz' might be undefined so protect against it.
-  (delay (dynamic-link (if (defined? '%libz)
-                           %libz
-                           "libz"))))
-
-(define (zlib-available?)
-  "Return true if zlib is available, #f otherwise."
-  (false-if-exception (force %zlib)))
-
-(define (zlib-procedure ret name parameters)
-  "Return a procedure corresponding to C function NAME in libz, or #f if
-either zlib or the function could not be found."
-  (match (false-if-exception (dynamic-func name (force %zlib)))
-    ((? pointer? ptr)
-     (pointer->procedure ret ptr parameters))
-    (#f
-     #f)))
-
-(define-wrapped-pointer-type <gzip-file>
-  ;; Scheme counterpart of the 'gzFile' opaque type.
-  gzip-file?
-  pointer->gzip-file
-  gzip-file->pointer
-  (lambda (obj port)
-    (format port "#<gzip-file ~a>"
-            (number->string (object-address obj) 16))))
-
-(define gzerror
-  (let ((proc (zlib-procedure '* "gzerror" '(* *))))
-    (lambda (gzfile)
-      (let* ((errnum* (make-bytevector (sizeof int)))
-             (ptr     (proc (gzip-file->pointer gzfile)
-                            (bytevector->pointer errnum*))))
-        (values (bytevector-sint-ref errnum* 0
-                                     (native-endianness) (sizeof int))
-                (pointer->string ptr))))))
-
-(define gzdopen
-  (let ((proc (zlib-procedure '* "gzdopen" (list int '*))))
-    (lambda (fd mode)
-      "Open file descriptor FD as a gzip stream with the given MODE.  MODE must
-be a string denoting the how FD is to be opened, such as \"r\" for reading or
-\"w9\" for writing data compressed at level 9 to FD.  Calling 'gzclose' also
-closes FD."
-      (let ((result (proc fd (string->pointer mode))))
-        (if (null-pointer? result)
-            (throw 'zlib-error 'gzdopen)
-            (pointer->gzip-file result))))))
-
-(define gzread!
-  (let ((proc (zlib-procedure int "gzread" (list '* '* unsigned-int))))
-    (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)))
-      "Read up to COUNT bytes from GZFILE into BV at offset START.  Return the
-number of uncompressed bytes actually read; it is zero if COUNT is zero or if
-the end-of-stream has been reached."
-      (let ((ret (proc (gzip-file->pointer gzfile)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (< ret 0)
-            (throw 'zlib-error 'gzread! ret)
-            ret)))))
-
-(define gzwrite
-  (let ((proc (zlib-procedure int "gzwrite" (list '* '* unsigned-int))))
-    (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)))
-      "Write up to COUNT bytes from BV at offset START into GZFILE.  Return
-the number of uncompressed bytes written, a strictly positive integer."
-      (let ((ret (proc (gzip-file->pointer gzfile)
-                       (bytevector->pointer bv start)
-                       count)))
-        (if (<= ret 0)
-            (throw 'zlib-error 'gzwrite ret)
-            ret)))))
-
-(define gzbuffer!
-  (let ((proc (zlib-procedure int "gzbuffer" (list '* unsigned-int))))
-    (lambda (gzfile size)
-      "Change the internal buffer size of GZFILE to SIZE bytes."
-      (let ((ret (proc (gzip-file->pointer gzfile) size)))
-        (unless (zero? ret)
-          (throw 'zlib-error 'gzbuffer! ret))))))
-
-(define gzeof?
-  (let ((proc (zlib-procedure int "gzeof" '(*))))
-    (lambda (gzfile)
-      "Return true if the end-of-file has been reached on GZFILE."
-      (not (zero? (proc (gzip-file->pointer gzfile)))))))
-
-(define gzclose
-  (let ((proc (zlib-procedure int "gzclose" '(*))))
-    (lambda (gzfile)
-      "Close GZFILE."
-      (let ((ret (proc (gzip-file->pointer gzfile))))
-        (unless (zero? ret)
-          (throw 'zlib-error 'gzclose ret (gzerror gzfile)))))))
-
-
-\f
-;;;
-;;; Port interface.
-;;;
-
-(define %default-buffer-size
-  ;; Default buffer size, as documented in <zlib.h>.
-  8192)
-
-(define %default-compression-level
-  ;; Z_DEFAULT_COMPRESSION.
-  -1)
-
-(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
-  "Return an input port that decompresses data read from PORT, a file port.
-PORT is automatically closed when the resulting port is closed.  BUFFER-SIZE
-is the size in bytes of the internal buffer, 8 KiB by default; using a larger
-buffer increases decompression speed.  An error is thrown if PORT contains
-buffered input, which would be lost (and is lost anyway)."
-  (define gzfile
-    (match (drain-input port)
-      (""                                         ;PORT's buffer is empty
-       ;; 'gzclose' will eventually close the file descriptor beneath PORT.
-       ;; 'close-port' on PORT would get EBADF if 'gzclose' already closed it,
-       ;; so that's no good; revealed ports are no good either because they
-       ;; leak (see <https://bugs.gnu.org/28784>); calling 'close-port' after
-       ;; 'gzclose' doesn't work either because it leads to a race condition
-       ;; (see <https://bugs.gnu.org/29335>).  So we dup and close PORT right
-       ;; away.
-       (gzdopen (dup (fileno port)) "r"))
-      (_
-       ;; This is unrecoverable but it's better than having the buffered input
-       ;; be lost, leading to unclear end-of-file or corrupt-data errors down
-       ;; the path.
-       (throw 'zlib-error 'make-gzip-input-port
-              "port contains buffered input" port))))
-
-  (define (read! bv start count)
-    (gzread! gzfile bv start count))
-
-  (unless (= buffer-size %default-buffer-size)
-    (gzbuffer! gzfile buffer-size))
-
-  (close-port port)                               ;we no longer need it
-  (make-custom-binary-input-port "gzip-input" read! #f #f
-                                 (lambda ()
-                                   (gzclose gzfile))))
-
-(define* (make-gzip-output-port port
-                                #:key
-                                (level %default-compression-level)
-                                (buffer-size %default-buffer-size))
-  "Return an output port that compresses data at the given LEVEL, using PORT,
-a file port, as its sink.  PORT is automatically closed when the resulting
-port is closed."
-  (define gzfile
-    (begin
-      (force-output port)                         ;empty PORT's buffer
-      (gzdopen (dup (fileno port))
-               (string-append "w" (number->string level)))))
-
-  (define (write! bv start count)
-    (gzwrite gzfile bv start count))
-
-  (unless (= buffer-size %default-buffer-size)
-    (gzbuffer! gzfile buffer-size))
-
-  (close-port port)
-  (make-custom-binary-output-port "gzip-output" write! #f #f
-                                  (lambda ()
-                                    (gzclose gzfile))))
-
-(define* (call-with-gzip-input-port port proc
-                                    #:key (buffer-size %default-buffer-size))
-  "Call PROC with a port that wraps PORT and decompresses data read from it.
-PORT is closed upon completion.  The gzip internal buffer size is set to
-BUFFER-SIZE bytes."
-  (let ((gzip (make-gzip-input-port port #:buffer-size buffer-size)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc gzip))
-      (lambda ()
-        (close-port gzip)))))
-
-(define* (call-with-gzip-output-port port proc
-                                     #:key
-                                     (level %default-compression-level)
-                                     (buffer-size %default-buffer-size))
-  "Call PROC with an output port that wraps PORT and compresses data.  PORT is
-close upon completion.  The gzip internal buffer size is set to BUFFER-SIZE
-bytes."
-  (let ((gzip (make-gzip-output-port port
-                                     #:level level
-                                     #:buffer-size buffer-size)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc gzip))
-      (lambda ()
-        (close-port gzip)))))
-
-;;; zlib.scm ends here
diff --git a/m4/guix.m4 b/m4/guix.m4
index cce03045db..b7bf74ccc8 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -342,32 +342,6 @@ AC_DEFUN([GUIX_LIBGCRYPT_LIBDIR], [
   $1="$guix_cv_libgcrypt_libdir"
 ])
 
-dnl GUIX_LIBZ_LIBDIR VAR
-dnl
-dnl Attempt to determine libz's LIBDIR; store the result in VAR.
-AC_DEFUN([GUIX_LIBZ_LIBDIR], [
-  AC_REQUIRE([PKG_PROG_PKG_CONFIG])
-  AC_CACHE_CHECK([zlib's library directory],
-    [guix_cv_libz_libdir],
-    [guix_cv_libz_libdir="`$PKG_CONFIG zlib --variable=libdir 2> /dev/null`"])
-  $1="$guix_cv_libz_libdir"
-])
-
-dnl GUIX_LIBLZ_FILE_NAME VAR
-dnl
-dnl Attempt to determine liblz's absolute file name; store the result in VAR.
-AC_DEFUN([GUIX_LIBLZ_FILE_NAME], [
-  AC_REQUIRE([PKG_PROG_PKG_CONFIG])
-  AC_CACHE_CHECK([lzlib's file name],
-    [guix_cv_liblz_libdir],
-    [old_LIBS="$LIBS"
-     LIBS="-llz"
-     AC_LINK_IFELSE([AC_LANG_SOURCE([int main () { return LZ_decompress_open(); }])],
-       [guix_cv_liblz_libdir="`ldd conftest$EXEEXT | grep liblz | sed '-es/.*=> \(.*\) .*$/\1/g'`"])
-     LIBS="$old_LIBS"])
-  $1="$guix_cv_liblz_libdir"
-])
-
 dnl GUIX_CURRENT_LOCALSTATEDIR
 dnl
 dnl Determine the localstatedir of an existing Guix installation and set
diff --git a/tests/lzlib.scm b/tests/lzlib.scm
deleted file mode 100644
index 63d1e15641..0000000000
--- a/tests/lzlib.scm
+++ /dev/null
@@ -1,120 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (test-lzlib)
-  #:use-module (guix lzlib)
-  #:use-module (guix tests)
-  #:use-module (srfi srfi-64)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
-  #:use-module (ice-9 match))
-
-;; Test the (guix lzlib) module.
-
-(define-syntax-rule (test-assert* description exp)
-  (begin
-    (unless (lzlib-available?)
-      (test-skip 1))
-    (test-assert description exp)))
-
-(test-begin "lzlib")
-
-(define (compress-and-decompress data)
-  "DATA must be a bytevector."
-  (pk "Uncompressed bytes:" (bytevector-length data))
-  (match (pipe)
-    ((parent . child)
-     (match (primitive-fork)
-       (0                               ;compress
-        (dynamic-wind
-          (const #t)
-          (lambda ()
-            (close-port parent)
-            (call-with-lzip-output-port child
-              (lambda (port)
-                (put-bytevector port data))))
-          (lambda ()
-            (primitive-exit 0))))
-       (pid                             ;decompress
-        (begin
-          (close-port child)
-          (let ((received (call-with-lzip-input-port parent
-                            (lambda (port)
-                              (get-bytevector-all port)))))
-            (match (waitpid pid)
-              ((_ . status)
-               (pk "Status" status)
-               (pk "Length data" (bytevector-length data) "received" (bytevector-length received))
-               ;; The following loop is a debug helper.
-               (let loop ((i 0))
-                 (if (and (< i (bytevector-length received))
-                          (= (bytevector-u8-ref received i)
-                             (bytevector-u8-ref data i)))
-                     (loop (+ 1 i))
-                     (pk "First diff at index" i)))
-               (and (zero? status)
-                    (port-closed? parent)
-                    (bytevector=? received data)))))))))))
-
-(test-assert* "null bytevector"
-  (compress-and-decompress (make-bytevector (+ (random 100000)
-                                               (* 20 1024)))))
-
-(test-assert* "random bytevector"
-  (compress-and-decompress (random-bytevector (+ (random 100000)
-                                                 (* 20 1024)))))
-(test-assert* "small bytevector"
-  (compress-and-decompress (random-bytevector 127)))
-
-(test-assert* "1 bytevector"
-  (compress-and-decompress (random-bytevector 1)))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)"
-  (compress-and-decompress
-   (random-bytevector
-    (* 2 (dictionary-size+match-length-limit %default-compression-level)))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)"
-  (compress-and-decompress (random-bytevector (* 64 1024))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB-1)"
-  (compress-and-decompress (random-bytevector (1- (* 64 1024)))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB+1)"
-  (compress-and-decompress (random-bytevector (1+ (* 64 1024)))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)"
-  (compress-and-decompress (random-bytevector (* 1024 1024))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-1)"
-  (compress-and-decompress (random-bytevector (1- (* 1024 1024)))))
-
-(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
-  (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
-
-(test-assert* "make-lzip-input-port/compressed"
-  (let* ((len        (pk 'len (+ 10 (random 4000 %seed))))
-         (data       (random-bytevector len))
-         (compressed (make-lzip-input-port/compressed
-                      (open-bytevector-input-port data)))
-         (result     (call-with-lzip-input-port compressed
-                                                get-bytevector-all)))
-    (pk (bytevector-length result) (bytevector-length data))
-    (bytevector=? result data)))
-
-(test-end)
diff --git a/tests/publish.scm b/tests/publish.scm
index e43310ef00..1c3b2785fb 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -35,8 +35,8 @@
   #:use-module ((guix serialization) #:select (restore-file))
   #:use-module (gcrypt pk-crypto)
   #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
-  #:use-module (guix zlib)
-  #:use-module (guix lzlib)
+  #:use-module (zlib)
+  #:use-module (lzlib)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
@@ -204,8 +204,6 @@ References: ~%"
        (call-with-input-string nar (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (test-equal "/nar/gzip/*"
   "bar"
   (call-with-temporary-output-file
@@ -217,8 +215,6 @@ References: ~%"
          (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (test-equal "/nar/gzip/* is really gzip"
   %gzip-magic-bytes
   ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
@@ -229,8 +225,6 @@ References: ~%"
                (string-append "/nar/gzip/" (basename %item))))))
     (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
 
-(unless (lzlib-available?)
-  (test-skip 1))
 (test-equal "/nar/lzip/*"
   "bar"
   (call-with-temporary-output-file
@@ -242,8 +236,6 @@ References: ~%"
          (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (test-equal "/*.narinfo with compression"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
@@ -264,8 +256,6 @@ References: ~%"
                   (_ #f)))
               (recutils->alist body)))))
 
-(unless (lzlib-available?)
-  (test-skip 1))
 (test-equal "/*.narinfo with lzip compression"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/lzip/" (basename %item)))
@@ -286,8 +276,6 @@ References: ~%"
                   (_ #f)))
               (recutils->alist body)))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (test-equal "/*.narinfo for a compressed file"
   '("none" "nar")          ;compression-less nar
   ;; Assume 'guix publish -C' is already running on port 6799.
@@ -300,8 +288,6 @@ References: ~%"
     (list (assoc-ref info "Compression")
           (dirname (assoc-ref info "URL")))))
 
-(unless (and (zlib-available?) (lzlib-available?))
-  (test-skip 1))
 (test-equal "/*.narinfo with lzip + gzip"
   `((("StorePath" . ,%item)
      ("URL" . ,(string-append "nar/gzip/" (basename %item)))
@@ -411,8 +397,6 @@ References: ~%"
                               (call-with-input-string "" port-sha256))))))
     (response-code (http-get uri))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (test-equal "with cache"
   (list #t
         `(("StorePath" . ,%item)
@@ -469,8 +453,6 @@ References: ~%"
                          (stat:size (stat nar)))
                       (response-code uncompressed)))))))))
 
-(unless (and (zlib-available?) (lzlib-available?))
-  (test-skip 1))
 (test-equal "with cache, lzip + gzip"
   '(200 200 404)
   (call-with-temporary-directory
@@ -515,8 +497,6 @@ References: ~%"
                       (response-code
                        (http-get uncompressed))))))))))
 
-(unless (zlib-available?)
-  (test-skip 1))
 (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
                                (random-text))))
   (test-equal "with cache, uncompressed"
@@ -596,9 +576,7 @@ References: ~%"
               (item     (add-text-to-store %store "random" (random-text)))
               (part     (store-path-hash-part item))
               (url      (string-append base part ".narinfo"))
-              (cached   (string-append cache
-                                       (if (zlib-available?)
-                                           "/gzip/" "/none/")
+              (cached   (string-append cache "/gzip/"
                                        (basename item)
                                        ".narinfo"))
               (response (http-get url)))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index a4246aff82..6560612c40 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -29,7 +29,6 @@
   #:use-module ((guix store) #:select (%store-prefix))
   #:use-module ((guix ui) #:select (guix-warning-port))
   #:use-module ((guix utils) #:select (call-with-compressed-output-port))
-  #:use-module ((guix lzlib) #:select (lzlib-available?))
   #:use-module ((guix build utils)
                 #:select (mkdir-p delete-file-recursively dump-port))
   #:use-module (guix tests http)
@@ -508,8 +507,7 @@ System: mips64el-linux\n")))
           (let ((nar (string-append %main-substitute-directory
                                     "/example.nar")))
             (compress nar (string-append nar ".gz") 'gzip)
-            (when (lzlib-available?)
-              (compress nar (string-append nar ".lz") 'lzip)))
+            (compress nar (string-append nar ".lz") 'lzip))
 
           (parameterize ((substitute-urls
                           (list (string-append "file://"
diff --git a/tests/utils.scm b/tests/utils.scm
index f78ec356bd..009e2121ab 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -23,7 +23,6 @@
   #:use-module (guix utils)
   #:use-module ((guix store) #:select (%store-prefix store-path-package-name))
   #:use-module ((guix search-paths) #:select (string-tokenize*))
-  #:use-module ((guix lzlib) #:select (lzlib-available?))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64)
@@ -215,7 +214,7 @@ skip these tests."
 
 (for-each test-compression/decompression
           '(gzip xz lzip)
-          (list (const #t) (const #t) lzlib-available?))
+          (list (const #t) (const #t) (const #t)))
 
 ;; This is actually in (guix store).
 (test-equal "store-path-package-name"
diff --git a/tests/zlib.scm b/tests/zlib.scm
deleted file mode 100644
index 7c595a422c..0000000000
--- a/tests/zlib.scm
+++ /dev/null
@@ -1,62 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2019 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (test-zlib)
-  #:use-module (guix zlib)
-  #:use-module (guix tests)
-  #:use-module (srfi srfi-64)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
-  #:use-module (ice-9 match))
-
-;; Test the (guix zlib) module.
-
-(test-begin "zlib")
-
-(unless (zlib-available?)
-  (test-skip 1))
-(test-assert "compression/decompression pipe"
-  (let ((data (random-bytevector (+ (random 10000)
-                                    (* 20 1024)))))
-    (match (pipe)
-      ((parent . child)
-       (match (primitive-fork)
-         (0                                       ;compress
-          (dynamic-wind
-            (const #t)
-            (lambda ()
-              (close-port parent)
-              (call-with-gzip-output-port child
-                (lambda (port)
-                  (put-bytevector port data))))
-            (lambda ()
-              (primitive-exit 0))))
-         (pid                                     ;decompress
-          (begin
-            (close-port child)
-            (let ((received (call-with-gzip-input-port parent
-                              (lambda (port)
-                                (get-bytevector-all port))
-                              #:buffer-size (* 64 1024))))
-              (match (waitpid pid)
-                ((_ . status)
-                 (and (zero? status)
-                      (port-closed? parent)
-                      (bytevector=? received data))))))))))))
-
-(test-end)
-- 
2.26.2


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-27 16:24               ` Mathieu Othacehe
@ 2020-07-28 22:16                 ` Ludovic Courtès
  2020-08-06 13:44                   ` Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-07-28 22:16 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hi!

Mathieu Othacehe <othacehe@gnu.org> skribis:

> So as you suggested I created "guile-zlib" and "guile-lzlib" which was
> the easy part. The other part is the hard to digest, attached patch.

Thanks for doing that!

(I figured David Thompson had one wrapping the low-level bits of zlib:
<https://github.com/davexunit/guile-zlib>.  We should probably
incorporate that.)

> I tested it running "make check", "make as-derivation", "./pre-inst-env
> guix build guix". Hope I didn't miss something.

Nice!

> Please, tell me what you think :)

Just a quick review because I’m headed for a break.  :-)

> From d0f23078d1963f9aa8facda0fb3ae40e1e8c3cf2 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <othacehe@gnu.org>
> Date: Mon, 27 Jul 2020 16:36:39 +0200
> Subject: [PATCH] Use "guile-zlib" and "guile-lzlib" instead of (guix config).
>
> * Makefile.am (MODULES): Remove guix/zlib.scm and guix/lzlib.scm,
> (SCM_TESTS): remove tests/zlib.scm, tests/lzlib.scm.
> * build-aux/build-self.scm (make-config.scm): Remove unused %libz variable.
> * configure.ac: Remove LIBZ and LIBLZ variables and check instead for
> Guile-zlib and Guile-lzlib.
> * doc/guix.texi ("Requirements"): Remove zlib requirement and add Guile-zlib
> and Guile-lzlib instead.
> * gnu/packages/package-management.scm (guix)[native-inputs]: Add "guile-zlib"
> and "guile-lzlib",
> [inputs]: remove "zlib" and "lzlib",
> [propagated-inputs]: ditto,
> [arguments]: add "guile-zlib" and "guile-lzlib" to Guile load path.
> * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib).
> * guix/config.scm.in (%libz, %liblz): Remove them.
> * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported
> modules list, instead add "guile-zlib" to the extension list.
> * guix/git-download.scm (git-fetch): Ditto.
> * guix/gnu-maintenance.scm: Use (zlib) instead of (guix zlib).
> * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported
> modules list, instead add "guile-zlib" to the extension list.
> * guix/lzlib.scm: Remove it.
> * guix/man-db.scm: Use (zlib) instead of (guix zlib).
> * guix/profiles.scm (manual-database): Do not stub (guix config) in imported
> modules list, instead add "guile-zlib" to the extension list.
> * guix/scripts/publish.scm: Use (zlib) instead of (guix zlib) and (lzlib)
> instead of (guix lzlib),
> (string->compression-type, effective-compression): do not check for zlib and
> lzlib availability.
> * guix/scripts/substitute.scm (%compression-methods): Do not check for lzlib
> availability.
> * guix/self.scm (specification->package): Add "guile-zlib" and "guile-lzlib"
> and remove "zlib" and "lzlib",
> (compiled-guix): remove "zlib" and "lzlib" arguments and add guile-zlib and
> guile-lzlib to the dependencies, also do not pass "zlib" and "lzlib" to
> "make-config.scm" procedure,
> (make-config.scm): remove "zlib" and "lzlib" arguments as well as %libz and
> %liblz variables.
> * guix/utils.scm (lzip-port): Use (lzlib) instead of (guix lzlib) and do not
> check for lzlib availability.
> * guix/zlib.scm: Remove it.
> * m4/guix.m4 (GUIX_LIBZ_LIBDIR, GUIX_LIBLZ_FILE_NAME): Remove them.
> * tests/lzlib.scm: Use (zlib) instead of (guix zlib) and (lzlib)
> instead of (guix lzlib), and do not check for zlib and lzlib availability.
> * tests/publish.scm: Ditto.
> * tests/substitute.scm: Do not check for lzlib availability.
> * tests/utils.scm: Ditto.
> * tests/zlib.scm: Remove it.

This can be decomposed in several steps:

  1. We can start using ‘guile-zlib’ as extensions for gexps: in (guix
     scripts pack), (guix download), etc.  Easy, no risk.

  2. Use guile-zlib & co. in Guix itself: (guix scripts substitute),
     (guix scripts publish), etc.  Keep (guix zlib) and (guix lzlib) in
     parallel.

  3. Update ‘guix’ package with these two new dependencies.

  4. Remove uses (guix zlib) and (guix lzlib), adjust build machinery
     and doc.

  5. Adjust (guix self) and related code.  This is a bit touchy.

Perhaps there’s a couple of steps that can be merged, but having a split
along these lines would be clearer and better for our peace of mind.

> --- a/build-aux/build-self.scm
> +++ b/build-aux/build-self.scm
> @@ -71,7 +71,7 @@
>                                        (variables rest ...))))))
>      (variables %localstatedir %storedir %sysconfdir %system)))
>  
> -(define* (make-config.scm #:key zlib gzip xz bzip2
> +(define* (make-config.scm #:key gzip xz bzip2
>                            (package-name "GNU Guix")
>                            (package-version "0")
>                            (bug-report-address "bug-guix@gnu.org")

This is OK.

> @@ -133,11 +133,7 @@
>                       (define %bzip2
>                         #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
>                       (define %xz
> -                       #+(and xz (file-append xz "/bin/xz")))
> -
> -                     (define %libz
> -                       #+(and zlib
> -                              (file-append zlib "/lib/libz")))))))
> +                       #+(and xz (file-append xz "/bin/xz")))))))

I think it’s OK too, but we have to keep in mind that this code can be
run by a past Guix that expects ‘%libz’.  Normally it’s OK because the
modules needed by ‘compute-guix-derivation’ do not rely on ‘%libz’ and
(guix zlib).

One test would be something like:

  guix time-machine --commit=6298c3ffd9654d3231a6f25390b056483e8f407c -- \
    pull -p /tmp/test --url=/path/to/local/repo --branch=the-branch

This will check that 1.0.0 can indeed pull this new repo.

The rest LGTM.  Thanks a lot for all the work!

Ludo’, who’s going to be away the coming weeks.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-07-28 22:16                 ` Ludovic Courtès
@ 2020-08-06 13:44                   ` Mathieu Othacehe
  2020-08-23 16:27                     ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-08-06 13:44 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123

[-- Attachment #1: Type: text/plain, Size: 1394 bytes --]


Hey Ludo!

> This can be decomposed in several steps:
>
>   1. We can start using ‘guile-zlib’ as extensions for gexps: in (guix
>      scripts pack), (guix download), etc.  Easy, no risk.

There's an attached patch that should cover this first step. An issue
here is that (guix build download-nar) is built in both "make" and "guix
pull" commands, so I cannot use a bare:

--8<---------------cut here---------------start------------->8---
#:use-module (zlib)
--8<---------------cut here---------------end--------------->8---

so, I used:

--8<---------------cut here---------------start------------->8---
#:autoload   (zlib) (call-with-gzip-input-port)
--8<---------------cut here---------------end--------------->8---

that seems to work but produces a lot of warnings when running
"make". Would it be acceptable as a first step?

>
>   2. Use guile-zlib & co. in Guix itself: (guix scripts substitute),
>      (guix scripts publish), etc.  Keep (guix zlib) and (guix lzlib) in
>      parallel.

I'm not sure how it can work without step 4. For me, including (zlib) in
Guix itself requires that build machinery and (guix self) are updated,
but maybe I'm missing something.

>
>   3. Update ‘guix’ package with these two new dependencies.

Seems fair!

> The rest LGTM.  Thanks a lot for all the work!

Thanks for having a look :)

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-guile-zlib-extension-in-build-side-code.patch --]
[-- Type: text/x-diff, Size: 7986 bytes --]

From 680e19137d22204f34b00336a3cb98a02397b0f9 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Thu, 6 Aug 2020 15:00:01 +0200
Subject: [PATCH] Use guile-zlib extension in build-side code.

* Makefile.am (MODULES): Move guix/build/download-nar.scm to ...
(MODULES_NOT_COMPILED): ... here.
* guix/build/download-nar.scm: Use (zlib) instead of (guix zlib).
* guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported
modules list, instead add "guile-zlib" to the extension list.
* guix/git-download.scm (git-fetch): Ditto.
* guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported
modules list, instead add "guile-zlib" to the extension list.
---
 guix/build/download-nar.scm |  2 +-
 guix/cvs-download.scm       | 39 ++++++++++++++-----------------------
 guix/git-download.scm       | 29 ++++++++++-----------------
 guix/hg-download.scm        | 37 +++++++++++++----------------------
 4 files changed, 40 insertions(+), 67 deletions(-)

diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 377e428341..867f3c10bb 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -20,7 +20,7 @@
   #:use-module (guix build download)
   #:use-module (guix build utils)
   #:use-module ((guix serialization) #:hide (dump-port*))
-  #:use-module (guix zlib)
+  #:autoload   (zlib) (call-with-gzip-input-port)
   #:use-module (guix progress)
   #:use-module (web uri)
   #:use-module (srfi srfi-11)
diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index cb42103aae..76b3eac739 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <cvs-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build cvs)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build cvs)
+                                     (guix build download-nar)))))
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build cvs)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build cvs)
+                         (guix build download-nar))
 
-          (or (cvs-fetch '#$(cvs-reference-root-directory ref)
-                         '#$(cvs-reference-module ref)
-                         '#$(cvs-reference-revision ref)
-                         #$output
-                         #:cvs-command (string-append #+cvs "/bin/cvs"))
-              (download-nar #$output)))))
+            (or (cvs-fetch '#$(cvs-reference-root-directory ref)
+                           '#$(cvs-reference-module ref)
+                           '#$(cvs-reference-revision ref)
+                           #$output
+                           #:cvs-command (string-append #+cvs "/bin/cvs"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "cvs-checkout") build
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 71ea1031c5..90634a8c4c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -84,35 +84,26 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
           ("tar" ,(module-ref (resolve-interface '(gnu packages base))
                               'tar)))))
 
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
   (define guile-json
     (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3))
 
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
+
   (define gnutls
     (module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
 
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
-
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build git)
-                                           (guix build utils)
-                                           (guix build download-nar)
-                                           (guix swh))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build git)
+                                     (guix build utils)
+                                     (guix build download-nar)
+                                     (guix swh)))))
 
   (define build
     (with-imported-modules modules
-      (with-extensions (list guile-json gnutls)   ;for (guix swh)
+      (with-extensions (list guile-json gnutls   ;for (guix swh)
+                             guile-zlib)
         #~(begin
             (use-modules (guix build git)
                          (guix build utils)
diff --git a/guix/hg-download.scm b/guix/hg-download.scm
index 4cdc1a780a..694105ceba 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
@@ -60,35 +60,26 @@
   "Return a fixed-output derivation that fetches REF, a <hg-reference>
 object.  The output is expected to have recursive hash HASH of type
 HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
-  (define zlib
-    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
-
-  (define config.scm
-    (scheme-file "config.scm"
-                 #~(begin
-                     (define-module (guix config)
-                       #:export (%libz))
-
-                     (define %libz
-                       #+(file-append zlib "/lib/libz")))))
+  (define guile-zlib
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
   (define modules
-    (cons `((guix config) => ,config.scm)
-          (delete '(guix config)
-                  (source-module-closure '((guix build hg)
-                                           (guix build download-nar))))))
+    (delete '(guix config)
+            (source-module-closure '((guix build hg)
+                                     (guix build download-nar)))))
 
   (define build
     (with-imported-modules modules
-      #~(begin
-          (use-modules (guix build hg)
-                       (guix build download-nar))
+      (with-extensions (list guile-zlib)
+        #~(begin
+            (use-modules (guix build hg)
+                         (guix build download-nar))
 
-          (or (hg-fetch '#$(hg-reference-url ref)
-                        '#$(hg-reference-changeset ref)
-                        #$output
-                        #:hg-command (string-append #+hg "/bin/hg"))
-              (download-nar #$output)))))
+            (or (hg-fetch '#$(hg-reference-url ref)
+                          '#$(hg-reference-changeset ref)
+                          #$output
+                          #:hg-command (string-append #+hg "/bin/hg"))
+                (download-nar #$output))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "hg-checkout") build
-- 
2.26.2


^ permalink raw reply related	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-08-06 13:44                   ` Mathieu Othacehe
@ 2020-08-23 16:27                     ` Ludovic Courtès
  2020-08-24 11:38                       ` Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-08-23 16:27 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hello!

Apologies for the holiday-induced delay!

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> This can be decomposed in several steps:
>>
>>   1. We can start using ‘guile-zlib’ as extensions for gexps: in (guix
>>      scripts pack), (guix download), etc.  Easy, no risk.
>
> There's an attached patch that should cover this first step. An issue
> here is that (guix build download-nar) is built in both "make" and "guix
> pull" commands, so I cannot use a bare:
>
> #:use-module (zlib)
>
>
> so, I used:
>
> #:autoload   (zlib) (call-with-gzip-input-port)
>
> that seems to work but produces a lot of warnings when running
> "make". Would it be acceptable as a first step?

Yeah, sounds good to me.

>>   2. Use guile-zlib & co. in Guix itself: (guix scripts substitute),
>>      (guix scripts publish), etc.  Keep (guix zlib) and (guix lzlib) in
>>      parallel.
>
> I'm not sure how it can work without step 4. For me, including (zlib) in
> Guix itself requires that build machinery and (guix self) are updated,
> but maybe I'm missing something.

Hmm you must be right.  Well in that case you can do these in lockstep.
Sorry for the confusion!

> From 680e19137d22204f34b00336a3cb98a02397b0f9 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <othacehe@gnu.org>
> Date: Thu, 6 Aug 2020 15:00:01 +0200
> Subject: [PATCH] Use guile-zlib extension in build-side code.
>
> * Makefile.am (MODULES): Move guix/build/download-nar.scm to ...
> (MODULES_NOT_COMPILED): ... here.
> * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib).
> * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported
> modules list, instead add "guile-zlib" to the extension list.
> * guix/git-download.scm (git-fetch): Ditto.
> * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported
> modules list, instead add "guile-zlib" to the extension list.

LGTM!  Glad we’re making progress on this front, thanks a lot!

Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-08-23 16:27                     ` Ludovic Courtès
@ 2020-08-24 11:38                       ` Mathieu Othacehe
  2020-08-24 14:03                         ` Ludovic Courtès
  0 siblings, 1 reply; 16+ messages in thread
From: Mathieu Othacehe @ 2020-08-24 11:38 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123


Hey,

> Apologies for the holiday-induced delay!

Glad to see you back!

> Hmm you must be right.  Well in that case you can do these in lockstep.
> Sorry for the confusion!

So, I did proceed in two steps:

* Pushed the build-side patch as e9f8a7e21579fd2833dfca6830e21f886a79a9ca.
* Pushed the rest as 4c0c65acfade63ce0549115d19db4b639c1e9992.

As you suggested before, I tested the "guix pull" from 1.0.0 revision,
which seems to work fine.

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 16+ messages in thread

* [bug#42123] [PATCH] linux-libre: Enable module compression.
  2020-08-24 11:38                       ` Mathieu Othacehe
@ 2020-08-24 14:03                         ` Ludovic Courtès
  2020-08-25 10:30                           ` bug#42123: " Mathieu Othacehe
  0 siblings, 1 reply; 16+ messages in thread
From: Ludovic Courtès @ 2020-08-24 14:03 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 42123

Hi!

Mathieu Othacehe <othacehe@gnu.org> skribis:

> So, I did proceed in two steps:
>
> * Pushed the build-side patch as e9f8a7e21579fd2833dfca6830e21f886a79a9ca.
> * Pushed the rest as 4c0c65acfade63ce0549115d19db4b639c1e9992.
>
> As you suggested before, I tested the "guix pull" from 1.0.0 revision,
> which seems to work fine.

Awesome, thanks a lot!

Ludo’.




^ permalink raw reply	[flat|nested] 16+ messages in thread

* bug#42123: [PATCH] linux-libre: Enable module compression.
  2020-08-24 14:03                         ` Ludovic Courtès
@ 2020-08-25 10:30                           ` Mathieu Othacehe
  0 siblings, 0 replies; 16+ messages in thread
From: Mathieu Othacehe @ 2020-08-25 10:30 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 42123-done


Hey,

>> As you suggested before, I tested the "guix pull" from 1.0.0 revision,
>> which seems to work fine.
>
> Awesome, thanks a lot!

I just pushed Linux module compression support with
755f365b02b42a5d1e8ef3000dadef069553a478 and
5fe12be0dd03d1a316343549f8c131d931f21a9a.

The build-side module (gnu build linux-modules) now uses (zlib)
module. This means that derivations that effectively rely on reading
compressed modules (such as "linux-modules"), need to add "guile-zlib"
as an extension.

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 16+ messages in thread

end of thread, other threads:[~2020-08-25 10:31 UTC | newest]

Thread overview: 16+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-06-29 14:24 [bug#42123] [PATCH] linux-libre: Enable module compression Mathieu Othacehe
2020-06-30  7:31 ` Mathieu Othacehe
2020-07-02 10:23 ` Ludovic Courtès
2020-07-06  8:48   ` Mathieu Othacehe
2020-07-06 12:20     ` Ludovic Courtès
2020-07-06 14:23       ` Mathieu Othacehe
2020-07-06 20:13         ` Ludovic Courtès
2020-07-07  7:32           ` Mathieu Othacehe
2020-07-09  7:56             ` Ludovic Courtès
2020-07-27 16:24               ` Mathieu Othacehe
2020-07-28 22:16                 ` Ludovic Courtès
2020-08-06 13:44                   ` Mathieu Othacehe
2020-08-23 16:27                     ` Ludovic Courtès
2020-08-24 11:38                       ` Mathieu Othacehe
2020-08-24 14:03                         ` Ludovic Courtès
2020-08-25 10:30                           ` bug#42123: " Mathieu Othacehe

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.