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.