From 2a991f3ae4823730395c7970d83159e93d5f5fe2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 23 May 2019 21:35:47 +0200
Subject: [PATCH] lzlib: Add 'make-lzip-input-port/compressed'.

* guix/lzlib.scm (lzwrite!, make-lzip-input-port/compressed): New
procedures.
* tests/lzlib.scm ("make-lzip-input-port/compressed"): New test.
* guix/tests.scm (%seed): Export.
---
 guix/lzlib.scm  | 71 +++++++++++++++++++++++++++++++++++++++++++++++++
 guix/tests.scm  |  1 +
 tests/lzlib.scm | 10 +++++++
 3 files changed, 82 insertions(+)

diff --git a/guix/lzlib.scm b/guix/lzlib.scm
index deb900f352..a484315c0e 100644
--- a/guix/lzlib.scm
+++ b/guix/lzlib.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,9 +24,11 @@
   #: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
@@ -515,6 +518,24 @@ the end-of-stream has been reached."
         (loop rd)))
     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
@@ -597,6 +618,56 @@ port is closed."
                                     (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 (apply lz-compress-open
+                         (car (assoc-ref %compression-levels level))))
+
+  (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."
diff --git a/guix/tests.scm b/guix/tests.scm
index 35ebf8464d..66d60e964e 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -33,6 +33,7 @@
   #:use-module (web uri)
   #:export (open-connection-for-tests
             with-external-store
+            %seed
             random-text
             random-bytevector
             file=?
diff --git a/tests/lzlib.scm b/tests/lzlib.scm
index cf53a9417d..543622bb45 100644
--- a/tests/lzlib.scm
+++ b/tests/lzlib.scm
@@ -108,4 +108,14 @@
 (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)