1. with Ada.Streams; use Ada.Streams; 
  2. package body Zip.Headers is 
  3.  
  4.    ----------------------------------------------------------- 
  5.    -- Byte array < - > various integers, with Intel endianess -- 
  6.    ----------------------------------------------------------- 
  7.  
  8.    -- Get numbers with correct trucmuche endian, to ensure 
  9.    -- correct header loading on some non - Intel machines 
  10.  
  11.    generic 
  12.       type Number is mod <>; -- range <> in Ada83 version (fake Interfaces) 
  13.    function Intel_x86_number (b : Byte_Buffer) return Number; 
  14.  
  15.    function Intel_x86_number (b : Byte_Buffer) return Number is 
  16.  
  17.       n : Number := 0; 
  18.  
  19.    begin 
  20.       for i in reverse b'Range loop 
  21.          n := n * 256 + Number (b (i)); 
  22.       end loop; 
  23.       return n; 
  24.    end Intel_x86_number; 
  25.  
  26.    function Intel_nb is new Intel_x86_number (Unsigned_16); 
  27.    function Intel_nb is new Intel_x86_number (Unsigned_32); 
  28.  
  29.    -- Put numbers with correct endianess as bytes 
  30.  
  31.    generic 
  32.       type Number is mod <>; -- range <> in Ada83 version (fake Interfaces) 
  33.       size : Positive; 
  34.    function Intel_x86_buffer (n : Number) return Byte_Buffer; 
  35.  
  36.    function Intel_x86_buffer (n : Number) return Byte_Buffer is 
  37.  
  38.       b : Byte_Buffer (1 .. size); 
  39.       m : Number := n; 
  40.  
  41.    begin 
  42.       for i in b'Range loop 
  43.          b (i) := Unsigned_8 (m and 255); 
  44.          m := m / 256; 
  45.       end loop; 
  46.       return b; 
  47.    end Intel_x86_buffer; 
  48.  
  49.    function Intel_bf is new Intel_x86_buffer (Unsigned_16, 2); 
  50.    function Intel_bf is new Intel_x86_buffer (Unsigned_32, 4); 
  51.  
  52.    ------------------- 
  53.    -- PK signatures -- 
  54.    ------------------- 
  55.  
  56.    function PK_signature (buf : Byte_Buffer; code : Unsigned_8) return Boolean is 
  57.      (buf (1 .. 4) = (16#50#, 16#4B#, code, code + 1)); -- PK12, PK34, . .. 
  58.  
  59.    procedure PK_signature (buf : in out Byte_Buffer; code : Unsigned_8) is 
  60.  
  61.    begin 
  62.       buf (1 .. 4) := (16#50#, 16#4B#, code, code + 1); -- PK12, PK34, . .. 
  63.    end PK_signature; 
  64.  
  65.    ------------------------------------------------------- 
  66.    -- PKZIP file header, as in central directory - PK12 -- 
  67.    ------------------------------------------------------- 
  68.  
  69.    procedure Read_and_check (stream  :     Zipstream_Class; 
  70.                              header  : out Central_File_Header) is 
  71.  
  72.       chb : Byte_Buffer (1 .. 46); 
  73.  
  74.    begin 
  75.       BlockRead (stream, chb); 
  76.  
  77.       if not PK_signature (chb, 1) then 
  78.          raise bad_central_header; 
  79.       end if; 
  80.  
  81.       header := (made_by_version     => Intel_nb (chb (5  ..  6)), 
  82.                  short_info          => 
  83.                    (needed_extract_version => Intel_nb (chb (7  ..  8)), 
  84.                     bit_flag               => Intel_nb (chb (9  .. 10)), 
  85.                     zip_type               => Intel_nb (chb (11 .. 12)), 
  86.                     file_timedate          => Zip_Streams.Calendar.Convert (Unsigned_32'(Intel_nb (chb (13 .. 16)))), 
  87.                     dd                     => 
  88.                       (crc_32            => Intel_nb (chb (17 .. 20)), 
  89.                        compressed_size   => Intel_nb (chb (21 .. 24)), 
  90.                        uncompressed_size => Intel_nb (chb (25 .. 28))), 
  91.                     filename_length        => Intel_nb (chb (29 .. 30)), 
  92.                     extra_field_length     => Intel_nb (chb (31 .. 32))), 
  93.                  comment_length      => Intel_nb (chb (33 .. 34)), 
  94.                  disk_number_start   => Intel_nb (chb (35 .. 36)), 
  95.                  internal_attributes => Intel_nb (chb (37 .. 38)), 
  96.                  external_attributes => Intel_nb (chb (39 .. 42)), 
  97.                  local_header_offset => Intel_nb (chb (43 .. 46))); 
  98.  
  99.    end Read_and_check; 
  100.  
  101.    procedure Write (stream  : Zipstream_Class; 
  102.                     header  : Central_File_Header) is 
  103.  
  104.       chb : Byte_Buffer (1 .. 46); 
  105.  
  106.    begin 
  107.       PK_signature (chb, 1); 
  108.  
  109.       chb (5  ..  6) := Intel_bf (header.made_by_version); 
  110.       chb (7  ..  8) := Intel_bf (header.short_info.needed_extract_version); 
  111.       chb (9  .. 10) := Intel_bf (header.short_info.bit_flag); 
  112.       chb (11 .. 12) := Intel_bf (header.short_info.zip_type); 
  113.       chb (13 .. 16) := Intel_bf (Zip_Streams.Calendar.Convert (header.short_info.file_timedate)); 
  114.       chb (17 .. 20) := Intel_bf (header.short_info.dd.crc_32); 
  115.       chb (21 .. 24) := Intel_bf (header.short_info.dd.compressed_size); 
  116.       chb (25 .. 28) := Intel_bf (header.short_info.dd.uncompressed_size); 
  117.       chb (29 .. 30) := Intel_bf (header.short_info.filename_length); 
  118.       chb (31 .. 32) := Intel_bf (header.short_info.extra_field_length); 
  119.       chb (33 .. 34) := Intel_bf (header.comment_length); 
  120.       chb (35 .. 36) := Intel_bf (header.disk_number_start); 
  121.       chb (37 .. 38) := Intel_bf (header.internal_attributes); 
  122.       chb (39 .. 42) := Intel_bf (header.external_attributes); 
  123.       chb (43 .. 46) := Intel_bf (header.local_header_offset); 
  124.  
  125.       BlockWrite (stream.all, chb); 
  126.    end Write; 
  127.  
  128.    ----------------------------------------------------------------------- 
  129.    -- PKZIP local file header, in front of every file in archive - PK34 -- 
  130.    ----------------------------------------------------------------------- 
  131.  
  132.    procedure Read_and_check (stream :     Zipstream_Class; 
  133.                              header : out Local_File_Header) is 
  134.  
  135.       lhb : Byte_Buffer (1 .. 30); 
  136.  
  137.    begin 
  138.       BlockRead (stream, lhb); 
  139.  
  140.       if not PK_signature (lhb, 3) then 
  141.          raise bad_local_header; 
  142.       end if; 
  143.  
  144.       header := 
  145.         (needed_extract_version => Intel_nb (lhb (5  ..  6)), 
  146.          bit_flag               => Intel_nb (lhb (7  ..  8)), 
  147.          zip_type               => Intel_nb (lhb (9  .. 10)), 
  148.          file_timedate          => Zip_Streams.Calendar.Convert (Unsigned_32'(Intel_nb (lhb (11 .. 14)))), 
  149.          dd                     => 
  150.            (crc_32            => Intel_nb (lhb (15 .. 18)), 
  151.             compressed_size   => Intel_nb (lhb (19 .. 22)), 
  152.             uncompressed_size => Intel_nb (lhb (23 .. 26))), 
  153.          filename_length      => Intel_nb (lhb (27 .. 28)), 
  154.          extra_field_length     => Intel_nb (lhb (29 .. 30))); 
  155.  
  156.    end Read_and_check; 
  157.  
  158.    procedure Write (stream : Zipstream_Class; 
  159.                     header : Local_File_Header) is 
  160.  
  161.       lhb : Byte_Buffer (1 .. 30); 
  162.  
  163.    begin 
  164.       PK_signature (lhb, 3); 
  165.  
  166.       lhb (5  ..  6) := Intel_bf (header.needed_extract_version); 
  167.       lhb (7  ..  8) := Intel_bf (header.bit_flag); 
  168.       lhb (9  .. 10) := Intel_bf (header.zip_type); 
  169.       lhb (11 .. 14) := Intel_bf (Zip_Streams.Calendar.Convert (header.file_timedate)); 
  170.       lhb (15 .. 18) := Intel_bf (header.dd.crc_32); 
  171.       lhb (19 .. 22) := Intel_bf (header.dd.compressed_size); 
  172.       lhb (23 .. 26) := Intel_bf (header.dd.uncompressed_size); 
  173.       lhb (27 .. 28) := Intel_bf (header.filename_length); 
  174.       lhb (29 .. 30) := Intel_bf (header.extra_field_length); 
  175.  
  176.       BlockWrite (stream.all, lhb); 
  177.    end Write; 
  178.  
  179.    ------------------------------------------- 
  180.    -- PKZIP end - of - central - directory - PK56 -- 
  181.    ------------------------------------------- 
  182.  
  183.    procedure Copy_and_check (buffer  :     Byte_Buffer; 
  184.                              the_end : out End_of_Central_Dir) is 
  185.  
  186.    begin 
  187.       if not PK_signature (buffer, 5) then 
  188.          raise bad_end; 
  189.       end if; 
  190.  
  191.       the_end := 
  192.         (disknum             => Intel_nb (buffer (5  ..  6)), 
  193.          disknum_with_start  => Intel_nb (buffer (7  ..  8)), 
  194.          disk_total_entries  => Intel_nb (buffer (9  .. 10)), 
  195.          total_entries       => Intel_nb (buffer (11 .. 12)), 
  196.          central_dir_size    => Intel_nb (buffer (13 .. 16)), 
  197.          central_dir_offset  => Intel_nb (buffer (17 .. 20)), 
  198.          main_comment_length => Intel_nb (buffer (21 .. 22)), 
  199.          offset_shifting     => 0); -- Assuming single zip archive here 
  200.  
  201.    end Copy_and_check; 
  202.  
  203.    procedure Read_and_check (stream  :     Zipstream_Class; 
  204.                              the_end : out End_of_Central_Dir) is 
  205.  
  206.       eb : Byte_Buffer (1 .. 22); 
  207.  
  208.    begin 
  209.       BlockRead (stream, eb); 
  210.       Copy_and_check (eb, the_end); 
  211.    end Read_and_check; 
  212.  
  213.    -- Some explanations - GdM 2001 
  214.  
  215.    -- The idea is that the .ZIP can be appended to an .EXE, for 
  216.    -- self - extracting purposes. So, the most general infos are 
  217.    -- at the end, and we crawl back for more precise infos: 
  218.    --  1) end - of - central directory 
  219.    --  2) central directory 
  220.    --  3) zipped files 
  221.  
  222.    procedure Load (stream  :     Zipstream_Class; 
  223.                    the_end : out End_of_Central_Dir) is 
  224.  
  225.       end_buffer    : Byte_Buffer (1 .. 22); 
  226.       min_end_start : Ada.Streams.Stream_IO.Count; 
  227.  
  228.       use Ada.Streams.Stream_IO; 
  229.  
  230.       max_comment : constant := 65_535; 
  231.  
  232.    begin 
  233.       -- 20 - Jun - 2001 : abandon search below min_end_start 
  234.       --              - read about max comment length in appnote 
  235.  
  236.       if Size (stream) <= max_comment then 
  237.          min_end_start := 1; 
  238.       else 
  239.          min_end_start := Ada.Streams.Stream_IO.Count (Size (stream)) - max_comment; 
  240.       end if; 
  241.  
  242.       -- Yes, we must _search_ for it .. . 
  243.       -- because PKWARE put a variable - size comment _after_ it 8 - ( 
  244.  
  245.       for i in reverse min_end_start .. Ada.Streams.Stream_IO.Count (Size (stream)) - 21 loop 
  246.          Zip_Streams.Set_Index (stream, Positive (i)); 
  247.          begin 
  248.             for j in end_buffer'Range loop 
  249.                Byte'Read (stream, end_buffer (j)); 
  250.                -- 20 - Jun - 2001 : useless to read more if 1st character is not 'P' 
  251.                if j = end_buffer'First and then 
  252.                  end_buffer (j) /= Character'Pos ('P') 
  253.                then 
  254.                   raise bad_end; 
  255.                end if; 
  256.             end loop; 
  257.             Copy_and_check (end_buffer, the_end); 
  258.             -- at this point, the buffer was successfully read 
  259.             -- (no exception raised). 
  260.             the_end.offset_shifting := 
  261.             -- This is the real position of the end - of - central - directory block. 
  262.               Unsigned_32 (Zip_Streams.Index (stream) - 22) 
  263.               - 
  264.             -- This is the theoretical position of the end - of - central - directory, 
  265.             -- block. Should coincide with the real position if the zip file 
  266.             -- is not appended. 
  267.               ( 
  268.                1 + 
  269.                  the_end.central_dir_offset + 
  270.                    the_end.central_dir_size 
  271.               ); 
  272.             return; -- the_end found and filled - > exit 
  273.          exception 
  274.             when bad_end => 
  275.                if i > min_end_start then 
  276.                   null;  -- we will try 1 index before .. . 
  277.                else 
  278.                   raise; -- definitely no "end - of - central - directory" here 
  279.                end if; 
  280.          end; 
  281.       end loop; 
  282.    end Load; 
  283.  
  284.    procedure Write (stream  : Zipstream_Class; 
  285.                     the_end : End_of_Central_Dir) is 
  286.  
  287.       eb : Byte_Buffer (1 .. 22); 
  288.  
  289.    begin 
  290.       PK_signature (eb, 5); 
  291.  
  292.       eb (5 .. 6) := Intel_bf (the_end.disknum); 
  293.       eb (7 .. 8) := Intel_bf (the_end.disknum_with_start); 
  294.       eb (9 .. 10) := Intel_bf (the_end.disk_total_entries); 
  295.       eb (11 .. 12) := Intel_bf (the_end.total_entries); 
  296.       eb (13 .. 16) := Intel_bf (the_end.central_dir_size); 
  297.       eb (17 .. 20) := Intel_bf (the_end.central_dir_offset); 
  298.       eb (21 .. 22) := Intel_bf (the_end.main_comment_length); 
  299.  
  300.       BlockWrite (stream.all, eb); 
  301.    end Write; 
  302.  
  303.    ------------------------------------------------------------------ 
  304.    -- PKZIP data descriptor, after streamed compressed data - PK78 -- 
  305.    ------------------------------------------------------------------ 
  306.  
  307.    procedure Copy_and_check (buffer        :     Byte_Buffer; 
  308.                              the_data_desc : out Data_descriptor) is 
  309.  
  310.    begin 
  311.       if not PK_signature (buffer, 7) then 
  312.          raise bad_data_descriptor; 
  313.       end if; 
  314.  
  315.       the_data_desc.crc_32 :=             Intel_nb (buffer (5 .. 8)); 
  316.       the_data_desc.compressed_size :=    Intel_nb (buffer (9 .. 12)); 
  317.       the_data_desc.uncompressed_size :=  Intel_nb (buffer (13 .. 16)); 
  318.  
  319.    end Copy_and_check; 
  320.  
  321.    procedure Read_and_check (stream        :     Zipstream_Class; 
  322.                              the_data_desc : out Data_descriptor) is 
  323.  
  324.       ddb : Byte_Buffer (1 .. 16); 
  325.  
  326.    begin 
  327.       BlockRead (stream, ddb); 
  328.       Copy_and_check (ddb, the_data_desc); 
  329.    end Read_and_check; 
  330.  
  331.    procedure Write (stream        : Zipstream_Class; 
  332.                     the_data_desc : Data_descriptor) is 
  333.  
  334.       ddb : Byte_Buffer (1 .. 16); 
  335.  
  336.    begin 
  337.       PK_signature (ddb, 7); 
  338.  
  339.       ddb (5 .. 8) := Intel_bf (the_data_desc.crc_32); 
  340.       ddb (9 .. 12) := Intel_bf (the_data_desc.compressed_size); 
  341.       ddb (13 .. 16) := Intel_bf (the_data_desc.uncompressed_size); 
  342.  
  343.       BlockWrite (stream.all, ddb); 
  344.    end Write; 
  345.  
  346. end Zip.Headers;