Back to... Zip-Ada

Source file : unzip.ads



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

Web view of Ada source code generated by GNATHTML, project: ALI_Parse version 1.0.
Zip-Ada: Ada library for zip archive files (.zip). Ada programming.
Some news about Zip-Ada and other Ada projects on Gautier's blog.