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