From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id IFZKK+j/Hl+7YQAA0tVLHw (envelope-from ) for ; Mon, 27 Jul 2020 16:25:12 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id 8CosJ+j/Hl9PGwAA1q6Kng (envelope-from ) for ; Mon, 27 Jul 2020 16:25:12 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id AAF8C9404CB for ; Mon, 27 Jul 2020 16:25:11 +0000 (UTC) Received: from localhost ([::1]:48294 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k05w6-0003ok-4c for larch@yhetil.org; Mon, 27 Jul 2020 12:25:10 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59320) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k05vy-0003oG-SQ for guix-patches@gnu.org; Mon, 27 Jul 2020 12:25:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:44000) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1k05vy-0003Cs-Ib for guix-patches@gnu.org; Mon, 27 Jul 2020 12:25:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1k05vy-0006Ui-C0 for guix-patches@gnu.org; Mon, 27 Jul 2020 12:25:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42123] [PATCH] linux-libre: Enable module compression. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 27 Jul 2020 16:25:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42123 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 42123@debbugs.gnu.org Received: via spool by 42123-submit@debbugs.gnu.org id=B42123.159586707424924 (code B ref 42123); Mon, 27 Jul 2020 16:25:02 +0000 Received: (at 42123) by debbugs.gnu.org; 27 Jul 2020 16:24:34 +0000 Received: from localhost ([127.0.0.1]:55546 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k05vN-0006To-Fq for submit@debbugs.gnu.org; Mon, 27 Jul 2020 12:24:34 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37514) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k05vH-0006TW-Ms for 42123@debbugs.gnu.org; Mon, 27 Jul 2020 12:24:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60954) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k05vB-0003AH-NB; Mon, 27 Jul 2020 12:24:13 -0400 Received: from [2a01:cb18:832e:5f00:9858:4478:ae33:b452] (port=42298 helo=cervin) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k05vA-0006Dc-QT; Mon, 27 Jul 2020 12:24:13 -0400 From: Mathieu Othacehe References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> Date: Mon, 27 Jul 2020 18:24:09 +0200 In-Reply-To: <874kqhcea1.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 09 Jul 2020 09:56:38 +0200") Message-ID: <87v9i9exjq.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.0 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: -1.01 X-TUID: UQm1LQnCOupD --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-Use-guile-zlib-and-guile-lzlib-instead-of-guix-confi.patch Content-Transfer-Encoding: quoted-printable >From d0f23078d1963f9aa8facda0fb3ae40e1e8c3cf2 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe 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-zli= b" 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 =3D \ 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 =3D \ 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 =3D \ tests/upstream.scm \ tests/utils.scm \ tests/uuid.scm \ - tests/workers.scm \ - tests/zlib.scm + tests/workers.scm =20 SH_TESTS =3D \ 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))) =20 -(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"))))))) =20 ;;; 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" !=3D "xye= s"; then AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install i= t.]) fi =20 +dnl Check for Guile-zlib. +GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) +if test "x$have_guile_zlib" !=3D "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" !=3D "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)]) =20 @@ -245,27 +257,6 @@ esac AC_SUBST([LIBGCRYPT_PREFIX]) AC_SUBST([LIBGCRYPT_LIBDIR]) =20 -dnl Library name of zlib suitable for 'dynamic-link'. -GUIX_LIBZ_LIBDIR([libz_libdir]) -if test "x$libz_libdir" =3D "x"; then - LIBZ=3D"libz" -else - LIBZ=3D"$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" =3D "x"; then - LIBLZ=3D"liblz" -else - # Strip the .so or .so.1 extension since that's what 'dynamic-link' expe= cts. - LIBLZ=3D"`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}, ver= sion 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 =20 diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-man= agement.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-loca= les")) (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) =20 @@ -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 substit= ute' - ("sqlite" ,sqlite) ("libgcrypt" ,libgcrypt) =20 @@ -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))) =20 (home-page "https://www.gnu.org/software/guix/") (synopsis "Functional package manager for installed software package= s 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 =20 %system - %libz - %liblz %gzip %bzip2 %xz)) @@ -88,12 +86,6 @@ (define %system "@guix_system@") =20 -(define %libz - "@LIBZ@") - -(define %liblz - "@LIBLZ@") - (define %gzip "@GZIP@") =20 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 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)) =20 (define modules - (cons `((guix config) =3D> ,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)) =20 - (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)))))) =20 (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))))) =20 - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - (define guile-json (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3)) =20 + (define guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) + (define gnutls (module-ref (resolve-interface '(gnu packages tls)) 'gnutls)) =20 - (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) =3D> ,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))))) =20 (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 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)) =20 (define modules - (cons `((guix config) =3D> ,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))))) =20 (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)) =20 - (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)))))) =20 (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 =C2=A9 2019 Pierre Neidhardt -;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s -;;; -;;; 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 . - -(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 mult= iple -;;; 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 o= nly -;;; decompress the empty member and stop there, resulting in truncated out= put. - -;;; 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 - ;; Scheme counterpart of the 'LZ_Decoder' opaque type. - lz-decoder? - pointer->lz-decoder - lz-decoder->pointer - (lambda (obj port) - (format port "#" - (number->string (object-address obj) 16)))) - -(define-wrapped-pointer-type - ;; Scheme counterpart of the 'LZ_Encoder' opaque type. - lz-encoder? - pointer->lz-encoder - lz-encoder->pointer - (lambda (obj port) - (format port "#" - (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) - - -;; 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 guar= antees - ;; a minimum range of 0..2^64-1. - (unlimited-size (- (expt 2 64) 1))) - (lambda* (dictionary-size match-length-limit #:optional (member-size u= nlimited-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-s= ize))) - (if (not (=3D (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 (=3D 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 (w= ith -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 re= ad -with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a n= ew -member can be started with 'lz-compress-restart-member'." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-finish (lz-compress-error enc= oder)) - ret))))) - -(define lz-compress-restart-member - (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* u= int64)))) - (lambda (encoder member-size) - "Start a new member in a multimember data stream. -Call this function only after `lz-compress-member-finished?' indicates tha= t the -current member has been fully read (with the `lz-compress-read' function)." - (let ((ret (proc (lz-encoder->pointer encoder) member-size))) - (if (=3D 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 w= ith -the `LZ-compress-write' function. First call `lz-compress-sync-flush'. T= hen -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 (=3D 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-le= ngth 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 (=3D ret -1) - (throw 'lzlib-error 'lz-compress-read (lz-compress-error encod= er)) - 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 enco= der)) - 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 (=3D 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-compres= s-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 (=3D 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 (=3D 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 (=3D 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 (=3D ret -1) - (throw 'lzlib-error 'lz-compress-total-out-size - (lz-compress-error encoder)) - ret))))) - - -;; 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 (=3D (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 (=3D 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 (w= ith -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 (=3D 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 buffe= rs -is discarded. Position counters are set to 0." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D 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 las= ts -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 retur= n 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 funct= ion -does nothing." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D 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-leng= th 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 i= nteger." - (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 d= ecoder)) - 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 acce= pt a -SIZE up to the returned number of bytes. " - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-e= rror 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-e= rror 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-decom= press-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 (=3D 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 (=3D 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 (=3D 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 perha= ps -not yet read, in the current member." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D 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 (=3D 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 (=3D 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 (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-total-out-size - (lz-decompress-error decoder)) - ret))))) - - -;; 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 TARGE= T, -possibly zero." - (define read - (if (> (lz-compress-write-size encoder) 0) - (match (lz-compress-write encoder source source-offset source-coun= t) - (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 (=3D 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-b= v))) - (put-bytevector lz-port lz-bv 0 rd) - (set! read (+ read rd)) - (unless (=3D rd 0) - (loop rd)))) - ;; `written' is the total byte count of uncompressed data. - written)) - - -;;; -;;; Port interface. -;;; - -;; Alist of (levels (dictionary-size match-length-limit)). 0 is the faste= st. -;; 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 PO= RT, -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 add= ed by `lz-compress-finish'. - (let ((lz-bv (make-bytevector (* 64 10= 24)))) - (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 (=3D rd 0) - (loop rd)))) - (lz-compress-close encoder) - (close-port port)))) - -(define* (make-lzip-input-port/compressed port - #:key - (level %default-compression-leve= l)) - "Return an input port that compresses data read from PORT, with the give= n 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))) - ((=3D 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 (=3D 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 i= t. -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. POR= T 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 . =20 (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)) =20 - (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)) =20 (define modules - (cons `((guix config) =3D> ,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))))) =20 (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; re= turn #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))) =20 (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")) =20 + (define guile-zlib + (specification->package "guile-zlib")) + + (define guile-lzlib + (specification->package "guile-lzlib")) + (define guile-gcrypt (specification->package "guile-gcrypt")) =20 @@ -757,7 +761,7 @@ Info manual." (cons (list "x" package) (package-transitive-propagated-inputs packa= ge))) (list guile-gcrypt gnutls guile-git guile-json - guile-ssh guile-sqlite3)) + guile-ssh guile-sqlite3 guile-zlib guile-lzli= b)) (((labels packages _ ...) ...) packages))) =20 @@ -884,9 +888,7 @@ Info manual." '() #:extra-modules `(((guix config) - =3D> ,(make-config.scm #:zlib zlib - #:lzlib lzlib - #:gzip gzip + =3D> ,(make-config.scm #:gzip gzip #:bzip2 bzip2 #:xz xz #:package-name @@ -983,7 +985,7 @@ Info manual." (variables rest ...)))))) (variables %localstatedir %storedir %sysconfdir))) =20 -(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")))) =20 ;; Guile 2.0 *requires* the 'define-module' to be at the ;; top-level or the 'toplevel-ref' in the resulting .go fil= e 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 AR= GS. 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) '()))) =20 (define (decompressed-port compression input) "Return an input port where INPUT is decompressed according to COMPRESSI= ON, 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 =C2=A9 2016, 2017 Ludovic Court=C3=A8s -;;; -;;; 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 . - -(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 - ;; Scheme counterpart of the 'gzFile' opaque type. - gzip-file? - pointer->gzip-file - gzip-file->pointer - (lambda (obj port) - (format port "#" - (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' al= so -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 (<=3D 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))))))) - - - -;;; -;;; Port interface. -;;; - -(define %default-buffer-size - ;; Default buffer size, as documented in . - 8192) - -(define %default-compression-level - ;; Z_DEFAULT_COMPRESSION. - -1) - -(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-siz= e)) - "Return an input port that decompresses data read from PORT, a file port. -PORT is automatically closed when the resulting port is closed. BUFFER-SI= ZE -is the size in bytes of the internal buffer, 8 KiB by default; using a lar= ger -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 ); calling 'close-port' af= ter - ;; 'gzclose' doesn't work either because it leads to a race conditi= on - ;; (see ). So we dup and close PORT ri= ght - ;; away. - (gzdopen (dup (fileno port)) "r")) - (_ - ;; This is unrecoverable but it's better than having the buffered i= nput - ;; be lost, leading to unclear end-of-file or corrupt-data errors d= own - ;; 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 (=3D 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 PO= RT, -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 (=3D 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-siz= e)) - "Call PROC with a port that wraps PORT and decompresses data read from i= t. -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. POR= T 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=3D"$guix_cv_libgcrypt_libdir" ]) =20 -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=3D"`$PKG_CONFIG zlib --variable=3Dlibdir 2> /dev/= null`"]) - $1=3D"$guix_cv_libz_libdir" -]) - -dnl GUIX_LIBLZ_FILE_NAME VAR -dnl -dnl Attempt to determine liblz's absolute file name; store the result in V= AR. -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=3D"$LIBS" - LIBS=3D"-llz" - AC_LINK_IFELSE([AC_LANG_SOURCE([int main () { return LZ_decompress_op= en(); }])], - [guix_cv_liblz_libdir=3D"`ldd conftest$EXEEXT | grep liblz | sed '-= es/.*=3D> \(.*\) .*$/\1/g'`"]) - LIBS=3D"$old_LIBS"]) - $1=3D"$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 =C2=A9 2019 Pierre Neidhardt -;;; -;;; 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 . - -(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" (byte= vector-length received)) - ;; The following loop is a debug helper. - (let loop ((i 0)) - (if (and (< i (bytevector-length received)) - (=3D (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=3D? 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 * d= ictionary)" - (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=3D? 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)))) =20 -(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)))) =20 -(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)))) =20 -(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)))) =20 -(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))))) =20 -(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))))) =20 -(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"))))) =20 -(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)))) =20 -(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))))))))) =20 -(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)))))))))) =20 -(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)) =20 (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-na= me)) #: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." =20 (for-each test-compression/decompression '(gzip xz lzip) - (list (const #t) (const #t) lzlib-available?)) + (list (const #t) (const #t) (const #t))) =20 ;; 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 =C2=A9 2016, 2019 Ludovic Court=C3=A8s -;;; -;;; 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 . - -(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=3D? received data)))))))))))) - -(test-end) --=20 2.26.2 --=-=-=--