From: "Ludovic Courtès" <ludo@gnu.org>
To: 35880@debbugs.gnu.org
Cc: Pierre Neidhardt <mail@ambrevar.xyz>
Subject: [bug#35880] [PATCH 1/7] lzlib: Add 'make-lzip-input-port/compressed'.
Date: Fri, 24 May 2019 15:42:32 +0200 [thread overview]
Message-ID: <20190524134238.22802-1-ludo@gnu.org> (raw)
In-Reply-To: <20190524133159.22568-1-ludo@gnu.org>
* 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 | 62 +++++++++++++++++++++++++++++++++++++++++++++++++
guix/tests.scm | 1 +
tests/lzlib.scm | 10 ++++++++
3 files changed, 73 insertions(+)
diff --git a/guix/lzlib.scm b/guix/lzlib.scm
index a6dac46049..48927c6262 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,23 @@ 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."
+ (define read
+ (if (< 0 (lz-compress-write-size encoder))
+ (match (lz-compress-write encoder source source-offset source-count)
+ (0 (lz-compress-finish encoder) 0)
+ (n n))
+ 0))
+
+ (let loop ()
+ (match (lz-compress-read encoder target target-offset target-count)
+ (0 (loop))
+ (written (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 +617,48 @@ 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?
+ (lz-compress-read encoder bv start count))
+ ((= 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))
+ 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)
--
2.21.0
next prev parent reply other threads:[~2019-05-24 13:43 UTC|newest]
Thread overview: 31+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-24 13:31 [bug#35880] [PATCH 0/7] Lzip support for 'guix publish' and 'guix substitute' Ludovic Courtès
2019-05-24 13:42 ` Ludovic Courtès [this message]
2019-05-24 13:42 ` [bug#35880] [PATCH 2/7] utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 3/7] utils: Support compression and decompression with lzip Ludovic Courtès
2019-05-25 17:27 ` Pierre Neidhardt
2019-05-26 19:52 ` Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 4/7] publish: Add support for lzip Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 5/7] self: Add dependency on lzlib Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 6/7] gnu: guix: " Ludovic Courtès
2019-05-24 13:42 ` [bug#35880] [PATCH 7/7] lzlib: 'lzread!' never returns more than it was asked for Ludovic Courtès
2019-05-25 17:31 ` Pierre Neidhardt
2019-05-26 19:54 ` Ludovic Courtès
2019-05-26 20:57 ` Pierre Neidhardt
2019-05-26 21:28 ` Ludovic Courtès
2019-05-27 7:00 ` Pierre Neidhardt
2019-05-27 10:00 ` Ludovic Courtès
2019-05-25 17:24 ` [bug#35880] [PATCH 1/7] lzlib: Add 'make-lzip-input-port/compressed' Pierre Neidhardt
2019-05-26 19:51 ` Ludovic Courtès
2019-05-27 15:45 ` Ludovic Courtès
2019-05-27 16:24 ` Pierre Neidhardt
2019-05-27 20:53 ` bug#35880: " Ludovic Courtès
2019-05-27 21:12 ` [bug#35880] " Pierre Neidhardt
2019-05-28 7:52 ` Ludovic Courtès
2019-05-28 8:46 ` Pierre Neidhardt
2019-05-28 13:47 ` Ludovic Courtès
2019-05-29 14:57 ` Pierre Neidhardt
2019-05-31 20:54 ` Ludovic Courtès
2019-06-01 6:02 ` Pierre Neidhardt
2019-06-01 9:41 ` Ludovic Courtès
2019-06-01 9:58 ` Pierre Neidhardt
2019-06-01 12:21 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190524134238.22802-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=35880@debbugs.gnu.org \
--cc=mail@ambrevar.xyz \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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.