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