From patchwork Fri May 24 13:42:32 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 14059 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 21CA417040; Fri, 24 May 2019 14:43:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 950EB1700D for ; Fri, 24 May 2019 14:43:07 +0100 (BST) Received: from localhost ([127.0.0.1]:54877 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUATT-0008Pd-6s for patchwork@mira.cbaines.net; Fri, 24 May 2019 09:43:07 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36880) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUATQ-0008Oj-08 for guix-patches@gnu.org; Fri, 24 May 2019 09:43:05 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hUATO-0008Mi-OX for guix-patches@gnu.org; Fri, 24 May 2019 09:43:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:60990) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hUATO-0008Mc-LV for guix-patches@gnu.org; Fri, 24 May 2019 09:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hUATO-0002PR-CS for guix-patches@gnu.org; Fri, 24 May 2019 09:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#35880] [PATCH 1/7] lzlib: Add 'make-lzip-input-port/compressed'. References: <20190524133159.22568-1-ludo@gnu.org> In-Reply-To: <20190524133159.22568-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 24 May 2019 13:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35880 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 35880@debbugs.gnu.org Received: via spool by 35880-submit@debbugs.gnu.org id=B35880.15587053769220 (code B ref 35880); Fri, 24 May 2019 13:43:02 +0000 Received: (at 35880) by debbugs.gnu.org; 24 May 2019 13:42:56 +0000 Received: from localhost ([127.0.0.1]:46295 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hUATH-0002OT-Ou for submit@debbugs.gnu.org; Fri, 24 May 2019 09:42:56 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50652) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hUATE-0002Nn-JF for 35880@debbugs.gnu.org; Fri, 24 May 2019 09:42:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:38746) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUAT8-0008C6-Oc; Fri, 24 May 2019 09:42:46 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=36484 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hUAT8-0007iN-AZ; Fri, 24 May 2019 09:42:46 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Fri, 24 May 2019 15:42:32 +0200 Message-Id: <20190524134238.22802-1-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Pierre Neidhardt Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 +;;; Copyright © 2019 Ludovic Courtès ;;; ;;; 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)