1. with Zip.Headers, UnZip.Decompress; 
  2.  
  3. with Ada.Strings.Unbounded; 
  4. with Ada.Unchecked_Deallocation; 
  5. with Interfaces;                        use Interfaces; 
  6.  
  7. package body UnZip.Streams is 
  8.  
  9.    procedure Dispose is new 
  10.      Ada.Unchecked_Deallocation (String, p_String); 
  11.  
  12.    procedure Dispose is new 
  13.      Ada.Unchecked_Deallocation (Ada.Streams.Stream_Element_Array, 
  14.                                  p_Stream_Element_Array); 
  15.  
  16.    procedure Dispose is new 
  17.      Ada.Unchecked_Deallocation (UnZip_Stream_Type, 
  18.                                  Zipped_File_Type); 
  19.  
  20.    -------------------------------------------------- 
  21.    -- *The* internal 1 - file unzipping procedure.   -- 
  22.    -- Input must be _open_ and won't be _closed_ ! -- 
  23.    -------------------------------------------------- 
  24.  
  25.    procedure UnZipFile (zip_file         :        Zip_Streams.Zipstream_Class; 
  26.                         header_index     : in out Ada.Streams.Stream_IO.Positive_Count; 
  27.                         mem_ptr          :    out p_Stream_Element_Array; 
  28.                         password         : in out Ada.Strings.Unbounded.Unbounded_String; 
  29.                         hint_comp_size   :        File_size_type; -- Added 2007 for .ODS files 
  30.                         cat_uncomp_size  :        File_size_type) is 
  31.  
  32.       work_index : Ada.Streams.Stream_IO.Positive_Count := header_index; 
  33.       local_header : Zip.Headers.Local_File_Header; 
  34.       data_descriptor_present : Boolean; 
  35.       encrypted : Boolean; 
  36.       method : PKZip_method; 
  37.       use Ada.Streams.Stream_IO, Zip, Zip_Streams; 
  38.    begin 
  39.       begin 
  40.          Zip_Streams.Set_Index (zip_file, Positive (header_index)); 
  41.          declare 
  42.             TempStream  : constant Zipstream_Class := zip_file; 
  43.          begin 
  44.             Zip.Headers.Read_and_check (TempStream, local_header); 
  45.          end; 
  46.       exception 
  47.          when Zip.Headers.bad_local_header => 
  48.             raise; 
  49.          when others => 
  50.             raise Read_Error; 
  51.       end; 
  52.  
  53.       method := Method_from_code (local_header.zip_type); 
  54.       if method = unknown then 
  55.          raise Unsupported_method; 
  56.       end if; 
  57.  
  58.       -- calculate offset of data 
  59.  
  60.       work_index := 
  61.         work_index + Ada.Streams.Stream_IO.Count ( 
  62.                                                   local_header.filename_length    + 
  63.                                                     local_header.extra_field_length + 
  64.                                                       Zip.Headers.local_header_length 
  65.                                                  ); 
  66.  
  67.       data_descriptor_present := (local_header.bit_flag and 8) /= 0; 
  68.  
  69.       if data_descriptor_present then 
  70.          -- Sizes and crc are after the data 
  71.          local_header.dd.crc_32 := 0; 
  72.          local_header.dd.uncompressed_size := cat_uncomp_size; 
  73.          local_header.dd.compressed_size   := hint_comp_size; 
  74.       else 
  75.          -- Sizes and crc are before the data 
  76.          if cat_uncomp_size /= local_header.dd.uncompressed_size then 
  77.             raise Uncompressed_size_Error; 
  78.          end if; 
  79.       end if; 
  80.  
  81.       encrypted := (local_header.bit_flag and 1) /= 0; 
  82.  
  83.       begin 
  84.          Zip_Streams.Set_Index (zip_file, Positive (work_index)); -- eventually skips the file name 
  85.       exception 
  86.          when others => raise Read_Error; 
  87.       end; 
  88.  
  89.       -- Unzip correct type 
  90.       UnZip.Decompress.Decompress_data ( 
  91.                                         zip_file             => zip_file, 
  92.                                         format               => method, 
  93.                                         mode                 => write_to_memory, 
  94.                                         output_file_name     => "", 
  95.                                         output_memory_access => mem_ptr, 
  96.                                         feedback             => null, 
  97.                                         explode_literal_tree => (local_header.bit_flag and 4) /= 0, 
  98.                                         explode_slide_8KB    => (local_header.bit_flag and 2) /= 0, 
  99.                                         end_data_descriptor  => data_descriptor_present, 
  100.                                         encrypted            => encrypted, 
  101.                                         password             => password, 
  102.                                         get_new_password     => null, 
  103.                                         hint                 => local_header.dd 
  104.                                        ); 
  105.  
  106.       -- Set the offset on the next zipped file 
  107.       header_index := header_index + 
  108.         Count ( 
  109.                File_size_type ( 
  110.                  local_header.filename_length    + 
  111.                    local_header.extra_field_length + 
  112.                      Zip.Headers.local_header_length 
  113.                 ) + 
  114.                  local_header.dd.compressed_size 
  115.               ); 
  116.  
  117.       if data_descriptor_present then 
  118.          header_index := header_index + Count (Zip.Headers.data_descriptor_length); 
  119.       end if; 
  120.  
  121.    end UnZipFile; 
  122.  
  123.    use Ada.Streams.Stream_IO; 
  124.  
  125.    procedure S_Extract (from           :     Zip.Zip_info; 
  126.                         Zip_Stream     :     Zip_Streams.Zipstream_Class; 
  127.                         what           :     String; 
  128.                         mem_ptr        : out p_Stream_Element_Array; 
  129.                         Password       :     String; 
  130.                         Case_sensitive :     Boolean) is 
  131.  
  132.       header_index  : Positive_Count; 
  133.       comp_size     : File_size_type; 
  134.       uncomp_size   : File_size_type; 
  135.       work_password : Ada.Strings.Unbounded.Unbounded_String := 
  136.         Ada.Strings.Unbounded.To_Unbounded_String (Password); 
  137.  
  138.    begin 
  139.       Zip.Find_offset (from, what, Case_sensitive, 
  140.                        header_index, 
  141.                        comp_size, 
  142.                        uncomp_size); 
  143.  
  144.       UnZipFile (Zip_Stream, 
  145.                  header_index, 
  146.                  mem_ptr, 
  147.                  work_password, 
  148.                  comp_size, 
  149.                  uncomp_size); 
  150.       pragma Unreferenced (header_index, work_password); 
  151.  
  152.    end S_Extract; 
  153.  
  154.    -------------------- for exportation: 
  155.  
  156.    procedure Close (File  : in out Zipped_File_Type) is 
  157.    begin 
  158.       if File = null or else File.all.state = uninitialized then 
  159.          raise Use_Error; 
  160.       end if; 
  161.       if File.all.delete_info_on_closing then 
  162.          Zip.Delete (File.all.archive_info); 
  163.       end if; 
  164.       Dispose (File.all.file_name); 
  165.       Dispose (File.all.Uncompressed); 
  166.       Dispose (File); 
  167.       File := null; 
  168.    end Close; 
  169.  
  170.    function Is_Open (File : Zipped_File_Type) return Boolean is 
  171.      (File /= null and then File.all.state /= uninitialized); 
  172.  
  173.    function End_Of_File (File : Zipped_File_Type) return Boolean is 
  174.  
  175.    begin 
  176.       if File = null or else File.all.state = uninitialized then 
  177.          raise Use_Error; 
  178.       end if; 
  179.       return File.all.state = end_of_zip; 
  180.    end End_Of_File; 
  181.  
  182.    procedure Open (File            : in out Zipped_File_Type; -- File - in - archive handle 
  183.                    Archive_Info    :        Zip.Zip_info;         -- loaded by Load_zip_info 
  184.                    Name            :        String;               -- Name of zipped entry 
  185.                    Password        :        String := "";         -- Decryption password 
  186.                    Case_sensitive  :        Boolean := False) is 
  187.  
  188.       use Zip_Streams, Ada.Streams; 
  189.  
  190.       MyStream      : aliased File_Zipstream; 
  191.       input_stream  : Zipstream_Class; 
  192.       use_a_file    : constant Boolean := Zip.Zip_Stream (Archive_Info) = null; 
  193.  
  194.    begin 
  195.       if File = null then 
  196.          File := new UnZip_Stream_Type; 
  197.       elsif File.all.state /= uninitialized then -- forgot to close last time! 
  198.          raise Use_Error; 
  199.       end if; 
  200.       if use_a_file then 
  201.          input_stream := MyStream'Unchecked_Access; 
  202.          Set_Name (input_stream, Zip.Zip_name (Archive_Info)); 
  203.          Open (MyStream, Ada.Streams.Stream_IO.In_File); 
  204.       else -- use the given stream 
  205.          input_stream := Zip.Zip_Stream (Archive_Info); 
  206.       end if; 
  207.       -- 
  208.       File.all.archive_info := Archive_Info; 
  209.       File.all.file_name := new String'(Name); 
  210.       begin 
  211.          S_Extract ( 
  212.                     File.all.archive_info, 
  213.                     input_stream, 
  214.                     Name, 
  215.                     File.all.Uncompressed, 
  216.                     Password, 
  217.                     Case_sensitive 
  218.                    ); 
  219.          if use_a_file then 
  220.             Close (MyStream); 
  221.          end if; 
  222.       exception 
  223.          when others => 
  224.             if use_a_file then 
  225.                Close (MyStream); 
  226.             end if; 
  227.             raise; 
  228.       end; 
  229.       File.all.index := File.all.Uncompressed'First; 
  230.       File.all.state := data_uncompressed; 
  231.       -- Bug fix for data of size 0 - 29 - Nov - 2002 
  232.       if File.all.Uncompressed'Last < File.all.index then -- (1 .. 0) array 
  233.          File.all.state := end_of_zip; 
  234.       end if; 
  235.       File.all.delete_info_on_closing := False; -- Close won't delete dir tree 
  236.       -- Bug fix 1 - Mar - 2007 : False was set only at initialization 
  237.    end Open; 
  238.  
  239.    procedure Open (File            : in out Zipped_File_Type; -- File - in - archive handle 
  240.                    Archive_Name    :        String;               -- Name of archive file 
  241.                    Name            :        String;               -- Name of zipped entry 
  242.                    Password        :        String := "";         -- Decryption password 
  243.                    Case_sensitive  :        Boolean := False) is 
  244.  
  245.       temp_info : Zip.Zip_info; 
  246.       -- this local record (but not the full tree) is copied by Open ( .. ) 
  247.  
  248.    begin 
  249.       Zip.Load (temp_info, Archive_Name, Case_sensitive); 
  250.       Open (File, temp_info, Name, Password, Case_sensitive); 
  251.       File.all.delete_info_on_closing := True; -- Close will delete temp. dir tree 
  252.    end Open; 
  253.  
  254.    procedure Open (File            : in out Zipped_File_Type; -- File - in - archive handle 
  255.                    Archive_Stream  :        Zip_Streams.Zipstream_Class; -- Archive's stream 
  256.                    Name            :        String;               -- Name of zipped entry 
  257.                    Password        :        String := "";         -- Decryption password 
  258.                    Case_sensitive  :        Boolean := False) is 
  259.  
  260.       temp_info : Zip.Zip_info; 
  261.       -- this local record (but not the full tree) is copied by Open ( .. ) 
  262.  
  263.    begin 
  264.       Zip.Load (temp_info, Archive_Stream, Case_sensitive); 
  265.       Open (File, temp_info, Name, Password, Case_sensitive); 
  266.       File.all.delete_info_on_closing := True; -- Close will delete temp. dir tree 
  267.    end Open; 
  268.  
  269.    ------------------------------------------ 
  270.    -- Read procedure for Unzip_Stream_Type -- 
  271.    ------------------------------------------ 
  272.  
  273.    overriding procedure Read (UnZip_Stream  : in out UnZip_Stream_Type; 
  274.                               Item    :    out Ada.Streams.Stream_Element_Array; 
  275.                               Last    :    out Ada.Streams.Stream_Element_Offset) is 
  276.  
  277.       use Ada.Streams; 
  278.  
  279.    begin 
  280.       if UnZip_Stream.state = uninitialized then 
  281.          raise Use_Error; 
  282.       end if; 
  283.       if UnZip_Stream.state = end_of_zip then 
  284.          -- Zero transfer - > Last := Item'First - 1, see RM 13.13.1 (8) 
  285.          -- No End_Error here, T'Read will raise it : RM 13.13.2 (37) 
  286.          if Item'First > Stream_Element_Offset'First then 
  287.             Last := Item'First - 1; 
  288.             return; 
  289.          else 
  290.             -- Well, we cannot return Item'First - 1 .. . 
  291.             raise Constraint_Error; -- RM 13.13.1 (11) requires this. 
  292.          end if; 
  293.       end if; 
  294.       if Item'Length = 0 then 
  295.          -- Nothing to be read actually. 
  296.          Last := Item'Last; -- this is < Item'First 
  297.          return; 
  298.       end if; 
  299.       -- From now on, we can assume Item'Length > 0. 
  300.  
  301.       if UnZip_Stream.index + Item'Length <= UnZip_Stream.Uncompressed'Last then 
  302.          -- * Normal case : even after reading, the index will be in the range 
  303.          Last := Item'Last; 
  304.          Item := 
  305.            UnZip_Stream.Uncompressed.all (UnZip_Stream.index .. UnZip_Stream.index + Item'Length - 1); 
  306.          UnZip_Stream.index := UnZip_Stream.index + Item'Length; 
  307.          -- Now : Stream.index <= Stream.uncompressed'Last, 
  308.          -- then at least one element is left to be read, end_of_zip not possible 
  309.       else 
  310.          -- * Special case : we exhaust the buffer 
  311.          Last := Item'First + (UnZip_Stream.Uncompressed'Last - UnZip_Stream.index); 
  312.          Item (Item'First .. Last) := 
  313.            UnZip_Stream.Uncompressed.all (UnZip_Stream.index .. UnZip_Stream.Uncompressed'Last); 
  314.          UnZip_Stream.state := end_of_zip; 
  315.          -- If Last < Item'Last, the T'Read attribute raises End_Error 
  316.          -- because of the incomplete reading. 
  317.       end if; 
  318.    end Read; 
  319.  
  320.    function Stream (File  : Zipped_File_Type) return Stream_Access is (Stream_Access (File)); 
  321.  
  322.    overriding procedure Write (UnZip_Stream : in out UnZip_Stream_Type; 
  323.                                Item         :        Ada.Streams.Stream_Element_Array) is 
  324.  
  325.       write_not_supported : exception; 
  326.  
  327.    begin 
  328.       raise write_not_supported; 
  329.    end Write; 
  330.  
  331. end UnZip.Streams;