702 lines
20 KiB
Ada
702 lines
20 KiB
Ada
|
----------------------------------------------------------------
|
||
|
|
-- ZLib for Ada thick binding. --
|
||
|
|
-- --
|
||
|
|
-- Copyright (C) 2002-2004 Dmitriy Anisimkov --
|
||
|
|
-- --
|
||
|
|
-- Open source license information is in the zlib.ads file. --
|
||
|
|
----------------------------------------------------------------
|
||
|
|
|
||
|
|
-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $
|
||
|
|
|
||
|
|
with Ada.Exceptions;
|
||
|
|
with Ada.Unchecked_Conversion;
|
||
|
|
with Ada.Unchecked_Deallocation;
|
||
|
|
|
||
|
|
with Interfaces.C.Strings;
|
||
|
|
|
||
|
|
with ZLib.Thin;
|
||
|
|
|
||
|
|
package body ZLib is
|
||
|
|
|
||
|
|
use type Thin.Int;
|
||
|
|
|
||
|
|
type Z_Stream is new Thin.Z_Stream;
|
||
|
|
|
||
|
|
type Return_Code_Enum is
|
||
|
|
(OK,
|
||
|
|
STREAM_END,
|
||
|
|
NEED_DICT,
|
||
|
|
ERRNO,
|
||
|
|
STREAM_ERROR,
|
||
|
|
DATA_ERROR,
|
||
|
|
MEM_ERROR,
|
||
|
|
BUF_ERROR,
|
||
|
|
VERSION_ERROR);
|
||
|
|
|
||
|
|
type Flate_Step_Function is access
|
||
|
|
function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
|
||
|
|
pragma Convention (C, Flate_Step_Function);
|
||
|
|
|
||
|
|
type Flate_End_Function is access
|
||
|
|
function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
|
||
|
|
pragma Convention (C, Flate_End_Function);
|
||
|
|
|
||
|
|
type Flate_Type is record
|
||
|
|
Step : Flate_Step_Function;
|
||
|
|
Done : Flate_End_Function;
|
||
|
|
end record;
|
||
|
|
|
||
|
|
subtype Footer_Array is Stream_Element_Array (1 .. 8);
|
||
|
|
|
||
|
|
Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
|
||
|
|
:= (16#1f#, 16#8b#, -- Magic header
|
||
|
|
16#08#, -- Z_DEFLATED
|
||
|
|
16#00#, -- Flags
|
||
|
|
16#00#, 16#00#, 16#00#, 16#00#, -- Time
|
||
|
|
16#00#, -- XFlags
|
||
|
|
16#03# -- OS code
|
||
|
|
);
|
||
|
|
-- The simplest gzip header is not for informational, but just for
|
||
|
|
-- gzip format compatibility.
|
||
|
|
-- Note that some code below is using assumption
|
||
|
|
-- Simple_GZip_Header'Last > Footer_Array'Last, so do not make
|
||
|
|
-- Simple_GZip_Header'Last <= Footer_Array'Last.
|
||
|
|
|
||
|
|
Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
|
||
|
|
:= (0 => OK,
|
||
|
|
1 => STREAM_END,
|
||
|
|
2 => NEED_DICT,
|
||
|
|
-1 => ERRNO,
|
||
|
|
-2 => STREAM_ERROR,
|
||
|
|
-3 => DATA_ERROR,
|
||
|
|
-4 => MEM_ERROR,
|
||
|
|
-5 => BUF_ERROR,
|
||
|
|
-6 => VERSION_ERROR);
|
||
|
|
|
||
|
|
Flate : constant array (Boolean) of Flate_Type
|
||
|
|
:= (True => (Step => Thin.Deflate'Access,
|
||
|
|
Done => Thin.DeflateEnd'Access),
|
||
|
|
False => (Step => Thin.Inflate'Access,
|
||
|
|
Done => Thin.InflateEnd'Access));
|
||
|
|
|
||
|
|
Flush_Finish : constant array (Boolean) of Flush_Mode
|
||
|
|
:= (True => Finish, False => No_Flush);
|
||
|
|
|
||
|
|
procedure Raise_Error (Stream : in Z_Stream);
|
||
|
|
pragma Inline (Raise_Error);
|
||
|
|
|
||
|
|
procedure Raise_Error (Message : in String);
|
||
|
|
pragma Inline (Raise_Error);
|
||
|
|
|
||
|
|
procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);
|
||
|
|
|
||
|
|
procedure Free is new Ada.Unchecked_Deallocation
|
||
|
|
(Z_Stream, Z_Stream_Access);
|
||
|
|
|
||
|
|
function To_Thin_Access is new Ada.Unchecked_Conversion
|
||
|
|
(Z_Stream_Access, Thin.Z_Streamp);
|
||
|
|
|
||
|
|
procedure Translate_GZip
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
In_Data : in Ada.Streams.Stream_Element_Array;
|
||
|
|
In_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode);
|
||
|
|
-- Separate translate routine for make gzip header.
|
||
|
|
|
||
|
|
procedure Translate_Auto
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
In_Data : in Ada.Streams.Stream_Element_Array;
|
||
|
|
In_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode);
|
||
|
|
-- translate routine without additional headers.
|
||
|
|
|
||
|
|
-----------------
|
||
|
|
-- Check_Error --
|
||
|
|
-----------------
|
||
|
|
|
||
|
|
procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
|
||
|
|
use type Thin.Int;
|
||
|
|
begin
|
||
|
|
if Code /= Thin.Z_OK then
|
||
|
|
Raise_Error
|
||
|
|
(Return_Code_Enum'Image (Return_Code (Code))
|
||
|
|
& ": " & Last_Error_Message (Stream));
|
||
|
|
end if;
|
||
|
|
end Check_Error;
|
||
|
|
|
||
|
|
-----------
|
||
|
|
-- Close --
|
||
|
|
-----------
|
||
|
|
|
||
|
|
procedure Close
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Ignore_Error : in Boolean := False)
|
||
|
|
is
|
||
|
|
Code : Thin.Int;
|
||
|
|
begin
|
||
|
|
if not Ignore_Error and then not Is_Open (Filter) then
|
||
|
|
raise Status_Error;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));
|
||
|
|
|
||
|
|
if Ignore_Error or else Code = Thin.Z_OK then
|
||
|
|
Free (Filter.Strm);
|
||
|
|
else
|
||
|
|
declare
|
||
|
|
Error_Message : constant String
|
||
|
|
:= Last_Error_Message (Filter.Strm.all);
|
||
|
|
begin
|
||
|
|
Free (Filter.Strm);
|
||
|
|
Ada.Exceptions.Raise_Exception
|
||
|
|
(ZLib_Error'Identity,
|
||
|
|
Return_Code_Enum'Image (Return_Code (Code))
|
||
|
|
& ": " & Error_Message);
|
||
|
|
end;
|
||
|
|
end if;
|
||
|
|
end Close;
|
||
|
|
|
||
|
|
-----------
|
||
|
|
-- CRC32 --
|
||
|
|
-----------
|
||
|
|
|
||
|
|
function CRC32
|
||
|
|
(CRC : in Unsigned_32;
|
||
|
|
Data : in Ada.Streams.Stream_Element_Array)
|
||
|
|
return Unsigned_32
|
||
|
|
is
|
||
|
|
use Thin;
|
||
|
|
begin
|
||
|
|
return Unsigned_32 (crc32 (ULong (CRC),
|
||
|
|
Data'Address,
|
||
|
|
Data'Length));
|
||
|
|
end CRC32;
|
||
|
|
|
||
|
|
procedure CRC32
|
||
|
|
(CRC : in out Unsigned_32;
|
||
|
|
Data : in Ada.Streams.Stream_Element_Array) is
|
||
|
|
begin
|
||
|
|
CRC := CRC32 (CRC, Data);
|
||
|
|
end CRC32;
|
||
|
|
|
||
|
|
------------------
|
||
|
|
-- Deflate_Init --
|
||
|
|
------------------
|
||
|
|
|
||
|
|
procedure Deflate_Init
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Level : in Compression_Level := Default_Compression;
|
||
|
|
Strategy : in Strategy_Type := Default_Strategy;
|
||
|
|
Method : in Compression_Method := Deflated;
|
||
|
|
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
|
||
|
|
Memory_Level : in Memory_Level_Type := Default_Memory_Level;
|
||
|
|
Header : in Header_Type := Default)
|
||
|
|
is
|
||
|
|
use type Thin.Int;
|
||
|
|
Win_Bits : Thin.Int := Thin.Int (Window_Bits);
|
||
|
|
begin
|
||
|
|
if Is_Open (Filter) then
|
||
|
|
raise Status_Error;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
-- We allow ZLib to make header only in case of default header type.
|
||
|
|
-- Otherwise we would either do header by ourselfs, or do not do
|
||
|
|
-- header at all.
|
||
|
|
|
||
|
|
if Header = None or else Header = GZip then
|
||
|
|
Win_Bits := -Win_Bits;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
-- For the GZip CRC calculation and make headers.
|
||
|
|
|
||
|
|
if Header = GZip then
|
||
|
|
Filter.CRC := 0;
|
||
|
|
Filter.Offset := Simple_GZip_Header'First;
|
||
|
|
else
|
||
|
|
Filter.Offset := Simple_GZip_Header'Last + 1;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Filter.Strm := new Z_Stream;
|
||
|
|
Filter.Compression := True;
|
||
|
|
Filter.Stream_End := False;
|
||
|
|
Filter.Header := Header;
|
||
|
|
|
||
|
|
if Thin.Deflate_Init
|
||
|
|
(To_Thin_Access (Filter.Strm),
|
||
|
|
Level => Thin.Int (Level),
|
||
|
|
method => Thin.Int (Method),
|
||
|
|
windowBits => Win_Bits,
|
||
|
|
memLevel => Thin.Int (Memory_Level),
|
||
|
|
strategy => Thin.Int (Strategy)) /= Thin.Z_OK
|
||
|
|
then
|
||
|
|
Raise_Error (Filter.Strm.all);
|
||
|
|
end if;
|
||
|
|
end Deflate_Init;
|
||
|
|
|
||
|
|
-----------
|
||
|
|
-- Flush --
|
||
|
|
-----------
|
||
|
|
|
||
|
|
procedure Flush
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode)
|
||
|
|
is
|
||
|
|
No_Data : Stream_Element_Array := (1 .. 0 => 0);
|
||
|
|
Last : Stream_Element_Offset;
|
||
|
|
begin
|
||
|
|
Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
|
||
|
|
end Flush;
|
||
|
|
|
||
|
|
-----------------------
|
||
|
|
-- Generic_Translate --
|
||
|
|
-----------------------
|
||
|
|
|
||
|
|
procedure Generic_Translate
|
||
|
|
(Filter : in out ZLib.Filter_Type;
|
||
|
|
In_Buffer_Size : in Integer := Default_Buffer_Size;
|
||
|
|
Out_Buffer_Size : in Integer := Default_Buffer_Size)
|
||
|
|
is
|
||
|
|
In_Buffer : Stream_Element_Array
|
||
|
|
(1 .. Stream_Element_Offset (In_Buffer_Size));
|
||
|
|
Out_Buffer : Stream_Element_Array
|
||
|
|
(1 .. Stream_Element_Offset (Out_Buffer_Size));
|
||
|
|
Last : Stream_Element_Offset;
|
||
|
|
In_Last : Stream_Element_Offset;
|
||
|
|
In_First : Stream_Element_Offset;
|
||
|
|
Out_Last : Stream_Element_Offset;
|
||
|
|
begin
|
||
|
|
Main : loop
|
||
|
|
Data_In (In_Buffer, Last);
|
||
|
|
|
||
|
|
In_First := In_Buffer'First;
|
||
|
|
|
||
|
|
loop
|
||
|
|
Translate
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => In_Buffer (In_First .. Last),
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Out_Buffer,
|
||
|
|
Out_Last => Out_Last,
|
||
|
|
Flush => Flush_Finish (Last < In_Buffer'First));
|
||
|
|
|
||
|
|
if Out_Buffer'First <= Out_Last then
|
||
|
|
Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
|
||
|
|
end if;
|
||
|
|
|
||
|
|
exit Main when Stream_End (Filter);
|
||
|
|
|
||
|
|
-- The end of in buffer.
|
||
|
|
|
||
|
|
exit when In_Last = Last;
|
||
|
|
|
||
|
|
In_First := In_Last + 1;
|
||
|
|
end loop;
|
||
|
|
end loop Main;
|
||
|
|
|
||
|
|
end Generic_Translate;
|
||
|
|
|
||
|
|
------------------
|
||
|
|
-- Inflate_Init --
|
||
|
|
------------------
|
||
|
|
|
||
|
|
procedure Inflate_Init
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Window_Bits : in Window_Bits_Type := Default_Window_Bits;
|
||
|
|
Header : in Header_Type := Default)
|
||
|
|
is
|
||
|
|
use type Thin.Int;
|
||
|
|
Win_Bits : Thin.Int := Thin.Int (Window_Bits);
|
||
|
|
|
||
|
|
procedure Check_Version;
|
||
|
|
-- Check the latest header types compatibility.
|
||
|
|
|
||
|
|
procedure Check_Version is
|
||
|
|
begin
|
||
|
|
if Version <= "1.1.4" then
|
||
|
|
Raise_Error
|
||
|
|
("Inflate header type " & Header_Type'Image (Header)
|
||
|
|
& " incompatible with ZLib version " & Version);
|
||
|
|
end if;
|
||
|
|
end Check_Version;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if Is_Open (Filter) then
|
||
|
|
raise Status_Error;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
case Header is
|
||
|
|
when None =>
|
||
|
|
Check_Version;
|
||
|
|
|
||
|
|
-- Inflate data without headers determined
|
||
|
|
-- by negative Win_Bits.
|
||
|
|
|
||
|
|
Win_Bits := -Win_Bits;
|
||
|
|
when GZip =>
|
||
|
|
Check_Version;
|
||
|
|
|
||
|
|
-- Inflate gzip data defined by flag 16.
|
||
|
|
|
||
|
|
Win_Bits := Win_Bits + 16;
|
||
|
|
when Auto =>
|
||
|
|
Check_Version;
|
||
|
|
|
||
|
|
-- Inflate with automatic detection
|
||
|
|
-- of gzip or native header defined by flag 32.
|
||
|
|
|
||
|
|
Win_Bits := Win_Bits + 32;
|
||
|
|
when Default => null;
|
||
|
|
end case;
|
||
|
|
|
||
|
|
Filter.Strm := new Z_Stream;
|
||
|
|
Filter.Compression := False;
|
||
|
|
Filter.Stream_End := False;
|
||
|
|
Filter.Header := Header;
|
||
|
|
|
||
|
|
if Thin.Inflate_Init
|
||
|
|
(To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
|
||
|
|
then
|
||
|
|
Raise_Error (Filter.Strm.all);
|
||
|
|
end if;
|
||
|
|
end Inflate_Init;
|
||
|
|
|
||
|
|
-------------
|
||
|
|
-- Is_Open --
|
||
|
|
-------------
|
||
|
|
|
||
|
|
function Is_Open (Filter : in Filter_Type) return Boolean is
|
||
|
|
begin
|
||
|
|
return Filter.Strm /= null;
|
||
|
|
end Is_Open;
|
||
|
|
|
||
|
|
-----------------
|
||
|
|
-- Raise_Error --
|
||
|
|
-----------------
|
||
|
|
|
||
|
|
procedure Raise_Error (Message : in String) is
|
||
|
|
begin
|
||
|
|
Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
|
||
|
|
end Raise_Error;
|
||
|
|
|
||
|
|
procedure Raise_Error (Stream : in Z_Stream) is
|
||
|
|
begin
|
||
|
|
Raise_Error (Last_Error_Message (Stream));
|
||
|
|
end Raise_Error;
|
||
|
|
|
||
|
|
----------
|
||
|
|
-- Read --
|
||
|
|
----------
|
||
|
|
|
||
|
|
procedure Read
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Item : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode := No_Flush)
|
||
|
|
is
|
||
|
|
In_Last : Stream_Element_Offset;
|
||
|
|
Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
|
||
|
|
V_Flush : Flush_Mode := Flush;
|
||
|
|
|
||
|
|
begin
|
||
|
|
pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
|
||
|
|
pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);
|
||
|
|
|
||
|
|
loop
|
||
|
|
if Rest_Last = Buffer'First - 1 then
|
||
|
|
V_Flush := Finish;
|
||
|
|
|
||
|
|
elsif Rest_First > Rest_Last then
|
||
|
|
Read (Buffer, Rest_Last);
|
||
|
|
Rest_First := Buffer'First;
|
||
|
|
|
||
|
|
if Rest_Last < Buffer'First then
|
||
|
|
V_Flush := Finish;
|
||
|
|
end if;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Translate
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => Buffer (Rest_First .. Rest_Last),
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Item (Item_First .. Item'Last),
|
||
|
|
Out_Last => Last,
|
||
|
|
Flush => V_Flush);
|
||
|
|
|
||
|
|
Rest_First := In_Last + 1;
|
||
|
|
|
||
|
|
exit when Stream_End (Filter)
|
||
|
|
or else Last = Item'Last
|
||
|
|
or else (Last >= Item'First and then Allow_Read_Some);
|
||
|
|
|
||
|
|
Item_First := Last + 1;
|
||
|
|
end loop;
|
||
|
|
end Read;
|
||
|
|
|
||
|
|
----------------
|
||
|
|
-- Stream_End --
|
||
|
|
----------------
|
||
|
|
|
||
|
|
function Stream_End (Filter : in Filter_Type) return Boolean is
|
||
|
|
begin
|
||
|
|
if Filter.Header = GZip and Filter.Compression then
|
||
|
|
return Filter.Stream_End
|
||
|
|
and then Filter.Offset = Footer_Array'Last + 1;
|
||
|
|
else
|
||
|
|
return Filter.Stream_End;
|
||
|
|
end if;
|
||
|
|
end Stream_End;
|
||
|
|
|
||
|
|
--------------
|
||
|
|
-- Total_In --
|
||
|
|
--------------
|
||
|
|
|
||
|
|
function Total_In (Filter : in Filter_Type) return Count is
|
||
|
|
begin
|
||
|
|
return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
|
||
|
|
end Total_In;
|
||
|
|
|
||
|
|
---------------
|
||
|
|
-- Total_Out --
|
||
|
|
---------------
|
||
|
|
|
||
|
|
function Total_Out (Filter : in Filter_Type) return Count is
|
||
|
|
begin
|
||
|
|
return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
|
||
|
|
end Total_Out;
|
||
|
|
|
||
|
|
---------------
|
||
|
|
-- Translate --
|
||
|
|
---------------
|
||
|
|
|
||
|
|
procedure Translate
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
In_Data : in Ada.Streams.Stream_Element_Array;
|
||
|
|
In_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode) is
|
||
|
|
begin
|
||
|
|
if Filter.Header = GZip and then Filter.Compression then
|
||
|
|
Translate_GZip
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => In_Data,
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Out_Data,
|
||
|
|
Out_Last => Out_Last,
|
||
|
|
Flush => Flush);
|
||
|
|
else
|
||
|
|
Translate_Auto
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => In_Data,
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Out_Data,
|
||
|
|
Out_Last => Out_Last,
|
||
|
|
Flush => Flush);
|
||
|
|
end if;
|
||
|
|
end Translate;
|
||
|
|
|
||
|
|
--------------------
|
||
|
|
-- Translate_Auto --
|
||
|
|
--------------------
|
||
|
|
|
||
|
|
procedure Translate_Auto
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
In_Data : in Ada.Streams.Stream_Element_Array;
|
||
|
|
In_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode)
|
||
|
|
is
|
||
|
|
use type Thin.Int;
|
||
|
|
Code : Thin.Int;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if not Is_Open (Filter) then
|
||
|
|
raise Status_Error;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
if Out_Data'Length = 0 and then In_Data'Length = 0 then
|
||
|
|
raise Constraint_Error;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
|
||
|
|
Set_In (Filter.Strm.all, In_Data'Address, In_Data'Length);
|
||
|
|
|
||
|
|
Code := Flate (Filter.Compression).Step
|
||
|
|
(To_Thin_Access (Filter.Strm),
|
||
|
|
Thin.Int (Flush));
|
||
|
|
|
||
|
|
if Code = Thin.Z_STREAM_END then
|
||
|
|
Filter.Stream_End := True;
|
||
|
|
else
|
||
|
|
Check_Error (Filter.Strm.all, Code);
|
||
|
|
end if;
|
||
|
|
|
||
|
|
In_Last := In_Data'Last
|
||
|
|
- Stream_Element_Offset (Avail_In (Filter.Strm.all));
|
||
|
|
Out_Last := Out_Data'Last
|
||
|
|
- Stream_Element_Offset (Avail_Out (Filter.Strm.all));
|
||
|
|
end Translate_Auto;
|
||
|
|
|
||
|
|
--------------------
|
||
|
|
-- Translate_GZip --
|
||
|
|
--------------------
|
||
|
|
|
||
|
|
procedure Translate_GZip
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
In_Data : in Ada.Streams.Stream_Element_Array;
|
||
|
|
In_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Out_Data : out Ada.Streams.Stream_Element_Array;
|
||
|
|
Out_Last : out Ada.Streams.Stream_Element_Offset;
|
||
|
|
Flush : in Flush_Mode)
|
||
|
|
is
|
||
|
|
Out_First : Stream_Element_Offset;
|
||
|
|
|
||
|
|
procedure Add_Data (Data : in Stream_Element_Array);
|
||
|
|
-- Add data to stream from the Filter.Offset till necessary,
|
||
|
|
-- used for add gzip headr/footer.
|
||
|
|
|
||
|
|
procedure Put_32
|
||
|
|
(Item : in out Stream_Element_Array;
|
||
|
|
Data : in Unsigned_32);
|
||
|
|
pragma Inline (Put_32);
|
||
|
|
|
||
|
|
--------------
|
||
|
|
-- Add_Data --
|
||
|
|
--------------
|
||
|
|
|
||
|
|
procedure Add_Data (Data : in Stream_Element_Array) is
|
||
|
|
Data_First : Stream_Element_Offset renames Filter.Offset;
|
||
|
|
Data_Last : Stream_Element_Offset;
|
||
|
|
Data_Len : Stream_Element_Offset; -- -1
|
||
|
|
Out_Len : Stream_Element_Offset; -- -1
|
||
|
|
begin
|
||
|
|
Out_First := Out_Last + 1;
|
||
|
|
|
||
|
|
if Data_First > Data'Last then
|
||
|
|
return;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Data_Len := Data'Last - Data_First;
|
||
|
|
Out_Len := Out_Data'Last - Out_First;
|
||
|
|
|
||
|
|
if Data_Len <= Out_Len then
|
||
|
|
Out_Last := Out_First + Data_Len;
|
||
|
|
Data_Last := Data'Last;
|
||
|
|
else
|
||
|
|
Out_Last := Out_Data'Last;
|
||
|
|
Data_Last := Data_First + Out_Len;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);
|
||
|
|
|
||
|
|
Data_First := Data_Last + 1;
|
||
|
|
Out_First := Out_Last + 1;
|
||
|
|
end Add_Data;
|
||
|
|
|
||
|
|
------------
|
||
|
|
-- Put_32 --
|
||
|
|
------------
|
||
|
|
|
||
|
|
procedure Put_32
|
||
|
|
(Item : in out Stream_Element_Array;
|
||
|
|
Data : in Unsigned_32)
|
||
|
|
is
|
||
|
|
D : Unsigned_32 := Data;
|
||
|
|
begin
|
||
|
|
for J in Item'First .. Item'First + 3 loop
|
||
|
|
Item (J) := Stream_Element (D and 16#FF#);
|
||
|
|
D := Shift_Right (D, 8);
|
||
|
|
end loop;
|
||
|
|
end Put_32;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Out_Last := Out_Data'First - 1;
|
||
|
|
|
||
|
|
if not Filter.Stream_End then
|
||
|
|
Add_Data (Simple_GZip_Header);
|
||
|
|
|
||
|
|
Translate_Auto
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => In_Data,
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Out_Data (Out_First .. Out_Data'Last),
|
||
|
|
Out_Last => Out_Last,
|
||
|
|
Flush => Flush);
|
||
|
|
|
||
|
|
CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
|
||
|
|
end if;
|
||
|
|
|
||
|
|
if Filter.Stream_End and then Out_Last <= Out_Data'Last then
|
||
|
|
-- This detection method would work only when
|
||
|
|
-- Simple_GZip_Header'Last > Footer_Array'Last
|
||
|
|
|
||
|
|
if Filter.Offset = Simple_GZip_Header'Last + 1 then
|
||
|
|
Filter.Offset := Footer_Array'First;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
declare
|
||
|
|
Footer : Footer_Array;
|
||
|
|
begin
|
||
|
|
Put_32 (Footer, Filter.CRC);
|
||
|
|
Put_32 (Footer (Footer'First + 4 .. Footer'Last),
|
||
|
|
Unsigned_32 (Total_In (Filter)));
|
||
|
|
Add_Data (Footer);
|
||
|
|
end;
|
||
|
|
end if;
|
||
|
|
end Translate_GZip;
|
||
|
|
|
||
|
|
-------------
|
||
|
|
-- Version --
|
||
|
|
-------------
|
||
|
|
|
||
|
|
function Version return String is
|
||
|
|
begin
|
||
|
|
return Interfaces.C.Strings.Value (Thin.zlibVersion);
|
||
|
|
end Version;
|
||
|
|
|
||
|
|
-----------
|
||
|
|
-- Write --
|
||
|
|
-----------
|
||
|
|
|
||
|
|
procedure Write
|
||
|
|
(Filter : in out Filter_Type;
|
||
|
|
Item : in Ada.Streams.Stream_Element_Array;
|
||
|
|
Flush : in Flush_Mode := No_Flush)
|
||
|
|
is
|
||
|
|
Buffer : Stream_Element_Array (1 .. Buffer_Size);
|
||
|
|
In_Last : Stream_Element_Offset;
|
||
|
|
Out_Last : Stream_Element_Offset;
|
||
|
|
In_First : Stream_Element_Offset := Item'First;
|
||
|
|
begin
|
||
|
|
if Item'Length = 0 and Flush = No_Flush then
|
||
|
|
return;
|
||
|
|
end if;
|
||
|
|
|
||
|
|
loop
|
||
|
|
Translate
|
||
|
|
(Filter => Filter,
|
||
|
|
In_Data => Item (In_First .. Item'Last),
|
||
|
|
In_Last => In_Last,
|
||
|
|
Out_Data => Buffer,
|
||
|
|
Out_Last => Out_Last,
|
||
|
|
Flush => Flush);
|
||
|
|
|
||
|
|
if Out_Last >= Buffer'First then
|
||
|
|
Write (Buffer (1 .. Out_Last));
|
||
|
|
end if;
|
||
|
|
|
||
|
|
exit when In_Last = Item'Last or Stream_End (Filter);
|
||
|
|
|
||
|
|
In_First := In_Last + 1;
|
||
|
|
end loop;
|
||
|
|
end Write;
|
||
|
|
|
||
|
|
end ZLib;
|