|
@@ -39,7 +39,9 @@
|
|
|
crc32
|
|
|
|
|
|
make-zlib-input-port
|
|
|
- make-zlib-output-port))
|
|
|
+ make-zlib-output-port
|
|
|
+ call-with-zlib-input-port
|
|
|
+ call-with-zlib-output-port))
|
|
|
|
|
|
;;; Commentary:
|
|
|
;;;
|
|
@@ -193,8 +195,8 @@ buffered input, which would be lost (and is lost anyway)."
|
|
|
(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."
|
|
|
+a file port, as its sink. PORT must be a file port; it is automatically
|
|
|
+closed when the resulting port is closed."
|
|
|
(define gzfile
|
|
|
(begin
|
|
|
(force-output port) ;empty PORT's buffer
|
|
@@ -215,8 +217,11 @@ port is closed."
|
|
|
(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."
|
|
|
+PORT must be a file port; it is closed upon completion. The gzip internal
|
|
|
+buffer size is set to BUFFER-SIZE bytes.
|
|
|
+
|
|
|
+See 'call-with-zlib-input-port' for a slightly slower variant that does not
|
|
|
+require PORT to be a file port."
|
|
|
(let ((gzip (make-gzip-input-port port #:buffer-size buffer-size)))
|
|
|
(dynamic-wind
|
|
|
(const #t)
|
|
@@ -229,9 +234,12 @@ BUFFER-SIZE bytes."
|
|
|
#: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."
|
|
|
+ "Call PROC with an output port that wraps PORT and compresses data. PORT
|
|
|
+must be a file port; it is closed upon completion. The gzip internal buffer
|
|
|
+size is set to BUFFER-SIZE bytes.
|
|
|
+
|
|
|
+See 'call-with-zlib-output-port' for a slightly slower variant that does not
|
|
|
+require PORT to be a file port."
|
|
|
(let ((gzip (make-gzip-output-port port
|
|
|
#:level level
|
|
|
#:buffer-size buffer-size)))
|
|
@@ -500,19 +508,33 @@ struct's fields."
|
|
|
(lambda (stream flush)
|
|
|
(proc stream flush))))
|
|
|
|
|
|
+(define (window-bits-for-format format)
|
|
|
+ ;; Search for "windowBits" in <zlib.h>.
|
|
|
+ (define MAX_WBITS 15) ;<zconf.h>
|
|
|
+ (match format
|
|
|
+ ('deflate (- MAX_WBITS)) ;raw deflate
|
|
|
+ ('zlib MAX_WBITS) ;zlib header
|
|
|
+ ('gzip (+ MAX_WBITS 16)))) ;gzip header
|
|
|
+
|
|
|
(define inflate-init!
|
|
|
- (let ((proc (zlib-procedure int "inflateInit_" `(* * ,int))))
|
|
|
- (lambda (stream)
|
|
|
- (let ((ret (proc stream
|
|
|
+ (let ((proc (zlib-procedure int "inflateInit2_" `(* ,int * ,int))))
|
|
|
+ (lambda (stream window-bits)
|
|
|
+ (let ((ret (proc stream window-bits
|
|
|
(string->pointer %zlib-version)
|
|
|
(sizeof %stream-struct))))
|
|
|
(unless (zero? ret)
|
|
|
(throw 'zlib-error 'inflate-init! ret))))))
|
|
|
|
|
|
(define deflate-init!
|
|
|
- (let ((proc (zlib-procedure int "deflateInit_" `(* ,int * ,int))))
|
|
|
- (lambda (stream level)
|
|
|
- (let ((ret (proc stream level
|
|
|
+ (let ((proc (zlib-procedure int "deflateInit2_" `(* ,int ,int ,int ,int
|
|
|
+ ,int * ,int))))
|
|
|
+ (lambda* (stream level
|
|
|
+ #:key
|
|
|
+ (window-bits (window-bits-for-format 'zlib))
|
|
|
+ (memory-level 8)
|
|
|
+ (strategy Z_DEFAULT_STRATEGY))
|
|
|
+ (let ((ret (proc stream level Z_DEFLATED
|
|
|
+ window-bits memory-level strategy
|
|
|
(string->pointer %zlib-version)
|
|
|
(sizeof %stream-struct))))
|
|
|
(unless (zero? ret)
|
|
@@ -549,12 +571,19 @@ struct's fields."
|
|
|
(define Z_FULL_FLUSH 3)
|
|
|
(define Z_FINISH 4)
|
|
|
|
|
|
+;; 'deflate-init!' flags.
|
|
|
+(define Z_DEFLATED 8)
|
|
|
+(define Z_DEFAULT_STRATEGY 0)
|
|
|
|
|
|
(define* (make-zlib-input-port port
|
|
|
#:key
|
|
|
+ (format 'zlib)
|
|
|
(buffer-size %default-buffer-size)
|
|
|
(close? #t))
|
|
|
- "Return an input port that decompresses data read from PORT.
|
|
|
+ "Return an input port that decompresses data read from PORT. FORMAT is a
|
|
|
+symbol denoting the header format; it must be one of 'deflate (RFC 1950),
|
|
|
+'zlib (RFC 1951), or 'gzip (RFC 1952).
|
|
|
+
|
|
|
When CLOSE? is true, PORT is automatically closed when the resulting port is
|
|
|
closed."
|
|
|
(define input-buffer (make-bytevector buffer-size))
|
|
@@ -632,18 +661,26 @@ closed."
|
|
|
;; No need for extra buffering.
|
|
|
(setvbuf result 'none)
|
|
|
|
|
|
- (inflate-init! (pointer stream))
|
|
|
+ (inflate-init! (pointer stream)
|
|
|
+ (window-bits-for-format format))
|
|
|
(set-stream-avail-in! stream 0)
|
|
|
result)
|
|
|
|
|
|
(define* (make-zlib-output-port port
|
|
|
#:key
|
|
|
+ (format 'zlib)
|
|
|
(buffer-size %default-buffer-size)
|
|
|
(level %default-compression-level)
|
|
|
(close? #t))
|
|
|
"Return an output port that compresses data at the given LEVEL, using PORT
|
|
|
-as its sink. When CLOSE? is true, PORT is automatically closed when the
|
|
|
-resulting port is closed."
|
|
|
+as its sink. FORMAT is a symbol denoting the header format; it must be one
|
|
|
+of 'deflate (RFC 1950), 'zlib (RFC 1951), or 'gzip (RFC 1952).
|
|
|
+
|
|
|
+When FORMAT is 'gzip, the gzip header takes default values, and in particular
|
|
|
+no modification time and no file name.
|
|
|
+
|
|
|
+When CLOSE? is true, PORT is automatically closed when the resulting port is
|
|
|
+closed."
|
|
|
(define output-buffer (make-bytevector buffer-size))
|
|
|
(define stream (make-bytevector (sizeof %stream-struct)))
|
|
|
|
|
@@ -696,7 +733,8 @@ resulting port is closed."
|
|
|
(when close?
|
|
|
(close-port port)))
|
|
|
|
|
|
- (deflate-init! (pointer stream) level)
|
|
|
+ (deflate-init! (pointer stream) level
|
|
|
+ #:window-bits (window-bits-for-format format))
|
|
|
|
|
|
(set-stream-avail-out! stream buffer-size)
|
|
|
(set-stream-next-out! stream
|
|
@@ -704,4 +742,42 @@ resulting port is closed."
|
|
|
|
|
|
(make-custom-binary-output-port "zlib-output" write! #f #f close))
|
|
|
|
|
|
+(define* (call-with-zlib-input-port port proc
|
|
|
+ #:key
|
|
|
+ (format 'zlib)
|
|
|
+ (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 zlib internal buffer size is set to
|
|
|
+BUFFER-SIZE bytes."
|
|
|
+ (let ((zlib (make-zlib-input-port port
|
|
|
+ #:format format
|
|
|
+ #:buffer-size buffer-size
|
|
|
+ #:close? #t)))
|
|
|
+ (dynamic-wind
|
|
|
+ (const #t)
|
|
|
+ (lambda ()
|
|
|
+ (proc zlib))
|
|
|
+ (lambda ()
|
|
|
+ (close-port zlib)))))
|
|
|
+
|
|
|
+(define* (call-with-zlib-output-port port proc
|
|
|
+ #:key
|
|
|
+ (format 'zlib)
|
|
|
+ (level %default-compression-level)
|
|
|
+ (buffer-size %default-buffer-size))
|
|
|
+ "Call PROC with an output port that wraps PORT and compresses data in the
|
|
|
+given FORMAT, with the given LEVEL. PORT is closed upon completion. The
|
|
|
+zlib internal buffer size is set to BUFFER-SIZE bytes."
|
|
|
+ (let ((zlib (make-zlib-output-port port
|
|
|
+ #:format format
|
|
|
+ #:level level
|
|
|
+ #:buffer-size buffer-size
|
|
|
+ #:close? #t)))
|
|
|
+ (dynamic-wind
|
|
|
+ (const #t)
|
|
|
+ (lambda ()
|
|
|
+ (proc zlib))
|
|
|
+ (lambda ()
|
|
|
+ (close-port zlib)))))
|
|
|
+
|
|
|
;;; zlib.scm ends here
|