[bug#34807] [PATCH 1/2] Add (guix lzlib).

[Pierre Neidhardt <mail@ambrevar.xyz>]

[-- Attachment #1.1: Type: text/plain, Size: 1243 bytes --]

Right on time, I just finished it!

- I've been in touch with Antonio, Lzip's maintainer, for more than a
  week and now I'm confident that I have a decent understanding of the
  library.

- Your m4 suggestion didn't work.  I've included a comment.  We need to
  fix it before merging.  I'm not the right person for this job I'm
  afraid :p  Ludo?

- The convenience functions do not support multi-member archives.
  Multi-member archives are mostly useful for parallelization, but we
  don't use that in Guix, so it's OK.  Should it be required some day,
  we would need to implement it, which requires a little bit more work.
  I've documented all that.

- The implementation of lzread! is subpar because I understood a
  subtlety a bit too late.  But that's alright, it does not affect
  performance nor reliability.

- I've included 11 tests covering all your suggestions.

- I haven't strace'd the Guile process.  The code regarding ports is
  identical to zlib.scm, so it's unlikely there would be an issue in
  this area.  I have never done this before, so out of curiosity, how do
  you run a specific Guix tests without going through `make'?

Next steps? :D

-- 
Pierre Neidhardt
https://ambrevar.xyz/

[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[-- Attachment #2: 0001-Add-guix-lzlib.patch --]
[-- Type: text/x-patch, Size: 36548 bytes --]

From 6407597ce2855b87849ba0b2c3866b8a75fca9b3 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Fri, 8 Mar 2019 19:02:59 +0100
Subject: [PATCH 1/2] Add (guix lzlib).

* guix/lzlib.scm, tests/lzlib.scm: New files.
* Makefile.am (MODULES): Add guix/lzlib.scm.
(SCM_TESTS): Add tests/lzlib.scm.
* m4/guix.m4 (GUIX_LIBLZ_LIBDIR): New macro.
* configure.ac (LIBLZ_LIBDIR): Use it.  Define and substitute
'LIBLZ'.
* guix/config.scm.in (%liblz): New variable.
---
 Makefile.am        |   2 +
 configure.ac       |  11 +
 guix/config.scm.in |   8 +-
 guix/lzlib.scm     | 633 +++++++++++++++++++++++++++++++++++++++++++++
 guix/self.scm      |   3 +-
 m4/guix.m4         |  17 ++
 tests/lzlib.scm    | 108 ++++++++
 7 files changed, 780 insertions(+), 2 deletions(-)
 create mode 100644 guix/lzlib.scm
 create mode 100644 tests/lzlib.scm

diff --git a/Makefile.am b/Makefile.am
index 36f3bc5c27..232550069f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -103,6 +103,7 @@ MODULES =					\
   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			\
@@ -404,6 +405,7 @@ SCM_TESTS =					\
   tests/cve.scm					\
   tests/workers.scm				\
   tests/zlib.scm				\
+  tests/lzlib.scm				\
   tests/file-systems.scm			\
   tests/uuid.scm				\
   tests/system.scm				\
diff --git a/configure.ac b/configure.ac
index 7e7ae02730..ee7aa25742 100644
--- a/configure.ac
+++ b/configure.ac
@@ -250,6 +250,17 @@ 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_LIBDIR([liblz_libdir])
+if test "x$liblz_libdir" = "x"; then
+  LIBLZ="liblz"
+else
+  LIBLZ="$liblz_libdir/liblz"
+fi
+AC_MSG_CHECKING([for lzlib's shared library name])
+AC_MSG_RESULT([$LIBLZ])
+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/guix/config.scm.in b/guix/config.scm.in
index 247b15ed81..cd7036ca7e 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -36,7 +36,8 @@
             %libz
             %gzip
             %bzip2
-            %xz))
+            %xz
+            %liblz))
 
 ;;; Commentary:
 ;;;
@@ -99,4 +100,9 @@
 (define %xz
   "@XZ@")
 
+(define %liblz
+  ;; TODO: Set this dynamically.
+  ;; "@LIBLZ@"
+  "/gnu/store/8db7vivi8p9mpkbphb8xy8gh2bkwc4iz-lzlib-1.11/lib/liblz")
+
 ;;; config.scm ends here
diff --git a/guix/lzlib.scm b/guix/lzlib.scm
new file mode 100644
index 0000000000..d596f0d95d
--- /dev/null
+++ b/guix/lzlib.scm
@@ -0,0 +1,633 @@
+;;; 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 (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)
+  #:export (lzlib-available?
+            make-lzip-input-port
+            make-lzip-output-port
+            call-with-lzip-input-port
+            call-with-lzip-output-port
+            %default-member-length-limit
+            %default-compression-level))
+
+;;; 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 strictly 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 %lz-decompress-input-buffer-size (* 64 1024))
+
+(define* (lzread! decoder file-port bv
+                  #:optional (start 0) (count (bytevector-length bv)))
+  "Read up to COUNT bytes from FILE-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."
+  ;; WARNING: Because we don't alternate between lz-reads and lz-writes, we can't
+  ;; process more than %lz-decompress-input-buffer-size from the file-port.
+  (when (> count %lz-decompress-input-buffer-size)
+    (set! count %lz-decompress-input-buffer-size))
+  (let* ((written 0)
+         (read 0)
+         (file-bv (get-bytevector-n file-port count)))
+    (unless (eof-object? file-bv)
+      (begin
+        (while (and (< 0 (lz-decompress-write-size decoder))
+                    (< written (bytevector-length file-bv)))
+          (set! written (+ written
+                           (lz-decompress-write decoder file-bv written
+                                                (- (bytevector-length file-bv) written)))))))
+    (let loop ((rd 0))
+      (if (< start (bytevector-length bv))
+          (begin
+            (set! rd (lz-decompress-read decoder bv start (- (bytevector-length bv) start)))
+            (set! start (+ start rd))
+            (set! read (+ read rd)))
+          (set! rd 0))
+      (unless (= rd 0)
+        (loop rd)))
+    read))
+
+(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* (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 (apply lz-compress-open
+                         (car (assoc-ref %compression-levels level))))
+
+  (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* (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/self.scm b/guix/self.scm
index 68b87051e9..ff6b7765dd 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -969,7 +969,8 @@ Info manual."
 
                    (define %libz
                      #+(and zlib
-                            (file-append zlib "/lib/libz"))))
+                            (file-append zlib "/lib/libz")))
+                   (define %liblz #f))
 
                ;; 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/m4/guix.m4 b/m4/guix.m4
index 5c846f7618..78cc3777f8 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -312,6 +312,23 @@ AC_DEFUN([GUIX_LIBZ_LIBDIR], [
   $1="$guix_cv_libz_libdir"
 ])
 
+dnl GUIX_LIBLZ_LIBDIR VAR
+dnl
+dnl Attempt to determine liblz's LIBDIR; store the result in VAR.
+AC_DEFUN([GUIX_LIBLZ_LIBDIR], [
+  AC_REQUIRE([PKG_PROG_PKG_CONFIG])
+  AC_CACHE_CHECK([lzlib's library directory],
+    [guix_cv_liblz_libdir],
+    [guix_cv_liblz_libdir="`$PKG_CONFIG lzlib --variable=libdir 2> /dev/null`"])
+    dnl TODO: lzlib has no pkg-config so we need the following trick to find its directory.
+    dnl old_LIBS="$LIBS"
+    dnl LIBS="-llz"
+    dnl AC_LINK_IFELSE([LZ_decompress_open();],
+    dnl   [guix_cv_libz_libdir="`ldd conftest$EXEEXT | grep liblz | sed '-es/.*=> \([^ ]*\).*$/\1/g'`"])
+    dnl 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
new file mode 100644
index 0000000000..a6631ce91c
--- /dev/null
+++ b/tests/lzlib.scm
@@ -0,0 +1,108 @@
+;;; 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.
+
+(unless (lzlib-available?)
+  (exit 77))
+
+(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 (car (car (assoc-ref (@@ (guix lzlib) %compression-levels)
+                              (@@ (guix lzlib) %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-end)
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-dir-locals.el-Add-call-with-lzip-input-port-and-call.patch --]
[-- Type: text/x-patch, Size: 1141 bytes --]

From 7dd8f4207657ae7ad178c21a45f74bef6cc0a314 Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Sun, 10 Mar 2019 16:40:41 +0100
Subject: [PATCH 2/2] dir-locals.el: Add 'call-with-lzip-input-port' and
 'call-with-lzip-output-port' keywords.

* .dir-locals.el: Add indentation rules for 'call-with-lzip-input-port' and
'call-with-lzip-output-port'.
---
 .dir-locals.el | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.dir-locals.el b/.dir-locals.el
index 550e06ef09..f1196fd781 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -53,6 +53,8 @@
    (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
    (eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
    (eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
+   (eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
+   (eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
    (eval . (put 'signature-case 'scheme-indent-function 1))
    (eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
    (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
-- 
2.21.0