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 15-- Ada translation and substantial rewriting by Gautier de Montmollin 16-- On the web: see the Zip.web constant. 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 .. 2018 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 51with Zip; 52 53with Ada.Calendar, Ada.Streams, Ada.Strings.Unbounded; 54 55package 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 64 type Option_set is array( option ) of Boolean; 65 66 no_option: constant Option_set:= ( others=> False ); 67 68 -- Ada 2005's Ada.Directories.Create_Path. 69 -- For Ada 95 compatibility we pass it as an optional procedure access. 70 type Create_Path_proc is access 71 procedure (New_Directory : in String; 72 Form : in String := ""); 73 74 -- This is system-dependent (or in a future Ada) 75 type Set_Time_Stamp_proc is access 76 procedure (file_name: String; stamp: Ada.Calendar.Time); 77 78 -- Alternatively, you can use Zip.Time to set file time stamps 79 type Set_ZTime_Stamp_proc is access 80 procedure (file_name: String; stamp: Zip.Time); 81 -- NB: you can use Zip.Convert to change Ada.Calendar.Time from/to Zip.Time 82 -- or use our Split to avoid using Ada.Calendar at all. 83 84 -- This is for modifying output file names (e.g. adding a 85 -- work directory, modifying the archived path, etc.) 86 type Compose_func is access function ( 87 File_Name : String; 88 Name_encoding : Zip.Zip_name_encoding 89 ) 90 return String; 91 92 -- File System dependent settings 93 type FS_routines_type is record 94 Create_Path : Create_Path_proc; 95 Set_Time_Stamp : Set_Time_Stamp_proc; 96 Compose_File_Name : Compose_func; 97 Set_ZTime_Stamp : Set_ZTime_Stamp_proc; -- alt. to Set_Time_Stamp 98 end record; 99 100 null_routines: constant FS_routines_type:= (null,null,null,null); 101 102 ---------------------------------- 103 -- Simple extraction procedures -- 104 ---------------------------------- 105 106 -- Extract all files from an archive (from) 107 108 procedure Extract( from : String; 109 options : Option_set:= no_option; 110 password : String:= ""; 111 file_system_routines : FS_routines_type:= null_routines 112 ); 113 114 -- Extract one precise file (what) from an archive (from) 115 116 procedure Extract( from : String; 117 what : String; 118 options : Option_set:= no_option; 119 password : String:= ""; 120 file_system_routines : FS_routines_type:= null_routines 121 ); 122 123 -- Extract one precise file (what) from an archive (from), 124 -- but save under a new name (rename) 125 126 procedure Extract( from : String; 127 what : String; 128 rename : String; 129 options : Option_set:= no_option; 130 password : String:= ""; 131 file_system_routines : FS_routines_type:= null_routines 132 ); 133 134 ------------------------------------------------------------------------- 135 -- Simple extraction procedures without re-searching central directory -- 136 ------------------------------------------------------------------------- 137 138 -- Extract all files from an archive (from) 139 -- Needs Zip.Load(from, ...) prior to the extraction 140 141 procedure Extract( from : Zip.Zip_info; 142 options : Option_set:= no_option; 143 password : String:= ""; 144 file_system_routines : FS_routines_type:= null_routines 145 ); 146 147 -- Extract one precise file (what) from an archive (from) 148 -- Needs Zip.Load(from, ...) prior to the extraction 149 150 procedure Extract( from : Zip.Zip_info; 151 what : String; 152 options : Option_set:= no_option; 153 password : String:= ""; 154 file_system_routines : FS_routines_type:= null_routines 155 ); 156 157 -- Extract one precise file (what) from an archive (from), 158 -- but save under a new name (rename) 159 -- Needs Zip.Load(from, ...) prior to the extraction 160 161 procedure Extract( from : Zip.Zip_info; 162 what : String; 163 rename : String; 164 options : Option_set:= no_option; 165 password : String:= ""; 166 file_system_routines : FS_routines_type:= null_routines 167 ); 168 169 subtype PKZip_method is Zip.PKZip_method; 170 171 ---------------------------------------------- 172 -- Extraction procedures for user interface -- 173 ---------------------------------------------- 174 175 -- NB: the *_proc types are accesses to procedures - their usage 176 -- may require the non-standard attribute "unrestricted_access", 177 -- or some changes. 178 -- Read unzipada.adb for details and examples. 179 180 type Name_conflict_intervention is 181 ( yes, no, yes_to_all, none, rename_it, abort_now ); 182 183 current_user_attitude : Name_conflict_intervention:= yes; 184 -- reset to "yes" for a new session (in case of yes_to_all / none state!) 185 186 type Resolve_conflict_proc is access 187 procedure ( name : in String; 188 name_encoding : in Zip.Zip_name_encoding; 189 action : out Name_conflict_intervention; 190 new_name : out String; 191 new_name_length : out Natural ); 192 193 type Get_password_proc is access 194 procedure(password: out Ada.Strings.Unbounded.Unbounded_String); 195 196 -- Data sizes in archive 197 subtype File_size_type is Zip.File_size_type; 198 199 -- Inform user about some archive data 200 201 type Tell_data_proc is access 202 procedure ( name : String; 203 compressed_bytes : File_size_type; 204 uncompressed_bytes : File_size_type; 205 method : PKZip_method ); 206 207 -- Extract all files from an archive (from) 208 209 procedure Extract( from : String; 210 feedback : Zip.Feedback_proc; 211 help_the_file_exists : Resolve_conflict_proc; 212 tell_data : Tell_data_proc; 213 get_pwd : Get_password_proc; 214 options : Option_set:= no_option; 215 password : String:= ""; 216 file_system_routines : FS_routines_type:= null_routines 217 ); 218 219 -- Extract one precise file (what) from an archive (from) 220 221 procedure Extract( from : String; 222 what : String; 223 feedback : Zip.Feedback_proc; 224 help_the_file_exists : Resolve_conflict_proc; 225 tell_data : Tell_data_proc; 226 get_pwd : Get_password_proc; 227 options : Option_set:= no_option; 228 password : String:= ""; 229 file_system_routines : FS_routines_type:= null_routines 230 ); 231 232 -- Extract one precise file (what) from an archive (from), 233 -- but save under a new name (rename) 234 235 procedure Extract( from : String; 236 what : String; 237 rename : String; 238 feedback : Zip.Feedback_proc; 239 tell_data : Tell_data_proc; 240 get_pwd : Get_password_proc; 241 options : Option_set:= no_option; 242 password : String:= ""; 243 file_system_routines : FS_routines_type:= null_routines 244 ); 245 246 -- Using Zip_info structure: 247 248 -- Extract all files from an archive (from) 249 -- Needs Zip.Load(from, ...) prior to the extraction 250 251 procedure Extract( from : Zip.Zip_info; 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 261 -- Extract one precise file (what) from an archive (from) 262 -- Needs Zip.Load(from, ...) prior to the extraction 263 264 procedure Extract( from : Zip.Zip_info; 265 what : String; 266 feedback : Zip.Feedback_proc; 267 help_the_file_exists : Resolve_conflict_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 275 -- Extract one precise file (what) from an archive (from), 276 -- but save under a new name (rename) 277 -- Needs Zip.Load(from, ...) prior to the extraction 278 279 procedure Extract( from : Zip.Zip_info; 280 what : String; 281 rename : String; 282 feedback : Zip.Feedback_proc; 283 tell_data : Tell_data_proc; 284 get_pwd : Get_password_proc; 285 options : Option_set:= no_option; 286 password : String:= ""; 287 file_system_routines : FS_routines_type:= null_routines 288 ); 289 290 -- Errors 291 292 CRC_Error, 293 Uncompressed_size_Error, 294 Write_Error, 295 Read_Error, 296 Wrong_password, 297 User_abort, 298 Not_supported, 299 Unsupported_method : exception; 300 301 tolerance_wrong_password: constant:= 4; 302 -- If password is wrong at the Nth attempt, Wrong_password is raised 303 304private 305 306 type Write_mode is 307 ( write_to_binary_file, 308 write_to_text_file, 309 write_to_memory, 310 write_to_stream, 311 just_test 312 ); 313 314 subtype Write_to_file is Write_mode 315 range write_to_binary_file..write_to_text_file; 316 317 type p_Stream is access all Ada.Streams.Root_Stream_Type'Class; 318 319 type p_Stream_Element_Array is access all Ada.Streams.Stream_Element_Array; 320 321end UnZip; 322