1. --  ________  ___   ______       ______     ___ 
  2. -- /___..._/  |.|   |.___.\     /. __ .\  __|.|   ____ 
  3. --    /../    |.|   |.____/     |.|__|.| /....|  __\..\ 
  4. --  _/../___  |.|   |.|    ===  |..__..||. = .| | = ..| 
  5. -- /_______/  |_|  /__|        /__|  |_| \__\_|  \__\_| 
  6.  
  7. -- UnZip 
  8. -------- 
  9. -- This library allows to uncompress deflated, enhanced deflated, bzip2-ed, 
  10. -- imploded, reduced, shrunk and stored streams from a Zip archive stream. 
  11. -- 
  12. -- Pure Ada 95 code, 100% portable: OS-, CPU- and compiler- independent. 
  13.  
  14. --  Ada translation and substantial rewriting by Gautier de Montmollin 
  15. --    On the web: see the Zip.web constant below. 
  16. --  based on Pascal version 2.10 by Abimbola A Olowofoyeku, 
  17. --    http://www.greatchief.plus.com/ 
  18. --  itself based on Pascal version by Christian Ghisler, 
  19. --  itself based on C code by Info-Zip group (Mark Adler et al.) 
  20. --    http://www.info-zip.org/UnZip.html 
  21.  
  22. -- Technical documentation: read appnote.txt 
  23.  
  24. -- Legal licensing note: 
  25.  
  26. --  Copyright (c) 1999..2010 Gautier de Montmollin 
  27.  
  28. --  Permission is hereby granted, free of charge, to any person obtaining a copy 
  29. --  of this software and associated documentation files (the "Software"), to deal 
  30. --  in the Software without restriction, including without limitation the rights 
  31. --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
  32. --  copies of the Software, and to permit persons to whom the Software is 
  33. --  furnished to do so, subject to the following conditions: 
  34.  
  35. --  The above copyright notice and this permission notice shall be included in 
  36. --  all copies or substantial portions of the Software. 
  37.  
  38. --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
  39. --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
  40. --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
  41. --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
  42. --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
  43. --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
  44. --  THE SOFTWARE. 
  45.  
  46. -- NB: this is the MIT License, as found 12-Sep-2007 on the site 
  47. -- http://www.opensource.org/licenses/mit-license.php 
  48.  
  49. with Zip; 
  50.  
  51. with Ada.Calendar, Ada.Streams, Ada.Strings.Unbounded; 
  52.  
  53. package UnZip is 
  54.  
  55.   type option is ( 
  56.     test_only,            -- test .zip file integrity, no write 
  57.     junk_directories,     -- ignore directory info -> extract to current one 
  58.     case_sensitive_match, -- case sensitive name matching 
  59.     extract_as_text       -- files will be written with native line endings 
  60.   ); 
  61.  
  62.   type Option_set is array( option ) of Boolean; 
  63.  
  64.   no_option: constant Option_set:= ( others=> False ); 
  65.  
  66.   -- Ada 2005's Ada.Directories.Create_Path. 
  67.   -- For Ada 95 compatibility we pass it as an optional procedure access. 
  68.   type Create_Path_proc is access 
  69.     procedure (New_Directory : in String; 
  70.                Form          : in String := ""); 
  71.  
  72.   -- This is system-dependent (or in a future Ada) 
  73.   type Set_Time_Stamp_proc is access 
  74.     procedure (file_name: String; stamp: Ada.Calendar.Time); 
  75.  
  76.   -- Alternatively, you can use Zip.Time to set file time stamps 
  77.   type Set_ZTime_Stamp_proc is access 
  78.     procedure (file_name: String; stamp: Zip.Time); 
  79.   -- NB: you can use Zip.Convert to change Ada.Calendar.Time from/to Zip.Time 
  80.   --     or use our Split to avoid using Ada.Calendar at all. 
  81.  
  82.   -- This is for modifying output file names (e.g. adding a 
  83.   -- work directory, modifying the archived path, etc.) 
  84.   type Compose_func is access function (File_Name : String) return String; 
  85.  
  86.   -- File System dependent settings 
  87.   type FS_routines_type is record 
  88.     Create_Path            : Create_Path_proc; 
  89.     Set_Time_Stamp         : Set_Time_Stamp_proc; 
  90.     Compose_File_Name      : Compose_func; 
  91.     Set_ZTime_Stamp        : Set_ZTime_Stamp_proc; -- alt. to Set_Time_Stamp 
  92.   end record; 
  93.  
  94.   null_routines: constant FS_routines_type:= (null,null,null,null); 
  95.  
  96.  
  97.   ---------------------------------- 
  98.   -- Simple extraction procedures -- 
  99.   ---------------------------------- 
  100.  
  101.   -- Extract all files from an archive (from) 
  102.  
  103.   procedure Extract( from                 : String; 
  104.                      options              : Option_set:= no_option; 
  105.                      password             : String:= ""; 
  106.                      file_system_routines : FS_routines_type:= null_routines 
  107.                    ); 
  108.  
  109.   -- Extract one precise file (what) from an archive (from) 
  110.  
  111.   procedure Extract( from                 : String; 
  112.                      what                 : String; 
  113.                      options              : Option_set:= no_option; 
  114.                      password             : String:= ""; 
  115.                      file_system_routines : FS_routines_type:= null_routines 
  116.                    ); 
  117.  
  118.   -- Extract one precise file (what) from an archive (from), 
  119.   -- but save under a new name (rename) 
  120.  
  121.   procedure Extract( from                 : String; 
  122.                      what                 : String; 
  123.                      rename               : String; 
  124.                      options              : Option_set:= no_option; 
  125.                      password             : String:= ""; 
  126.                      file_system_routines : FS_routines_type:= null_routines 
  127.                    ); 
  128.  
  129.   ------------------------------------------------------------------------- 
  130.   -- Simple extraction procedures without re-searching central directory -- 
  131.   ------------------------------------------------------------------------- 
  132.  
  133.   -- Extract all files from an archive (from) 
  134.   -- Needs Zip.Load(from, ...) prior to the extraction 
  135.  
  136.   procedure Extract( from                 : Zip.Zip_info; 
  137.                      options              : Option_set:= no_option; 
  138.                      password             : String:= ""; 
  139.                      file_system_routines : FS_routines_type:= null_routines 
  140.                    ); 
  141.  
  142.   -- Extract one precise file (what) from an archive (from) 
  143.   -- Needs Zip.Load(from, ...) prior to the extraction 
  144.  
  145.   procedure Extract( from                 : Zip.Zip_info; 
  146.                      what                 : String; 
  147.                      options              : Option_set:= no_option; 
  148.                      password             : String:= ""; 
  149.                      file_system_routines : FS_routines_type:= null_routines 
  150.                    ); 
  151.  
  152.   -- Extract one precise file (what) from an archive (from), 
  153.   -- but save under a new name (rename) 
  154.   -- Needs Zip.Load(from, ...) prior to the extraction 
  155.  
  156.   procedure Extract( from                 : Zip.Zip_info; 
  157.                      what                 : String; 
  158.                      rename               : String; 
  159.                      options              : Option_set:= no_option; 
  160.                      password             : String:= ""; 
  161.                      file_system_routines : FS_routines_type:= null_routines 
  162.                    ); 
  163.  
  164.   subtype PKZip_method is Zip.PKZip_method; 
  165.  
  166.   ---------------------------------------------- 
  167.   -- Extraction procedures for user interface -- 
  168.   ---------------------------------------------- 
  169.  
  170.   -- NB: the *_proc types are accesses to procedures - their usage 
  171.   -- may require the non-standard attribute "unrestricted_access", 
  172.   -- or some changes. 
  173.   -- Read unzipada.adb for details and examples. 
  174.  
  175.   type Name_conflict_intervention is 
  176.     ( yes, no, yes_to_all, none, rename_it, abort_now ); 
  177.  
  178.   current_user_attitude : Name_conflict_intervention:= yes; 
  179.   -- reset to "yes" for a new session (in case of yes_to_all / none state!) 
  180.  
  181.   type Resolve_conflict_proc is access 
  182.     procedure ( name            :  in String; 
  183.                 action          : out Name_conflict_intervention; 
  184.                 new_name        : out String; 
  185.                 new_name_length : out Natural ); 
  186.  
  187.  
  188.   type Get_password_proc is access 
  189.     procedure(password: out Ada.Strings.Unbounded.Unbounded_String); 
  190.  
  191.   -- Data sizes in archive 
  192.   subtype File_size_type is Zip.File_size_type; 
  193.  
  194.   -- Inform user about some archive data 
  195.  
  196.   type Tell_data_proc is access 
  197.     procedure ( name               : String; 
  198.                 compressed_bytes   : File_size_type; 
  199.                 uncompressed_bytes : File_size_type; 
  200.                 method             : PKZip_method ); 
  201.  
  202.   -- Extract all files from an archive (from) 
  203.  
  204.   procedure Extract( from                 : String; 
  205.                      feedback             : Zip.Feedback_proc; 
  206.                      help_the_file_exists : Resolve_conflict_proc; 
  207.                      tell_data            : Tell_data_proc; 
  208.                      get_pwd              : Get_password_proc; 
  209.                      options              : Option_set:= no_option; 
  210.                      password             : String:= ""; 
  211.                      file_system_routines : FS_routines_type:= null_routines 
  212.                    ); 
  213.  
  214.   -- Extract one precise file (what) from an archive (from) 
  215.  
  216.   procedure Extract( from                 : String; 
  217.                      what                 : String; 
  218.                      feedback             : Zip.Feedback_proc; 
  219.                      help_the_file_exists : Resolve_conflict_proc; 
  220.                      tell_data            : Tell_data_proc; 
  221.                      get_pwd              : Get_password_proc; 
  222.                      options              : Option_set:= no_option; 
  223.                      password             : String:= ""; 
  224.                      file_system_routines : FS_routines_type:= null_routines 
  225.                    ); 
  226.  
  227.   -- Extract one precise file (what) from an archive (from), 
  228.   -- but save under a new name (rename) 
  229.  
  230.   procedure Extract( from        : String; 
  231.                      what        : String; 
  232.                      rename      : String; 
  233.                      feedback    : Zip.Feedback_proc; 
  234.                      tell_data   : Tell_data_proc; 
  235.                      get_pwd     : Get_password_proc; 
  236.                      options     : Option_set:= no_option; 
  237.                      password    : String:= ""; 
  238.                      file_system_routines : FS_routines_type:= null_routines 
  239.                    ); 
  240.  
  241.   -- Using Zip_info structure: 
  242.  
  243.   -- Extract all files from an archive (from) 
  244.   -- Needs Zip.Load(from, ...) prior to the extraction 
  245.  
  246.   procedure Extract( from                 : Zip.Zip_info; 
  247.                      feedback             : Zip.Feedback_proc; 
  248.                      help_the_file_exists : Resolve_conflict_proc; 
  249.                      tell_data            : Tell_data_proc; 
  250.                      get_pwd              : Get_password_proc; 
  251.                      options              : Option_set:= no_option; 
  252.                      password             : String:= ""; 
  253.                      file_system_routines : FS_routines_type:= null_routines 
  254.                    ); 
  255.  
  256.   -- Extract one precise file (what) from an archive (from) 
  257.   -- Needs Zip.Load(from, ...) prior to the extraction 
  258.  
  259.   procedure Extract( from                 : Zip.Zip_info; 
  260.                      what                 : String; 
  261.                      feedback             : Zip.Feedback_proc; 
  262.                      help_the_file_exists : Resolve_conflict_proc; 
  263.                      tell_data            : Tell_data_proc; 
  264.                      get_pwd              : Get_password_proc; 
  265.                      options              : Option_set:= no_option; 
  266.                      password             : String:= ""; 
  267.                      file_system_routines : FS_routines_type:= null_routines 
  268.                    ); 
  269.  
  270.   -- Extract one precise file (what) from an archive (from), 
  271.   -- but save under a new name (rename) 
  272.   -- Needs Zip.Load(from, ...) prior to the extraction 
  273.  
  274.   procedure Extract( from                 : Zip.Zip_info; 
  275.                      what                 : String; 
  276.                      rename               : String; 
  277.                      feedback             : Zip.Feedback_proc; 
  278.                      tell_data            : Tell_data_proc; 
  279.                      get_pwd              : Get_password_proc; 
  280.                      options              : Option_set:= no_option; 
  281.                      password             : String:= ""; 
  282.                      file_system_routines : FS_routines_type:= null_routines 
  283.                    ); 
  284.  
  285.   -- Errors 
  286.  
  287.   CRC_Error, 
  288.   Uncompressed_size_Error, 
  289.   Write_Error, 
  290.   Read_Error, 
  291.   Wrong_password, 
  292.   User_abort, 
  293.   Not_supported, 
  294.   Unsupported_method, 
  295.   Wrong_or_no_password, 
  296.   Internal_Error : exception; 
  297.  
  298. private 
  299.  
  300.   type Write_mode is 
  301.     ( write_to_binary_file, 
  302.       write_to_text_file, 
  303.       write_to_memory, 
  304.       just_test 
  305.     ); 
  306.  
  307.   subtype Write_to_file is Write_mode 
  308.     range write_to_binary_file..write_to_text_file; 
  309.  
  310.   type p_Stream_Element_Array is access all Ada.Streams.Stream_Element_Array; 
  311.  
  312. end UnZip;