1 | ----------------------------------------------------------------
|
---|
2 | -- ZLib for Ada thick binding. --
|
---|
3 | -- --
|
---|
4 | -- Copyright (C) 2002-2004 Dmitriy Anisimkov --
|
---|
5 | -- --
|
---|
6 | -- Open source license information is in the zlib.ads file. --
|
---|
7 | ----------------------------------------------------------------
|
---|
8 |
|
---|
9 | -- $Id: zlib.adb,v 1.1 2005/09/23 22:39:01 beng Exp $
|
---|
10 |
|
---|
11 | with Ada.Exceptions;
|
---|
12 | with Ada.Unchecked_Conversion;
|
---|
13 | with Ada.Unchecked_Deallocation;
|
---|
14 |
|
---|
15 | with Interfaces.C.Strings;
|
---|
16 |
|
---|
17 | with ZLib.Thin;
|
---|
18 |
|
---|
19 | package body ZLib is
|
---|
20 |
|
---|
21 | use type Thin.Int;
|
---|
22 |
|
---|
23 | type Z_Stream is new Thin.Z_Stream;
|
---|
24 |
|
---|
25 | type Return_Code_Enum is
|
---|
26 | (OK,
|
---|
27 | STREAM_END,
|
---|
28 | NEED_DICT,
|
---|
29 | ERRNO,
|
---|
30 | STREAM_ERROR,
|
---|
31 | DATA_ERROR,
|
---|
32 | MEM_ERROR,
|
---|
33 | BUF_ERROR,
|
---|
34 | VERSION_ERROR);
|
---|
35 |
|
---|
36 | type Flate_Step_Function is access
|
---|
37 | function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
|
---|
38 | pragma Convention (C, Flate_Step_Function);
|
---|
39 |
|
---|
40 | type Flate_End_Function is access
|
---|
41 | function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
|
---|
42 | pragma Convention (C, Flate_End_Function);
|
---|
43 |
|
---|
44 | type Flate_Type is record
|
---|
45 | Step : Flate_Step_Function;
|
---|
46 | Done : Flate_End_Function;
|
---|
47 | end record;
|
---|
48 |
|
---|
49 | subtype Footer_Array is Stream_Element_Array (1 .. 8);
|
---|
50 |
|
---|
51 | Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
|
---|
52 | := (16#1f#, 16#8b#, -- Magic header
|
---|
53 | 16#08#, -- Z_DEFLATED
|
---|
54 | 16#00#, -- Flags
|
---|
55 | 16#00#, 16#00#, 16#00#, 16#00#, -- Time
|
---|
56 | 16#00#, -- XFlags
|
---|
57 | 16#03# -- OS code
|
---|
58 | );
|
---|
59 | -- The simplest gzip header is not for informational, but just for
|
---|
60 | -- gzip format compatibility.
|
---|
61 | -- Note that some code below is using assumption
|
---|
62 | -- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
|
---|
63 | -- Simple_GZip_Header'Last <= Footer_Array'Last.
|
---|
64 |
|
---|
65 | Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
|
---|
66 | := (0 => OK,
|
---|
67 | 1 => STREAM_END,
|
---|
68 | 2 => NEED_DICT,
|
---|
69 | -1 => ERRNO,
|
---|
70 | -2 => STREAM_ERROR,
|
---|
71 | -3 => DATA_ERROR,
|
---|
72 | -4 => MEM_ERROR,
|
---|
73 | -5 => BUF_ERROR,
|
---|
74 | -6 => VERSION_ERROR);
|
---|
75 |
|
---|
76 | Flate : constant array (Boolean) of Flate_Type
|
---|
77 | := (True => (Step => Thin.Deflate'Access,
|
---|
78 | Done => Thin.DeflateEnd'Access),
|
---|
79 | False => (Step => Thin.Inflate'Access,
|
---|
80 | Done => Thin.InflateEnd'Access));
|
---|
81 |
|
---|
82 | Flush_Finish : constant array (Boolean) of Flush_Mode
|
---|
83 | := (True => Finish, False => No_Flush);
|
---|
84 |
|
---|
85 | procedure Raise_Error (Stream : in Z_Stream);
|
---|
86 | pragma Inline (Raise_Error);
|
---|
87 |
|
---|
88 | procedure Raise_Error (Message : in String);
|
---|
89 | pragma Inline (Raise_Error);
|
---|
90 |
|
---|
91 | procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
|
---|
92 |
|
---|
93 | procedure Free is new Ada.Unchecked_Deallocation
|
---|
94 | (Z_Stream, Z_Stream_Access);
|
---|
95 |
|
---|
96 | function To_Thin_Access is new Ada.Unchecked_Conversion
|
---|
97 | (Z_Stream_Access, Thin.Z_Streamp);
|
---|
98 |
|
---|
99 | procedure Translate_GZip
|
---|
100 | (Filter : in out Filter_Type;
|
---|
101 | In_Data : in Ada.Streams.Stream_Element_Array;
|
---|
102 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
103 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
104 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
105 | Flush : in Flush_Mode);
|
---|
106 | -- Separate translate routine for make gzip header.
|
---|
107 |
|
---|
108 | procedure Translate_Auto
|
---|
109 | (Filter : in out Filter_Type;
|
---|
110 | In_Data : in Ada.Streams.Stream_Element_Array;
|
---|
111 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
112 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
113 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
114 | Flush : in Flush_Mode);
|
---|
115 | -- translate routine without additional headers.
|
---|
116 |
|
---|
117 | -----------------
|
---|
118 | -- Check_Error --
|
---|
119 | -----------------
|
---|
120 |
|
---|
121 | procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
|
---|
122 | use type Thin.Int;
|
---|
123 | begin
|
---|
124 | if Code /= Thin.Z_OK then
|
---|
125 | Raise_Error
|
---|
126 | (Return_Code_Enum'Image (Return_Code (Code))
|
---|
127 | & ": " & Last_Error_Message (Stream));
|
---|
128 | end if;
|
---|
129 | end Check_Error;
|
---|
130 |
|
---|
131 | -----------
|
---|
132 | -- Close --
|
---|
133 | -----------
|
---|
134 |
|
---|
135 | procedure Close
|
---|
136 | (Filter : in out Filter_Type;
|
---|
137 | Ignore_Error : in Boolean := False)
|
---|
138 | is
|
---|
139 | Code : Thin.Int;
|
---|
140 | begin
|
---|
141 | if not Ignore_Error and then not Is_Open (Filter) then
|
---|
142 | raise Status_Error;
|
---|
143 | end if;
|
---|
144 |
|
---|
145 | Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
|
---|
146 |
|
---|
147 | if Ignore_Error or else Code = Thin.Z_OK then
|
---|
148 | Free (Filter.Strm);
|
---|
149 | else
|
---|
150 | declare
|
---|
151 | Error_Message : constant String
|
---|
152 | := Last_Error_Message (Filter.Strm.all);
|
---|
153 | begin
|
---|
154 | Free (Filter.Strm);
|
---|
155 | Ada.Exceptions.Raise_Exception
|
---|
156 | (ZLib_Error'Identity,
|
---|
157 | Return_Code_Enum'Image (Return_Code (Code))
|
---|
158 | & ": " & Error_Message);
|
---|
159 | end;
|
---|
160 | end if;
|
---|
161 | end Close;
|
---|
162 |
|
---|
163 | -----------
|
---|
164 | -- CRC32 --
|
---|
165 | -----------
|
---|
166 |
|
---|
167 | function CRC32
|
---|
168 | (CRC : in Unsigned_32;
|
---|
169 | Data : in Ada.Streams.Stream_Element_Array)
|
---|
170 | return Unsigned_32
|
---|
171 | is
|
---|
172 | use Thin;
|
---|
173 | begin
|
---|
174 | return Unsigned_32 (crc32 (ULong (CRC),
|
---|
175 | Data'Address,
|
---|
176 | Data'Length));
|
---|
177 | end CRC32;
|
---|
178 |
|
---|
179 | procedure CRC32
|
---|
180 | (CRC : in out Unsigned_32;
|
---|
181 | Data : in Ada.Streams.Stream_Element_Array) is
|
---|
182 | begin
|
---|
183 | CRC := CRC32 (CRC, Data);
|
---|
184 | end CRC32;
|
---|
185 |
|
---|
186 | ------------------
|
---|
187 | -- Deflate_Init --
|
---|
188 | ------------------
|
---|
189 |
|
---|
190 | procedure Deflate_Init
|
---|
191 | (Filter : in out Filter_Type;
|
---|
192 | Level : in Compression_Level := Default_Compression;
|
---|
193 | Strategy : in Strategy_Type := Default_Strategy;
|
---|
194 | Method : in Compression_Method := Deflated;
|
---|
195 | Window_Bits : in Window_Bits_Type := Default_Window_Bits;
|
---|
196 | Memory_Level : in Memory_Level_Type := Default_Memory_Level;
|
---|
197 | Header : in Header_Type := Default)
|
---|
198 | is
|
---|
199 | use type Thin.Int;
|
---|
200 | Win_Bits : Thin.Int := Thin.Int (Window_Bits);
|
---|
201 | begin
|
---|
202 | if Is_Open (Filter) then
|
---|
203 | raise Status_Error;
|
---|
204 | end if;
|
---|
205 |
|
---|
206 | -- We allow ZLib to make header only in case of default header type.
|
---|
207 | -- Otherwise we would either do header by ourselfs, or do not do
|
---|
208 | -- header at all.
|
---|
209 |
|
---|
210 | if Header = None or else Header = GZip then
|
---|
211 | Win_Bits := -Win_Bits;
|
---|
212 | end if;
|
---|
213 |
|
---|
214 | -- For the GZip CRC calculation and make headers.
|
---|
215 |
|
---|
216 | if Header = GZip then
|
---|
217 | Filter.CRC := 0;
|
---|
218 | Filter.Offset := Simple_GZip_Header'First;
|
---|
219 | else
|
---|
220 | Filter.Offset := Simple_GZip_Header'Last + 1;
|
---|
221 | end if;
|
---|
222 |
|
---|
223 | Filter.Strm := new Z_Stream;
|
---|
224 | Filter.Compression := True;
|
---|
225 | Filter.Stream_End := False;
|
---|
226 | Filter.Header := Header;
|
---|
227 |
|
---|
228 | if Thin.Deflate_Init
|
---|
229 | (To_Thin_Access (Filter.Strm),
|
---|
230 | Level => Thin.Int (Level),
|
---|
231 | method => Thin.Int (Method),
|
---|
232 | windowBits => Win_Bits,
|
---|
233 | memLevel => Thin.Int (Memory_Level),
|
---|
234 | strategy => Thin.Int (Strategy)) /= Thin.Z_OK
|
---|
235 | then
|
---|
236 | Raise_Error (Filter.Strm.all);
|
---|
237 | end if;
|
---|
238 | end Deflate_Init;
|
---|
239 |
|
---|
240 | -----------
|
---|
241 | -- Flush --
|
---|
242 | -----------
|
---|
243 |
|
---|
244 | procedure Flush
|
---|
245 | (Filter : in out Filter_Type;
|
---|
246 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
247 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
248 | Flush : in Flush_Mode)
|
---|
249 | is
|
---|
250 | No_Data : Stream_Element_Array := (1 .. 0 => 0);
|
---|
251 | Last : Stream_Element_Offset;
|
---|
252 | begin
|
---|
253 | Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
|
---|
254 | end Flush;
|
---|
255 |
|
---|
256 | -----------------------
|
---|
257 | -- Generic_Translate --
|
---|
258 | -----------------------
|
---|
259 |
|
---|
260 | procedure Generic_Translate
|
---|
261 | (Filter : in out ZLib.Filter_Type;
|
---|
262 | In_Buffer_Size : in Integer := Default_Buffer_Size;
|
---|
263 | Out_Buffer_Size : in Integer := Default_Buffer_Size)
|
---|
264 | is
|
---|
265 | In_Buffer : Stream_Element_Array
|
---|
266 | (1 .. Stream_Element_Offset (In_Buffer_Size));
|
---|
267 | Out_Buffer : Stream_Element_Array
|
---|
268 | (1 .. Stream_Element_Offset (Out_Buffer_Size));
|
---|
269 | Last : Stream_Element_Offset;
|
---|
270 | In_Last : Stream_Element_Offset;
|
---|
271 | In_First : Stream_Element_Offset;
|
---|
272 | Out_Last : Stream_Element_Offset;
|
---|
273 | begin
|
---|
274 | Main : loop
|
---|
275 | Data_In (In_Buffer, Last);
|
---|
276 |
|
---|
277 | In_First := In_Buffer'First;
|
---|
278 |
|
---|
279 | loop
|
---|
280 | Translate
|
---|
281 | (Filter => Filter,
|
---|
282 | In_Data => In_Buffer (In_First .. Last),
|
---|
283 | In_Last => In_Last,
|
---|
284 | Out_Data => Out_Buffer,
|
---|
285 | Out_Last => Out_Last,
|
---|
286 | Flush => Flush_Finish (Last < In_Buffer'First));
|
---|
287 |
|
---|
288 | if Out_Buffer'First <= Out_Last then
|
---|
289 | Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
|
---|
290 | end if;
|
---|
291 |
|
---|
292 | exit Main when Stream_End (Filter);
|
---|
293 |
|
---|
294 | -- The end of in buffer.
|
---|
295 |
|
---|
296 | exit when In_Last = Last;
|
---|
297 |
|
---|
298 | In_First := In_Last + 1;
|
---|
299 | end loop;
|
---|
300 | end loop Main;
|
---|
301 |
|
---|
302 | end Generic_Translate;
|
---|
303 |
|
---|
304 | ------------------
|
---|
305 | -- Inflate_Init --
|
---|
306 | ------------------
|
---|
307 |
|
---|
308 | procedure Inflate_Init
|
---|
309 | (Filter : in out Filter_Type;
|
---|
310 | Window_Bits : in Window_Bits_Type := Default_Window_Bits;
|
---|
311 | Header : in Header_Type := Default)
|
---|
312 | is
|
---|
313 | use type Thin.Int;
|
---|
314 | Win_Bits : Thin.Int := Thin.Int (Window_Bits);
|
---|
315 |
|
---|
316 | procedure Check_Version;
|
---|
317 | -- Check the latest header types compatibility.
|
---|
318 |
|
---|
319 | procedure Check_Version is
|
---|
320 | begin
|
---|
321 | if Version <= "1.1.4" then
|
---|
322 | Raise_Error
|
---|
323 | ("Inflate header type " & Header_Type'Image (Header)
|
---|
324 | & " incompatible with ZLib version " & Version);
|
---|
325 | end if;
|
---|
326 | end Check_Version;
|
---|
327 |
|
---|
328 | begin
|
---|
329 | if Is_Open (Filter) then
|
---|
330 | raise Status_Error;
|
---|
331 | end if;
|
---|
332 |
|
---|
333 | case Header is
|
---|
334 | when None =>
|
---|
335 | Check_Version;
|
---|
336 |
|
---|
337 | -- Inflate data without headers determined
|
---|
338 | -- by negative Win_Bits.
|
---|
339 |
|
---|
340 | Win_Bits := -Win_Bits;
|
---|
341 | when GZip =>
|
---|
342 | Check_Version;
|
---|
343 |
|
---|
344 | -- Inflate gzip data defined by flag 16.
|
---|
345 |
|
---|
346 | Win_Bits := Win_Bits + 16;
|
---|
347 | when Auto =>
|
---|
348 | Check_Version;
|
---|
349 |
|
---|
350 | -- Inflate with automatic detection
|
---|
351 | -- of gzip or native header defined by flag 32.
|
---|
352 |
|
---|
353 | Win_Bits := Win_Bits + 32;
|
---|
354 | when Default => null;
|
---|
355 | end case;
|
---|
356 |
|
---|
357 | Filter.Strm := new Z_Stream;
|
---|
358 | Filter.Compression := False;
|
---|
359 | Filter.Stream_End := False;
|
---|
360 | Filter.Header := Header;
|
---|
361 |
|
---|
362 | if Thin.Inflate_Init
|
---|
363 | (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
|
---|
364 | then
|
---|
365 | Raise_Error (Filter.Strm.all);
|
---|
366 | end if;
|
---|
367 | end Inflate_Init;
|
---|
368 |
|
---|
369 | -------------
|
---|
370 | -- Is_Open --
|
---|
371 | -------------
|
---|
372 |
|
---|
373 | function Is_Open (Filter : in Filter_Type) return Boolean is
|
---|
374 | begin
|
---|
375 | return Filter.Strm /= null;
|
---|
376 | end Is_Open;
|
---|
377 |
|
---|
378 | -----------------
|
---|
379 | -- Raise_Error --
|
---|
380 | -----------------
|
---|
381 |
|
---|
382 | procedure Raise_Error (Message : in String) is
|
---|
383 | begin
|
---|
384 | Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
|
---|
385 | end Raise_Error;
|
---|
386 |
|
---|
387 | procedure Raise_Error (Stream : in Z_Stream) is
|
---|
388 | begin
|
---|
389 | Raise_Error (Last_Error_Message (Stream));
|
---|
390 | end Raise_Error;
|
---|
391 |
|
---|
392 | ----------
|
---|
393 | -- Read --
|
---|
394 | ----------
|
---|
395 |
|
---|
396 | procedure Read
|
---|
397 | (Filter : in out Filter_Type;
|
---|
398 | Item : out Ada.Streams.Stream_Element_Array;
|
---|
399 | Last : out Ada.Streams.Stream_Element_Offset;
|
---|
400 | Flush : in Flush_Mode := No_Flush)
|
---|
401 | is
|
---|
402 | In_Last : Stream_Element_Offset;
|
---|
403 | Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
|
---|
404 | V_Flush : Flush_Mode := Flush;
|
---|
405 |
|
---|
406 | begin
|
---|
407 | pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
|
---|
408 | pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
|
---|
409 |
|
---|
410 | loop
|
---|
411 | if Rest_Last = Buffer'First - 1 then
|
---|
412 | V_Flush := Finish;
|
---|
413 |
|
---|
414 | elsif Rest_First > Rest_Last then
|
---|
415 | Read (Buffer, Rest_Last);
|
---|
416 | Rest_First := Buffer'First;
|
---|
417 |
|
---|
418 | if Rest_Last < Buffer'First then
|
---|
419 | V_Flush := Finish;
|
---|
420 | end if;
|
---|
421 | end if;
|
---|
422 |
|
---|
423 | Translate
|
---|
424 | (Filter => Filter,
|
---|
425 | In_Data => Buffer (Rest_First .. Rest_Last),
|
---|
426 | In_Last => In_Last,
|
---|
427 | Out_Data => Item (Item_First .. Item'Last),
|
---|
428 | Out_Last => Last,
|
---|
429 | Flush => V_Flush);
|
---|
430 |
|
---|
431 | Rest_First := In_Last + 1;
|
---|
432 |
|
---|
433 | exit when Stream_End (Filter)
|
---|
434 | or else Last = Item'Last
|
---|
435 | or else (Last >= Item'First and then Allow_Read_Some);
|
---|
436 |
|
---|
437 | Item_First := Last + 1;
|
---|
438 | end loop;
|
---|
439 | end Read;
|
---|
440 |
|
---|
441 | ----------------
|
---|
442 | -- Stream_End --
|
---|
443 | ----------------
|
---|
444 |
|
---|
445 | function Stream_End (Filter : in Filter_Type) return Boolean is
|
---|
446 | begin
|
---|
447 | if Filter.Header = GZip and Filter.Compression then
|
---|
448 | return Filter.Stream_End
|
---|
449 | and then Filter.Offset = Footer_Array'Last + 1;
|
---|
450 | else
|
---|
451 | return Filter.Stream_End;
|
---|
452 | end if;
|
---|
453 | end Stream_End;
|
---|
454 |
|
---|
455 | --------------
|
---|
456 | -- Total_In --
|
---|
457 | --------------
|
---|
458 |
|
---|
459 | function Total_In (Filter : in Filter_Type) return Count is
|
---|
460 | begin
|
---|
461 | return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
|
---|
462 | end Total_In;
|
---|
463 |
|
---|
464 | ---------------
|
---|
465 | -- Total_Out --
|
---|
466 | ---------------
|
---|
467 |
|
---|
468 | function Total_Out (Filter : in Filter_Type) return Count is
|
---|
469 | begin
|
---|
470 | return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
|
---|
471 | end Total_Out;
|
---|
472 |
|
---|
473 | ---------------
|
---|
474 | -- Translate --
|
---|
475 | ---------------
|
---|
476 |
|
---|
477 | procedure Translate
|
---|
478 | (Filter : in out Filter_Type;
|
---|
479 | In_Data : in Ada.Streams.Stream_Element_Array;
|
---|
480 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
481 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
482 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
483 | Flush : in Flush_Mode) is
|
---|
484 | begin
|
---|
485 | if Filter.Header = GZip and then Filter.Compression then
|
---|
486 | Translate_GZip
|
---|
487 | (Filter => Filter,
|
---|
488 | In_Data => In_Data,
|
---|
489 | In_Last => In_Last,
|
---|
490 | Out_Data => Out_Data,
|
---|
491 | Out_Last => Out_Last,
|
---|
492 | Flush => Flush);
|
---|
493 | else
|
---|
494 | Translate_Auto
|
---|
495 | (Filter => Filter,
|
---|
496 | In_Data => In_Data,
|
---|
497 | In_Last => In_Last,
|
---|
498 | Out_Data => Out_Data,
|
---|
499 | Out_Last => Out_Last,
|
---|
500 | Flush => Flush);
|
---|
501 | end if;
|
---|
502 | end Translate;
|
---|
503 |
|
---|
504 | --------------------
|
---|
505 | -- Translate_Auto --
|
---|
506 | --------------------
|
---|
507 |
|
---|
508 | procedure Translate_Auto
|
---|
509 | (Filter : in out Filter_Type;
|
---|
510 | In_Data : in Ada.Streams.Stream_Element_Array;
|
---|
511 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
512 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
513 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
514 | Flush : in Flush_Mode)
|
---|
515 | is
|
---|
516 | use type Thin.Int;
|
---|
517 | Code : Thin.Int;
|
---|
518 |
|
---|
519 | begin
|
---|
520 | if not Is_Open (Filter) then
|
---|
521 | raise Status_Error;
|
---|
522 | end if;
|
---|
523 |
|
---|
524 | if Out_Data'Length = 0 and then In_Data'Length = 0 then
|
---|
525 | raise Constraint_Error;
|
---|
526 | end if;
|
---|
527 |
|
---|
528 | Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
|
---|
529 | Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
|
---|
530 |
|
---|
531 | Code := Flate (Filter.Compression).Step
|
---|
532 | (To_Thin_Access (Filter.Strm),
|
---|
533 | Thin.Int (Flush));
|
---|
534 |
|
---|
535 | if Code = Thin.Z_STREAM_END then
|
---|
536 | Filter.Stream_End := True;
|
---|
537 | else
|
---|
538 | Check_Error (Filter.Strm.all, Code);
|
---|
539 | end if;
|
---|
540 |
|
---|
541 | In_Last := In_Data'Last
|
---|
542 | - Stream_Element_Offset (Avail_In (Filter.Strm.all));
|
---|
543 | Out_Last := Out_Data'Last
|
---|
544 | - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
|
---|
545 | end Translate_Auto;
|
---|
546 |
|
---|
547 | --------------------
|
---|
548 | -- Translate_GZip --
|
---|
549 | --------------------
|
---|
550 |
|
---|
551 | procedure Translate_GZip
|
---|
552 | (Filter : in out Filter_Type;
|
---|
553 | In_Data : in Ada.Streams.Stream_Element_Array;
|
---|
554 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
555 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
---|
556 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
---|
557 | Flush : in Flush_Mode)
|
---|
558 | is
|
---|
559 | Out_First : Stream_Element_Offset;
|
---|
560 |
|
---|
561 | procedure Add_Data (Data : in Stream_Element_Array);
|
---|
562 | -- Add data to stream from the Filter.Offset till necessary,
|
---|
563 | -- used for add gzip headr/footer.
|
---|
564 |
|
---|
565 | procedure Put_32
|
---|
566 | (Item : in out Stream_Element_Array;
|
---|
567 | Data : in Unsigned_32);
|
---|
568 | pragma Inline (Put_32);
|
---|
569 |
|
---|
570 | --------------
|
---|
571 | -- Add_Data --
|
---|
572 | --------------
|
---|
573 |
|
---|
574 | procedure Add_Data (Data : in Stream_Element_Array) is
|
---|
575 | Data_First : Stream_Element_Offset renames Filter.Offset;
|
---|
576 | Data_Last : Stream_Element_Offset;
|
---|
577 | Data_Len : Stream_Element_Offset; -- -1
|
---|
578 | Out_Len : Stream_Element_Offset; -- -1
|
---|
579 | begin
|
---|
580 | Out_First := Out_Last + 1;
|
---|
581 |
|
---|
582 | if Data_First > Data'Last then
|
---|
583 | return;
|
---|
584 | end if;
|
---|
585 |
|
---|
586 | Data_Len := Data'Last - Data_First;
|
---|
587 | Out_Len := Out_Data'Last - Out_First;
|
---|
588 |
|
---|
589 | if Data_Len <= Out_Len then
|
---|
590 | Out_Last := Out_First + Data_Len;
|
---|
591 | Data_Last := Data'Last;
|
---|
592 | else
|
---|
593 | Out_Last := Out_Data'Last;
|
---|
594 | Data_Last := Data_First + Out_Len;
|
---|
595 | end if;
|
---|
596 |
|
---|
597 | Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
|
---|
598 |
|
---|
599 | Data_First := Data_Last + 1;
|
---|
600 | Out_First := Out_Last + 1;
|
---|
601 | end Add_Data;
|
---|
602 |
|
---|
603 | ------------
|
---|
604 | -- Put_32 --
|
---|
605 | ------------
|
---|
606 |
|
---|
607 | procedure Put_32
|
---|
608 | (Item : in out Stream_Element_Array;
|
---|
609 | Data : in Unsigned_32)
|
---|
610 | is
|
---|
611 | D : Unsigned_32 := Data;
|
---|
612 | begin
|
---|
613 | for J in Item'First .. Item'First + 3 loop
|
---|
614 | Item (J) := Stream_Element (D and 16#FF#);
|
---|
615 | D := Shift_Right (D, 8);
|
---|
616 | end loop;
|
---|
617 | end Put_32;
|
---|
618 |
|
---|
619 | begin
|
---|
620 | Out_Last := Out_Data'First - 1;
|
---|
621 |
|
---|
622 | if not Filter.Stream_End then
|
---|
623 | Add_Data (Simple_GZip_Header);
|
---|
624 |
|
---|
625 | Translate_Auto
|
---|
626 | (Filter => Filter,
|
---|
627 | In_Data => In_Data,
|
---|
628 | In_Last => In_Last,
|
---|
629 | Out_Data => Out_Data (Out_First .. Out_Data'Last),
|
---|
630 | Out_Last => Out_Last,
|
---|
631 | Flush => Flush);
|
---|
632 |
|
---|
633 | CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
|
---|
634 | end if;
|
---|
635 |
|
---|
636 | if Filter.Stream_End and then Out_Last <= Out_Data'Last then
|
---|
637 | -- This detection method would work only when
|
---|
638 | -- Simple_GZip_Header'Last > Footer_Array'Last
|
---|
639 |
|
---|
640 | if Filter.Offset = Simple_GZip_Header'Last + 1 then
|
---|
641 | Filter.Offset := Footer_Array'First;
|
---|
642 | end if;
|
---|
643 |
|
---|
644 | declare
|
---|
645 | Footer : Footer_Array;
|
---|
646 | begin
|
---|
647 | Put_32 (Footer, Filter.CRC);
|
---|
648 | Put_32 (Footer (Footer'First + 4 .. Footer'Last),
|
---|
649 | Unsigned_32 (Total_In (Filter)));
|
---|
650 | Add_Data (Footer);
|
---|
651 | end;
|
---|
652 | end if;
|
---|
653 | end Translate_GZip;
|
---|
654 |
|
---|
655 | -------------
|
---|
656 | -- Version --
|
---|
657 | -------------
|
---|
658 |
|
---|
659 | function Version return String is
|
---|
660 | begin
|
---|
661 | return Interfaces.C.Strings.Value (Thin.zlibVersion);
|
---|
662 | end Version;
|
---|
663 |
|
---|
664 | -----------
|
---|
665 | -- Write --
|
---|
666 | -----------
|
---|
667 |
|
---|
668 | procedure Write
|
---|
669 | (Filter : in out Filter_Type;
|
---|
670 | Item : in Ada.Streams.Stream_Element_Array;
|
---|
671 | Flush : in Flush_Mode := No_Flush)
|
---|
672 | is
|
---|
673 | Buffer : Stream_Element_Array (1 .. Buffer_Size);
|
---|
674 | In_Last : Stream_Element_Offset;
|
---|
675 | Out_Last : Stream_Element_Offset;
|
---|
676 | In_First : Stream_Element_Offset := Item'First;
|
---|
677 | begin
|
---|
678 | if Item'Length = 0 and Flush = No_Flush then
|
---|
679 | return;
|
---|
680 | end if;
|
---|
681 |
|
---|
682 | loop
|
---|
683 | Translate
|
---|
684 | (Filter => Filter,
|
---|
685 | In_Data => Item (In_First .. Item'Last),
|
---|
686 | In_Last => In_Last,
|
---|
687 | Out_Data => Buffer,
|
---|
688 | Out_Last => Out_Last,
|
---|
689 | Flush => Flush);
|
---|
690 |
|
---|
691 | if Out_Last >= Buffer'First then
|
---|
692 | Write (Buffer (1 .. Out_Last));
|
---|
693 | end if;
|
---|
694 |
|
---|
695 | exit when In_Last = Item'Last or Stream_End (Filter);
|
---|
696 |
|
---|
697 | In_First := In_Last + 1;
|
---|
698 | end loop;
|
---|
699 | end Write;
|
---|
700 |
|
---|
701 | end ZLib;
|
---|