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