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