From 4c0c65acfade63ce0549115d19db4b639c1e9992 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 27 Jul 2020 16:36:39 +0200 Subject: 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-zlib" and "guile-lzlib", [inputs]: remove "zlib" and "lzlib", [propagated-inputs]: ditto, [arguments]: add "guile-zlib" and "guile-lzlib" to Guile load path. * guix/config.scm.in (%libz, %liblz): Remove them. * 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. --- guix/zlib.scm | 241 ---------------------------------------------------------- 1 file changed, 241 deletions(-) delete mode 100644 guix/zlib.scm (limited to 'guix/zlib.scm') 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 © 2016, 2017 Ludovic Courtès -;;; -;;; 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' also -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 (<= 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-size)) - "Return an input port that decompresses data read from PORT, a file port. -PORT is automatically closed when the resulting port is closed. BUFFER-SIZE -is the size in bytes of the internal buffer, 8 KiB by default; using a larger -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' after - ;; 'gzclose' doesn't work either because it leads to a race condition - ;; (see ). So we dup and close PORT right - ;; away. - (gzdopen (dup (fileno port)) "r")) - (_ - ;; This is unrecoverable but it's better than having the buffered input - ;; be lost, leading to unclear end-of-file or corrupt-data errors down - ;; 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 (= 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 PORT, -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 (= 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-size)) - "Call PROC with a port that wraps PORT and decompresses data read from it. -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. PORT 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 -- cgit v1.2.3