Source file : zip-create.ads
1 -- Zip archive creation
2 --
3 -- Contributed by ITEC - NXP Semiconductors
4 -- June 2008
5 --
6
7 -- Legal licensing note:
8
9 -- Copyright (c) 2008 .. 2023 Gautier de Montmollin
10 -- (maintenance and further development)
11 -- SWITZERLAND
12
13 -- Permission is hereby granted, free of charge, to any person obtaining a copy
14 -- of this software and associated documentation files (the "Software"), to deal
15 -- in the Software without restriction, including without limitation the rights
16 -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
17 -- copies of the Software, and to permit persons to whom the Software is
18 -- furnished to do so, subject to the following conditions:
19
20 -- The above copyright notice and this permission notice shall be included in
21 -- all copies or substantial portions of the Software.
22
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
24 -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
25 -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
26 -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
27 -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
28 -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
29 -- THE SOFTWARE.
30
31 -- NB: this is the MIT License, as found 21-Aug-2016 on the site
32 -- http://www.opensource.org/licenses/mit-license.php
33
34 --
35 -- Change log:
36 -- ==========
37 --
38 -- 29-May-2022: GdM: Support for Zip64 extensions.
39 -- 17-Aug-2020: GdM: Added Zip_Entry_Stream_Type.
40 -- 23-Mar-2016: GdM: Create with Duplicate_name_policy
41 -- 14-Feb-2015: GdM: Added "Is_Created" function
42 -- 13-Feb-2015: GdM: Added "Password" parameter
43 -- 30-Oct-2012: GdM: Removed all profiles using Zip_Streams' objects
44 -- with accesses (cf 25-Oct's modifications)
45 -- 26-Oct-2012: GdM: Added Add_Compressed_Stream
46 -- 25-Oct-2012: GdM: Some procedures using Zip_Streams' objects also with
47 -- pointer-free profiles (no more 'access' or access type)
48 -- 14-Oct-2012: GdM: Added Set procedure for changing compression method
49 -- 30-Mar-2010: GdM: Added Name function
50 -- 25-Feb-2010: GdM: Fixed major bottlenecks around Dir_entries
51 -- -> 5x faster overall for 1000 files, 356x for 100'000 !
52 -- 17-Feb-2009: GdM: Added procedure Add_String
53 -- 10-Feb-2009: GdM: Create / Finish: if Info.Stream is to a file,
54 -- the underling file is also created / closed in time
55 -- 4-Feb-2009: GdM: Added procedure Add_File
56 --
57
58 with Zip.Compress,
59 Zip.Headers;
60
61 with Ada.Containers.Hashed_Maps,
62 Ada.Strings.Unbounded.Hash;
63
64 package Zip.Create is
65
66 type Zip_Create_Info is private;
67
68 subtype Zip_File_Stream is Zip_Streams.File_Zipstream;
69 -- You can use this type for creating Zip archives as files.
70 subtype Zip_Memory_Stream is Zip_Streams.Memory_Zipstream;
71 -- You can use this type for creating Zip archives in memory.
72
73 -- Create the Zip archive; create the Zip file if the stream is a file.
74 --
75 procedure Create_Archive
76 (Info : out Zip_Create_Info;
77 Z_Stream : in Zip_Streams.Zipstream_Class_Access;
78 Archive_Name : String;
79 Compress_Method : Zip.Compress.Compression_Method := Zip.Compress.Deflate_1;
80 Duplicates : Duplicate_name_policy := admit_duplicates);
81
82 function Is_Created (Info : Zip_Create_Info) return Boolean;
83
84 -- Set a new compression method for the next data to be added to the archive.
85 -- Can be useful if some knowledge about the data is known in advance:
86 -- its size, contents (text/machine code/random/...), quantity of files.
87 --
88 procedure Set (Info : in out Zip_Create_Info;
89 New_Method : Zip.Compress.Compression_Method);
90
91 function Name (Info : Zip_Create_Info) return String;
92
93 -- Add a new entry to a Zip archive, from a general *input* Zipstream
94 -- The entry's name is set by Set_Name on the Stream before calling Add_Stream.
95
96 procedure Add_Stream (Info : in out Zip_Create_Info;
97 Stream : in out Zip_Streams.Root_Zipstream_Type'Class;
98 Password : in String := "");
99
100 procedure Add_Stream (Info : in out Zip_Create_Info;
101 Stream : in out Zip_Streams.Root_Zipstream_Type'Class;
102 Feedback : in Feedback_Proc;
103 Password : in String := "";
104 Compressed_Size : out Zip.Zip_64_Data_Size_Type;
105 Final_Method : out Natural);
106
107 default_creation_time : Zip_Streams.Time renames Zip_Streams.default_time;
108
109 -- If use_file_modification_time is passed to Add_File, Ada.Directories.Modification_Time
110 -- will be called on File_Name and that time will be used for setting the Zip entry's time
111 -- stamp. NB: Ada.Directories.Modification_Time is not reliable: it may fail on UTF-8 file
112 -- names on some Ada systems.
113 --
114 use_file_modification_time : Zip_Streams.Time renames Zip_Streams.special_time_1;
115
116 -- If use_clock is passed to Add_File or Add_String, Ada.Calendar.Clock will be called
117 -- and that time will be used for setting the Zip entry's time stamp.
118 -- NB: Ada.Calendar.Clock may be time-consuming on some Ada systems.
119 --
120 use_clock : Zip_Streams.Time renames Zip_Streams.special_time_2;
121
122 -- Add a new entry to a Zip archive, from an entire file
123
124 procedure Add_File (Info : in out Zip_Create_Info;
125 File_Name : String;
126 -- Name_in_archive: default: add the file in
127 -- the archive under the File's name.
128 Name_in_archive : String := "";
129 -- Delete_file_after: practical to delete temporary file after adding.
130 Delete_file_after : Boolean := False;
131 Name_encoding : Zip_Name_Encoding := IBM_437;
132 -- Time stamp for this entry
133 Modification_time : Time := default_creation_time;
134 Is_read_only : Boolean := False;
135 Feedback : Feedback_Proc := null;
136 Password : String := "");
137
138 -- Add a new entry to a Zip archive, from a buffer stored in a string
139
140 procedure Add_String (Info : in out Zip_Create_Info;
141 Contents : String;
142 Name_in_archive : String;
143 -- Name_UTF_8_encoded = True if Name is actually UTF-8 encoded (Unicode)
144 Name_UTF_8_encoded : Boolean := False;
145 Password : String := "";
146 -- Time stamp for this entry
147 Creation_time : Zip.Time := default_creation_time);
148
149 procedure Add_String (Info : in out Zip_Create_Info;
150 Contents : Ada.Strings.Unbounded.Unbounded_String;
151 Name_in_archive : String;
152 -- Name_UTF_8_encoded = True if Name is actually UTF-8 encoded (Unicode)
153 Name_UTF_8_encoded : Boolean := False;
154 Password : String := "";
155 -- Time stamp for this entry
156 Creation_time : Zip.Time := default_creation_time);
157
158 procedure Add_Empty_Folder
159 (Info : in out Zip_Create_Info;
160 Folder_Name : in String;
161 -- Name_UTF_8_encoded = True if Name is actually UTF-8 encoded (Unicode)
162 Name_UTF_8_encoded : in Boolean := False);
163
164 -- Add a new entry to a Zip archive, copied from another Zip archive.
165 -- This is useful for duplicating archives with some differences, like
166 -- adding, replacing, removing or recompressing entries, while preserving
167 -- other entries, which Add_Compressed_Stream is for.
168 -- See the AZip file manager ( http://azip.sf.net ) for an application example.
169 -- The streams' indices are set at the beginning of local headers in both archives.
170 --
171 procedure Add_Compressed_Stream
172 (Info : in out Zip_Create_Info; -- Destination
173 Stream : in out Zip_Streams.Root_Zipstream_Type'Class; -- Source
174 Feedback : in Feedback_Proc);
175
176 -- Zip_Entry_Stream_Type
177 -------------------------
178 -- With that type, you can add an entry as an *output* stream
179 -- to a Zip archive. The workflow is:
180 --
181 -- Create_Archive (Info, ...);
182 -- [for each entry]:
183 -- Open (Zip_Entry_Stream, Guess); -- Guess = guess of data size
184 -- [various occurrences of]: T'Write (Zip_Entry_Stream, Data);
185 -- Close (Zip_Entry_Stream, "contents.dat", Info);
186 -- Finish (Info);
187 --
188 -- For a full example, see: test/test_zip_entry_stream.adb
189
190 type Zip_Entry_Stream_Type is
191 new Ada.Streams.Root_Stream_Type with private;
192
193 Default_Zip_Entry_Buffer_Size : constant := 1024 ** 2;
194 Default_Zip_Entry_Buffer_Growth : constant := 8;
195
196 procedure Open
197 (Zip_Entry_Stream : out Zip_Entry_Stream_Type;
198 Initial_Buffer_Size : in Positive := Default_Zip_Entry_Buffer_Size;
199 Buffer_Growth_Factor : in Positive := Default_Zip_Entry_Buffer_Growth);
200
201 procedure Close
202 (Zip_Entry_Stream : in out Zip_Entry_Stream_Type;
203 Entry_Name : in String;
204 Creation_Time : in Zip.Time := default_creation_time;
205 Info : in out Zip_Create_Info);
206
207 -- Finish: complete the Zip archive when all desired entries have
208 -- been added; close the Zip file if the archive stream is in
209 -- File_Zipstream's class.
210 --
211 procedure Finish (Info : in out Zip_Create_Info);
212
213 -- The following exception is raised on cases when the Zip archive
214 -- creation exceeds the Zip_64 format's capacity in our implementation:
215 -- * 2 EiB (Exbibytes) total size, which represents around 2.3 million Terabytes
216 -- * around 2 billion entries (archived files).
217
218 Zip_Capacity_Exceeded : exception;
219
220 -- We limit somewhat the real maximum size (16 EiB) in order
221 -- to catch issues with size before an integer overflow.
222 -- 1 EiB = 1024 PiB (Pebibyte) = 1024*1024 TiB = 1,048,576 TiB (Tebibyte),
223 -- around 1,152,922 Terabytes.
224 max_size : constant := 16#1FFF_FFFF_FFFF_FFFF#; -- 2 EiB.
225
226 private
227
228 type Dir_entry is record
229 head : Zip.Headers.Central_File_Header;
230 name : p_String;
231 end record;
232
233 type Dir_entries is array (Positive_M32 range <>) of Dir_entry;
234 type Pdir_entries is access Dir_entries;
235
236 -- The use of Hashed_Maps makes Test_Zip_Create_Info_Timing run ~10x faster than
237 -- with the unbalanced binary tree of previous versions.
238 --
239 package Name_mapping is
240 new Ada.Containers.Hashed_Maps
241 (Ada.Strings.Unbounded.Unbounded_String,
242 Positive,
243 Ada.Strings.Unbounded.Hash,
244 Ada.Strings.Unbounded."=");
245
246 type Zip_Create_Info is record
247 Stream : Zip_Streams.Zipstream_Class_Access;
248 Compress : Zip.Compress.Compression_Method;
249 Contains : Pdir_entries := null;
250 -- 'Contains' has unused room, to avoid reallocating each time:
251 Last_entry : Natural_M32 := 0;
252 Duplicates : Duplicate_name_policy;
253 -- We set up a name dictionary just for detecting duplicate entries:
254 name_dictionary : Name_mapping.Map;
255 -- The format is Zip_32 but is automatically promoted
256 -- to Zip_64 if needed.
257 zip_archive_format : Zip_archive_format_type := Zip_32;
258 end record;
259
260 type Stream_Element_Array_Access is
261 access Ada.Streams.Stream_Element_Array;
262
263 type Zip_Entry_Stream_Type is new Ada.Streams.Root_Stream_Type with record
264 Buffer_Access : Stream_Element_Array_Access := null;
265 Last_Element : Ada.Streams.Stream_Element_Offset;
266 Growth : Positive;
267 end record;
268
269 overriding procedure Read
270 (Stream : in out Zip_Entry_Stream_Type;
271 Item : out Ada.Streams.Stream_Element_Array;
272 Last : out Ada.Streams.Stream_Element_Offset)
273 is null;
274
275 overriding procedure Write
276 (Stream : in out Zip_Entry_Stream_Type;
277 Item : Ada.Streams.Stream_Element_Array);
278
279 end Zip.Create;
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.
