with Ada.Streams; use Ada.Streams;
package body Zip.Headers is
generic
type Number is mod <>;
function Intel_x86_number (b : Byte_Buffer) return Number;
function Intel_x86_number (b : Byte_Buffer) return Number is
n : Number := 0;
begin
for i in reverse b'Range loop
n := n * 256 + Number (b (i));
end loop;
return n;
end Intel_x86_number;
function Intel_nb is new Intel_x86_number (Unsigned_16);
function Intel_nb is new Intel_x86_number (Unsigned_32);
generic
type Number is mod <>;
size : Positive;
function Intel_x86_buffer (n : Number) return Byte_Buffer;
function Intel_x86_buffer (n : Number) return Byte_Buffer is
b : Byte_Buffer (1 .. size);
m : Number := n;
begin
for i in b'Range loop
b (i) := Unsigned_8 (m and 255);
m := m / 256;
end loop;
return b;
end Intel_x86_buffer;
function Intel_bf is new Intel_x86_buffer (Unsigned_16, 2);
function Intel_bf is new Intel_x86_buffer (Unsigned_32, 4);
function PK_signature (buf : Byte_Buffer; code : Unsigned_8) return Boolean is
(buf (1 .. 4) = (16#50#, 16#4B#, code, code + 1));
procedure PK_signature (buf : in out Byte_Buffer; code : Unsigned_8) is
begin
buf (1 .. 4) := (16#50#, 16#4B#, code, code + 1);
end PK_signature;
procedure Read_and_check (stream : Zipstream_Class;
header : out Central_File_Header) is
chb : Byte_Buffer (1 .. 46);
begin
BlockRead (stream, chb);
if not PK_signature (chb, 1) then
raise bad_central_header;
end if;
header := (made_by_version => Intel_nb (chb (5 .. 6)),
short_info =>
(needed_extract_version => Intel_nb (chb (7 .. 8)),
bit_flag => Intel_nb (chb (9 .. 10)),
zip_type => Intel_nb (chb (11 .. 12)),
file_timedate => Zip_Streams.Calendar.Convert (Unsigned_32'(Intel_nb (chb (13 .. 16)))),
dd =>
(crc_32 => Intel_nb (chb (17 .. 20)),
compressed_size => Intel_nb (chb (21 .. 24)),
uncompressed_size => Intel_nb (chb (25 .. 28))),
filename_length => Intel_nb (chb (29 .. 30)),
extra_field_length => Intel_nb (chb (31 .. 32))),
comment_length => Intel_nb (chb (33 .. 34)),
disk_number_start => Intel_nb (chb (35 .. 36)),
internal_attributes => Intel_nb (chb (37 .. 38)),
external_attributes => Intel_nb (chb (39 .. 42)),
local_header_offset => Intel_nb (chb (43 .. 46)));
end Read_and_check;
procedure Write (stream : Zipstream_Class;
header : Central_File_Header) is
chb : Byte_Buffer (1 .. 46);
begin
PK_signature (chb, 1);
chb (5 .. 6) := Intel_bf (header.made_by_version);
chb (7 .. 8) := Intel_bf (header.short_info.needed_extract_version);
chb (9 .. 10) := Intel_bf (header.short_info.bit_flag);
chb (11 .. 12) := Intel_bf (header.short_info.zip_type);
chb (13 .. 16) := Intel_bf (Zip_Streams.Calendar.Convert (header.short_info.file_timedate));
chb (17 .. 20) := Intel_bf (header.short_info.dd.crc_32);
chb (21 .. 24) := Intel_bf (header.short_info.dd.compressed_size);
chb (25 .. 28) := Intel_bf (header.short_info.dd.uncompressed_size);
chb (29 .. 30) := Intel_bf (header.short_info.filename_length);
chb (31 .. 32) := Intel_bf (header.short_info.extra_field_length);
chb (33 .. 34) := Intel_bf (header.comment_length);
chb (35 .. 36) := Intel_bf (header.disk_number_start);
chb (37 .. 38) := Intel_bf (header.internal_attributes);
chb (39 .. 42) := Intel_bf (header.external_attributes);
chb (43 .. 46) := Intel_bf (header.local_header_offset);
BlockWrite (stream.all, chb);
end Write;
procedure Read_and_check (stream : Zipstream_Class;
header : out Local_File_Header) is
lhb : Byte_Buffer (1 .. 30);
begin
BlockRead (stream, lhb);
if not PK_signature (lhb, 3) then
raise bad_local_header;
end if;
header :=
(needed_extract_version => Intel_nb (lhb (5 .. 6)),
bit_flag => Intel_nb (lhb (7 .. 8)),
zip_type => Intel_nb (lhb (9 .. 10)),
file_timedate => Zip_Streams.Calendar.Convert (Unsigned_32'(Intel_nb (lhb (11 .. 14)))),
dd =>
(crc_32 => Intel_nb (lhb (15 .. 18)),
compressed_size => Intel_nb (lhb (19 .. 22)),
uncompressed_size => Intel_nb (lhb (23 .. 26))),
filename_length => Intel_nb (lhb (27 .. 28)),
extra_field_length => Intel_nb (lhb (29 .. 30)));
end Read_and_check;
procedure Write (stream : Zipstream_Class;
header : Local_File_Header) is
lhb : Byte_Buffer (1 .. 30);
begin
PK_signature (lhb, 3);
lhb (5 .. 6) := Intel_bf (header.needed_extract_version);
lhb (7 .. 8) := Intel_bf (header.bit_flag);
lhb (9 .. 10) := Intel_bf (header.zip_type);
lhb (11 .. 14) := Intel_bf (Zip_Streams.Calendar.Convert (header.file_timedate));
lhb (15 .. 18) := Intel_bf (header.dd.crc_32);
lhb (19 .. 22) := Intel_bf (header.dd.compressed_size);
lhb (23 .. 26) := Intel_bf (header.dd.uncompressed_size);
lhb (27 .. 28) := Intel_bf (header.filename_length);
lhb (29 .. 30) := Intel_bf (header.extra_field_length);
BlockWrite (stream.all, lhb);
end Write;
procedure Copy_and_check (buffer : Byte_Buffer;
the_end : out End_of_Central_Dir) is
begin
if not PK_signature (buffer, 5) then
raise bad_end;
end if;
the_end :=
(disknum => Intel_nb (buffer (5 .. 6)),
disknum_with_start => Intel_nb (buffer (7 .. 8)),
disk_total_entries => Intel_nb (buffer (9 .. 10)),
total_entries => Intel_nb (buffer (11 .. 12)),
central_dir_size => Intel_nb (buffer (13 .. 16)),
central_dir_offset => Intel_nb (buffer (17 .. 20)),
main_comment_length => Intel_nb (buffer (21 .. 22)),
offset_shifting => 0);
end Copy_and_check;
procedure Read_and_check (stream : Zipstream_Class;
the_end : out End_of_Central_Dir) is
eb : Byte_Buffer (1 .. 22);
begin
BlockRead (stream, eb);
Copy_and_check (eb, the_end);
end Read_and_check;
procedure Load (stream : Zipstream_Class;
the_end : out End_of_Central_Dir) is
end_buffer : Byte_Buffer (1 .. 22);
min_end_start : Ada.Streams.Stream_IO.Count;
use Ada.Streams.Stream_IO;
max_comment : constant := 65_535;
begin
if Size (stream) <= max_comment then
min_end_start := 1;
else
min_end_start := Ada.Streams.Stream_IO.Count (Size (stream)) - max_comment;
end if;
for i in reverse min_end_start .. Ada.Streams.Stream_IO.Count (Size (stream)) - 21 loop
Zip_Streams.Set_Index (stream, Positive (i));
begin
for j in end_buffer'Range loop
Byte'Read (stream, end_buffer (j));
if j = end_buffer'First and then
end_buffer (j) /= Character'Pos ('P')
then
raise bad_end;
end if;
end loop;
Copy_and_check (end_buffer, the_end);
the_end.offset_shifting :=
Unsigned_32 (Zip_Streams.Index (stream) - 22)
-
(
1 +
the_end.central_dir_offset +
the_end.central_dir_size
);
return;
exception
when bad_end =>
if i > min_end_start then
null;
else
raise;
end if;
end;
end loop;
end Load;
procedure Write (stream : Zipstream_Class;
the_end : End_of_Central_Dir) is
eb : Byte_Buffer (1 .. 22);
begin
PK_signature (eb, 5);
eb (5 .. 6) := Intel_bf (the_end.disknum);
eb (7 .. 8) := Intel_bf (the_end.disknum_with_start);
eb (9 .. 10) := Intel_bf (the_end.disk_total_entries);
eb (11 .. 12) := Intel_bf (the_end.total_entries);
eb (13 .. 16) := Intel_bf (the_end.central_dir_size);
eb (17 .. 20) := Intel_bf (the_end.central_dir_offset);
eb (21 .. 22) := Intel_bf (the_end.main_comment_length);
BlockWrite (stream.all, eb);
end Write;
procedure Copy_and_check (buffer : Byte_Buffer;
the_data_desc : out Data_descriptor) is
begin
if not PK_signature (buffer, 7) then
raise bad_data_descriptor;
end if;
the_data_desc.crc_32 := Intel_nb (buffer (5 .. 8));
the_data_desc.compressed_size := Intel_nb (buffer (9 .. 12));
the_data_desc.uncompressed_size := Intel_nb (buffer (13 .. 16));
end Copy_and_check;
procedure Read_and_check (stream : Zipstream_Class;
the_data_desc : out Data_descriptor) is
ddb : Byte_Buffer (1 .. 16);
begin
BlockRead (stream, ddb);
Copy_and_check (ddb, the_data_desc);
end Read_and_check;
procedure Write (stream : Zipstream_Class;
the_data_desc : Data_descriptor) is
ddb : Byte_Buffer (1 .. 16);
begin
PK_signature (ddb, 7);
ddb (5 .. 8) := Intel_bf (the_data_desc.crc_32);
ddb (9 .. 12) := Intel_bf (the_data_desc.compressed_size);
ddb (13 .. 16) := Intel_bf (the_data_desc.uncompressed_size);
BlockWrite (stream.all, ddb);
end Write;
end Zip.Headers;