1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
;;; Zlib bindings, adapted from Guile-zlib
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
;;; Copyright © 2020 GNUnet e.V.
;;;
;;; This file is part of Guile-zlib.
;;;
;;; Guile-zlib 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.
;;;
;;; Guile-zlib 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 Guile-zlib. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;
;;; This file is extracted from Guile-zlib, which was extracted from Guix
;;; and originally writen by Ludovic Courtès.
;;; Bindings to the gzip-related part of zlib's API. The main limitation of
;;; this API is that it requires a bytevector as the source or sink.
;;;
;;; Code:
(library (gnu gnunet utils decompress)
(export decompress)
(import (system foreign)
(only (guile) dynamic-link false-if-exception
dynamic-func)
(only (ice-9 match) match)
(only (srfi srfi-45) delay force)
(only (zlib config) %libz)
(rnrs base)
(rnrs control)
(rnrs exceptions)
(rnrs bytevectors)
(rnrs conditions))
(define %zlib
(delay (dynamic-link %libz)))
(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-condition-type &z-error &error
make-z-error z-error?)
(define-condition-type &z-oom-error &z-error
make-z-oom-error z-oom-error?)
(define-condition-type &z-buf-error &z-error
make-z-buf-error z-buf-error?)
(define-condition-type &z-data-error &z-error
make-z-data-error z-data-error?)
(define-condition-type &z-bogus-error &violation
make-z-bogus-error z-bogus-error?
(value z-bogus-error-value))
(define Z_OK 0)
(define Z_DATA_ERROR -3)
(define Z_MEM_ERROR -4)
(define Z_BUF_ERROR -5)
(define uncompress!
(let ((proc (zlib-procedure int "uncompress" `(* * * ,unsigned-long))))
(lambda (dest-bv dest-offset dest-length
source-bv source-offset source-length)
"Uncompress the source buffer into the destination buffer.
Return the actual buffer size on success, raise an appropriate
&z-error otherwise.
&z-oom-error: out of memory
&z-data-error: corrupted or incomplete data
&z-buf-error: output buffer too small
@var{dest-bv}: destination buffer, as a bytevector
@var{dest-offset}: position of the first byte in @var{dest-bv}
@var{dest-length}: size of @var{dest-bv}. Possibly more than
strictly required."
;; Verify bounds
(assert (and (exact? dest-offset)
(integer? dest-offset)))
(assert (and (exact? dest-length)
(integer? dest-length)))
(assert (and (exact? source-offset)
(integer? source-offset)))
(assert (and (exact? source-length)
(integer? source-length)))
(assert (and (<= 0 dest-offset)
(<= dest-offset (bytevector-length dest-bv))))
(assert (and (<= 0 source-offset)
(<= source-offset (bytevector-length source-bv))))
(assert (and (<= (+ source-offset source-length)
(bytevector-length source-bv))))
(assert (and (<= (+ dest-offset dest-length)
(bytevector-length dest-bv))))
(let* ((dest-len-buf
(make-c-struct `(,unsigned-long) `(,dest-length)))
(ret (proc (bytevector->pointer dest-bv dest-offset)
dest-len-buf
(bytevector->pointer source-bv source-offset)
source-length)))
(cond ((= ret Z_OK)
(list-ref (parse-c-struct dest-len-buf `(,unsigned-long))
0))
((= ret Z_MEM_ERROR) (raise (make-z-oom-error)))
((= ret Z_BUF_ERROR) (raise (make-z-buf-error)))
((= ret Z_DATA_ERROR) (raise (make-z-data-error)))
(else (raise
(condition
(make-z-bogus-error ret)
(make-message-condition "bogus zlib error value")
(make-who-condition 'uncompress!)))))))))
(define decompress
(case-lambda
"Uncompress a bytevector with deflate"
((input-size output-size input-bv)
(decompress input-size output-size input-bv 0))
((input-size output-size input-bv input-offset)
"Decompress a source buffer
Return the decompressed buffer as a fresh bytevector.
In case the input is invalid, return #f"
(guard (ex ((z-buf-error? ex) #f)
((z-data-error? ex) #f))
(let* ((bv (make-bytevector output-size))
(bv-used (uncompress! bv 0 output-size input-bv input-offset
input-size)))
(and (= bv-used output-size)
bv)))))))
|
