]>
Commit | Line | Data |
---|---|---|
7c673cae FG |
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.31 2004/09/06 06:53:19 vagul 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; |