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);
procedure UnZipFile (zip_file : Zip_Streams.Zipstream_Class;
header_index : in out Ada.Streams.Stream_IO.Positive_Count;
mem_ptr : out p_Stream_Element_Array;
password : in out Ada.Strings.Unbounded.Unbounded_String;
hint_comp_size : File_size_type;
cat_uncomp_size : File_size_type) is
work_index : Ada.Streams.Stream_IO.Positive_Count := header_index;
local_header : Zip.Headers.Local_File_Header;
data_descriptor_present : Boolean;
encrypted : Boolean;
method : PKZip_method;
use Ada.Streams.Stream_IO, Zip, Zip_Streams;
begin
begin
Zip_Streams.Set_Index (zip_file, Positive (header_index));
declare
TempStream : constant Zipstream_Class := zip_file;
begin
Zip.Headers.Read_and_check (TempStream, local_header);
end;
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;
work_index :=
work_index + Ada.Streams.Stream_IO.Count (
local_header.filename_length +
local_header.extra_field_length +
Zip.Headers.local_header_length
);
data_descriptor_present := (local_header.bit_flag and 8) /= 0;
if data_descriptor_present then
local_header.dd.crc_32 := 0;
local_header.dd.uncompressed_size := cat_uncomp_size;
local_header.dd.compressed_size := hint_comp_size;
else
if cat_uncomp_size /= local_header.dd.uncompressed_size then
raise Uncompressed_size_Error;
end if;
end if;
encrypted := (local_header.bit_flag and 1) /= 0;
begin
Zip_Streams.Set_Index (zip_file, Positive (work_index));
exception
when others => raise Read_Error;
end;
UnZip.Decompress.Decompress_data (
zip_file => zip_file,
format => method,
mode => write_to_memory,
output_file_name => "",
output_memory_access => mem_ptr,
feedback => null,
explode_literal_tree => (local_header.bit_flag and 4) /= 0,
explode_slide_8KB => (local_header.bit_flag and 2) /= 0,
end_data_descriptor => data_descriptor_present,
encrypted => encrypted,
password => password,
get_new_password => null,
hint => local_header.dd
);
header_index := header_index +
Count (
File_size_type (
local_header.filename_length +
local_header.extra_field_length +
Zip.Headers.local_header_length
) +
local_header.dd.compressed_size
);
if data_descriptor_present then
header_index := header_index + Count (Zip.Headers.data_descriptor_length);
end if;
end UnZipFile;
use Ada.Streams.Stream_IO;
procedure S_Extract (from : Zip.Zip_info;
Zip_Stream : Zip_Streams.Zipstream_Class;
what : String;
mem_ptr : out p_Stream_Element_Array;
Password : String;
Case_sensitive : Boolean) is
header_index : Positive_Count;
comp_size : File_size_type;
uncomp_size : File_size_type;
work_password : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.To_Unbounded_String (Password);
begin
Zip.Find_offset (from, what, Case_sensitive,
header_index,
comp_size,
uncomp_size);
UnZipFile (Zip_Stream,
header_index,
mem_ptr,
work_password,
comp_size,
uncomp_size);
pragma Unreferenced (header_index, work_password);
end S_Extract;
procedure Close (File : in out Zipped_File_Type) is
begin
if File = null or else File.all.state = uninitialized then
raise Use_Error;
end if;
if File.all.delete_info_on_closing then
Zip.Delete (File.all.archive_info);
end if;
Dispose (File.all.file_name);
Dispose (File.all.Uncompressed);
Dispose (File);
File := null;
end Close;
function Is_Open (File : Zipped_File_Type) return Boolean is
(File /= null and then File.all.state /= uninitialized);
function End_Of_File (File : Zipped_File_Type) return Boolean is
begin
if File = null or else File.all.state = uninitialized then
raise Use_Error;
end if;
return File.all.state = end_of_zip;
end End_Of_File;
procedure Open (File : in out Zipped_File_Type;
Archive_Info : Zip.Zip_info;
Name : String;
Password : String := "";
Case_sensitive : Boolean := False) is
use Zip_Streams, Ada.Streams;
MyStream : aliased File_Zipstream;
input_stream : Zipstream_Class;
use_a_file : constant Boolean := Zip.Zip_Stream (Archive_Info) = null;
begin
if File = null then
File := new UnZip_Stream_Type;
elsif File.all.state /= uninitialized then
raise Use_Error;
end if;
if use_a_file then
input_stream := MyStream'Unchecked_Access;
Set_Name (input_stream, Zip.Zip_name (Archive_Info));
Open (MyStream, Ada.Streams.Stream_IO.In_File);
else
input_stream := Zip.Zip_Stream (Archive_Info);
end if;
File.all.archive_info := Archive_Info;
File.all.file_name := new String'(Name);
begin
S_Extract (
File.all.archive_info,
input_stream,
Name,
File.all.Uncompressed,
Password,
Case_sensitive
);
if use_a_file then
Close (MyStream);
end if;
exception
when others =>
if use_a_file then
Close (MyStream);
end if;
raise;
end;
File.all.index := File.all.Uncompressed'First;
File.all.state := data_uncompressed;
if File.all.Uncompressed'Last < File.all.index then
File.all.state := end_of_zip;
end if;
File.all.delete_info_on_closing := False;
end Open;
procedure Open (File : in out Zipped_File_Type;
Archive_Name : String;
Name : String;
Password : String := "";
Case_sensitive : Boolean := False) is
temp_info : Zip.Zip_info;
begin
Zip.Load (temp_info, Archive_Name, Case_sensitive);
Open (File, temp_info, Name, Password, Case_sensitive);
File.all.delete_info_on_closing := True;
end Open;
procedure Open (File : in out Zipped_File_Type;
Archive_Stream : Zip_Streams.Zipstream_Class;
Name : String;
Password : String := "";
Case_sensitive : Boolean := False) is
temp_info : Zip.Zip_info;
begin
Zip.Load (temp_info, Archive_Stream, Case_sensitive);
Open (File, temp_info, Name, Password, Case_sensitive);
File.all.delete_info_on_closing := True;
end Open;
overriding procedure Read (UnZip_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 UnZip_Stream.state = uninitialized then
raise Use_Error;
end if;
if UnZip_Stream.state = end_of_zip then
if Item'First > Stream_Element_Offset'First then
Last := Item'First - 1;
return;
else
raise Constraint_Error;
end if;
end if;
if Item'Length = 0 then
Last := Item'Last;
return;
end if;
if UnZip_Stream.index + Item'Length <= UnZip_Stream.Uncompressed'Last then
Last := Item'Last;
Item :=
UnZip_Stream.Uncompressed.all (UnZip_Stream.index .. UnZip_Stream.index + Item'Length - 1);
UnZip_Stream.index := UnZip_Stream.index + Item'Length;
else
Last := Item'First + (UnZip_Stream.Uncompressed'Last - UnZip_Stream.index);
Item (Item'First .. Last) :=
UnZip_Stream.Uncompressed.all (UnZip_Stream.index .. UnZip_Stream.Uncompressed'Last);
UnZip_Stream.state := end_of_zip;
end if;
end Read;
function Stream (File : Zipped_File_Type) return Stream_Access is (Stream_Access (File));
overriding procedure Write (UnZip_Stream : in out UnZip_Stream_Type;
Item : Ada.Streams.Stream_Element_Array) is
write_not_supported : exception;
begin
raise write_not_supported;
end Write;
end UnZip.Streams;