Back to... GLOBE_3D

Source file : unzip-streams.adb


with Zip.Headers, UnZip.Decompress;

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Interfaces;                        use Interfaces;

package body UnZip.Streams is

   procedure Dispose is new
     Ada.Unchecked_Deallocation( String, p_String );

   procedure Dispose is new
     Ada.Unchecked_Deallocation( Ada.Streams.Stream_Element_Array,
                                 p_Stream_Element_Array );

   procedure Dispose is new
     Ada.Unchecked_Deallocation( UnZip_Stream_Type,
                                 Zipped_File_Type );

  --------------------------------------------------
  -- *The* internal 1-file unzipping procedure.   --
  -- Input must be _open_ and won't be _closed_ ! --
  --------------------------------------------------

  procedure UnZipFile (
    zip_stream      : in out Zip_Streams.Root_Zipstream_Type'Class;
    header_index    : in out Zip_Streams.ZS_Index_Type;
    mem_ptr         :    out p_Stream_Element_Array;
    out_stream_ptr  :        p_Stream;
    -- if not null, extract to out_stream_ptr, not to memory
    password        : in out Ada.Strings.Unbounded.Unbounded_String;
    hint_comp_size  : in     File_size_type; -- Added 2007 for .ODS files
    hint_crc_32     : in     Unsigned_32;    -- Added 2012 for decryption
    cat_uncomp_size : in     File_size_type
  )
  is
    work_index: Zip_Streams.ZS_Index_Type:= header_index;
    local_header: Zip.Headers.Local_File_Header;
    data_descriptor_after_data: Boolean;
    encrypted: Boolean;
    method: PKZip_method;
    use Zip, Zip_Streams;
    mode: Write_mode;
  begin
    begin
      Zip_Streams.Set_Index(zip_stream, header_index);
      Zip.Headers.Read_and_check(zip_stream, local_header);
    exception
      when Zip.Headers.bad_local_header =>
        raise;
      when others =>
        raise Read_Error;
    end;

    method:= Method_from_code(local_header.zip_type);
    if method = unknown then
      raise Unsupported_method;
    end if;

    -- calculate offset of data

    work_index :=
      work_index +
      Zip_Streams.ZS_Size_Type(
              local_header.filename_length    +
              local_header.extra_field_length +
              Zip.Headers.local_header_length
      );

    data_descriptor_after_data:= (local_header.bit_flag and 8) /= 0;

    if data_descriptor_after_data then
      -- Sizes and crc are after the data
      local_header.dd.crc_32            := hint_crc_32;
      local_header.dd.uncompressed_size := cat_uncomp_size;
      local_header.dd.compressed_size   := hint_comp_size;
    else
      -- Sizes and crc are before the data
      if cat_uncomp_size /= local_header.dd.uncompressed_size then
        raise Uncompressed_size_Error;
      end if;
    end if;

    encrypted:= (local_header.bit_flag and Zip.Headers.Encryption_Flag_Bit) /= 0;

    begin
      Zip_Streams.Set_Index ( zip_stream, work_index ); -- eventually skips the file name
    exception
      when others => raise Read_Error;
    end;

    if out_stream_ptr = null then
      mode:= write_to_memory;
    else
      mode:= write_to_stream;
    end if;
    -- Unzip correct type
    UnZip.Decompress.Decompress_data(
      zip_file                   => zip_stream,
      format                     => method,
      mode                       => mode,
      output_file_name           => "",
      output_memory_access       => mem_ptr,
      output_stream_access       => out_stream_ptr,
      feedback                   => null,
      explode_literal_tree       => (local_header.bit_flag and 4) /= 0,
      explode_slide_8KB_LZMA_EOS => (local_header.bit_flag and 2) /= 0,
      data_descriptor_after_data => data_descriptor_after_data,
      is_encrypted               => encrypted,
      password                   => password,
      get_new_password           => null,
      hint                       => local_header
    );

    -- Set the offset on the next zipped file
    header_index:= header_index +
      Zip_Streams.ZS_Size_Type(
              local_header.filename_length    +
              local_header.extra_field_length +
              Zip.Headers.local_header_length
      ) +
      Zip_Streams.ZS_Size_Type(
        local_header.dd.compressed_size
      );

    if data_descriptor_after_data then
      header_index:= header_index +
        Zip_Streams.ZS_Size_Type(Zip.Headers.data_descriptor_length);
    end if;

  end UnZipFile;

  procedure S_Extract( from           : Zip.Zip_info;
                       zip_stream     : in out Zip_Streams.Root_Zipstream_Type'Class;
                       what           : String;
                       password       : in String;
                       mem_ptr        : out p_Stream_Element_Array;
                       out_stream_ptr : p_Stream
                      )
  is
    header_index : Zip_Streams.ZS_Index_Type;
    comp_size    : File_size_type;
    uncomp_size  : File_size_type;
    crc_32: Interfaces.Unsigned_32;
    work_password: Ada.Strings.Unbounded.Unbounded_String:=
      Ada.Strings.Unbounded.To_Unbounded_String(password);
    dummy_name_encoding: Zip.Zip_name_encoding;
  begin
    Zip.Find_offset(
      info          => from,
      name          => what ,
      name_encoding => dummy_name_encoding,
      file_index    => header_index,
      comp_size     => comp_size,
      uncomp_size   => uncomp_size,
      crc_32        => crc_32
    );
    UnZipFile(
      zip_stream      => zip_stream,
      header_index    => header_index,
      mem_ptr         => mem_ptr,
      out_stream_ptr  => out_stream_ptr,
      password        => work_password,
      hint_comp_size  => comp_size,
      hint_crc_32     => crc_32,
      cat_uncomp_size => uncomp_size
    );
  end S_Extract;

  -------------------- for exportation:

  procedure Close (File : in out Zipped_File_Type) is
  begin
    if File = null or else File.state = uninitialized then
       raise Use_Error;
    end if;
    if File.delete_info_on_closing then
      Zip.Delete( File.archive_info );
    end if;
    Dispose(File.file_name);
    Dispose(File.uncompressed);
    Dispose(File);
    File:= null;
  end Close;

  function Is_Open (File : in Zipped_File_Type) return Boolean is
  begin
    return File /= null and then File.state /= uninitialized;
  end Is_Open;

  function End_Of_File (File : in Zipped_File_Type) return Boolean is
  begin
    if File = null or else File.state = uninitialized then
       raise Use_Error;
    end if;
    return File.state = end_of_zip;
  end End_Of_File;

  procedure Open
     (File           : in out Zipped_File_Type; -- File-in-archive handle
      Archive_Info   : in Zip.Zip_info;         -- loaded by Load_zip_info
      Name           : in String;               -- Name of zipped entry
      Password       : in String := ""          -- Decryption password
     )
  is
    use Zip_Streams, Ada.Streams;
    zip_stream   : aliased File_Zipstream;
    input_stream : Zipstream_Class_Access;
    use_a_file   : constant Boolean:= Zip.Zip_stream(Archive_Info) = null;
  begin
    if File = null then
      File:= new UnZip_Stream_Type;
    elsif File.state /= uninitialized then -- forgot to close last time!
      raise Use_Error;
    end if;
    if use_a_file then
      input_stream:= zip_stream'Unchecked_Access;
      Set_Name (zip_stream , Zip.Zip_name(Archive_Info));
      Open (zip_stream, In_File);
    else -- use the given stream
      input_stream:= Zip.Zip_stream(Archive_Info);
    end if;
    --
    File.archive_info:= Archive_Info;
    File.file_name:= new String' (Name);
    begin
      S_Extract(
        File.archive_info,
        input_stream.all,
        Name,
        Password,
        File.uncompressed,
        null
      );
      if use_a_file then
        Close (zip_stream);
      end if;
    exception
      when others =>
        if use_a_file then
          Close (zip_stream);
        end if;
        raise;
    end;
    File.index:= File.uncompressed'First;
    File.state:= data_uncompressed;
    -- Bug fix for data of size 0 - 29-Nov-2002
    if File.uncompressed'Last < File.index then -- (1..0) array
      File.state:= end_of_zip;
    end if;
    File.delete_info_on_closing:= False; -- Close won't delete dir tree
    -- Bug fix 1-Mar-2007: False was set only at initialization
  end Open;

  procedure Open
     (File           : in out Zipped_File_Type; -- File-in-archive handle
      Archive_Name   : in String;               -- Name of archive file
      Name           : in String;               -- Name of zipped entry
      Password       : in String := "";         -- Decryption password
      Case_sensitive : in Boolean:= False
     )
   is
    temp_info: Zip.Zip_info;
    -- this local record (but not the full tree) is copied by Open(..)
  begin
    Zip.Load( temp_info, Archive_Name, Case_sensitive);
    Open( File, temp_info, Name, Password );
    File.delete_info_on_closing:= True; -- Close will delete temp. dir tree
  end Open;

  procedure Open
     (File           : in out Zipped_File_Type; -- File-in-archive handle
      Archive_Stream : in out Zip_Streams.Root_Zipstream_Type'Class; -- Archive's stream
      Name           : in String;               -- Name of zipped entry
      Password       : in String := "";         -- Decryption password
      Case_sensitive : in Boolean:= False
     )
  is
    temp_info: Zip.Zip_info;
    -- this local record (but not the full tree) is copied by Open(..)
  begin
    Zip.Load( temp_info, Archive_Stream, Case_sensitive);
    Open( File, temp_info, Name, Password );
    File.delete_info_on_closing:= True; -- Close will delete temp. dir tree
  end Open;

  ------------------------------------------
  -- Read procedure for Unzip_Stream_Type --
  ------------------------------------------

  overriding procedure Read
    (Stream : in out UnZip_Stream_Type;
     Item   :    out Ada.Streams.Stream_Element_Array;
     Last   :    out Ada.Streams.Stream_Element_Offset)
  is
    use Ada.Streams;
  begin
    if Stream.state = uninitialized then
      raise Use_Error;
    end if;
    if Stream.state = end_of_zip then
      -- Zero transfer -> Last:= Item'First - 1, see RM 13.13.1(8)
      -- No End_Error here, T'Read will raise it: RM 13.13.2(37)
      if Item'First > Stream_Element_Offset'First then
        Last:= Item'First - 1;
        return;
      else
        -- Well, we cannot return Item'First - 1...
        raise Constraint_Error; -- RM 13.13.1(11) requires this.
      end if;
    end if;
    if Item'Length = 0 then
      -- Nothing to be read actually.
      Last:= Item'Last; -- this is < Item'First
      return;
    end if;
    -- From now on, we can assume Item'Length > 0.

    if Stream.index + Item'Length <= Stream.uncompressed'Last then
      -- * Normal case: even after reading, the index will be in the range
      Last := Item'Last;
      Item:=
        Stream.uncompressed(Stream.index .. Stream.index + Item'Length - 1);
      Stream.index:= Stream.index + Item'Length;
      -- Now: Stream.index <= Stream.uncompressed'Last,
      -- then at least one element is left to be read, end_of_zip not possible
    else
      -- * Special case: we exhaust the buffer
      Last:= Item'First + (Stream.uncompressed'Last - Stream.index);
      Item(Item'First .. Last):=
        Stream.uncompressed(Stream.index..Stream.uncompressed'Last);
      Stream.state:= end_of_zip;
      -- If Last < Item'Last, the T'Read attribute raises End_Error
      -- because of the incomplete reading.
    end if;
  end Read;

  function Stream (File : Zipped_File_Type) return Stream_Access is
  begin
    return Stream_Access(File);
  end Stream;

  overriding procedure Write
    (Stream : in out UnZip_Stream_Type;
     Item   : in     Ada.Streams.Stream_Element_Array)
  is
    write_not_supported: exception;
  begin
    raise write_not_supported;
  end Write;

  procedure Extract(
    Destination    : in out Ada.Streams.Root_Stream_Type'Class;
    Archive_Info   : in Zip.Zip_info;  -- Archive's Zip_info
    Name           : in String;        -- Name of zipped entry
    Password       : in String := ""   -- Decryption password
  )
  is
    use Zip_Streams, Ada.Streams;
    zip_stream   : aliased File_Zipstream;
    input_stream : Zipstream_Class_Access;
    use_a_file   : constant Boolean:= Zip.Zip_stream(Archive_Info) = null;
  begin
    if use_a_file then
      input_stream:= zip_stream'Unchecked_Access;
      Set_Name (zip_stream , Zip.Zip_name(Archive_Info));
      Open (zip_stream, In_File);
    else -- use the given stream
      input_stream:= Zip.Zip_stream(Archive_Info);
    end if;
    declare
      dummy_mem_ptr: p_Stream_Element_Array;
    begin
      S_Extract(
        Archive_Info,
        input_stream.all,
        Name,
        Password,
        dummy_mem_ptr,
        Destination'Unchecked_Access
      );
      if use_a_file then
        Close (zip_stream);
      end if;
    exception
      when others =>
        if use_a_file then
          Close (zip_stream);
        end if;
        raise;
    end;
  end Extract;

end UnZip.Streams;

GLOBE_3D: Ada library for real-time 3D rendering. Ada programming.