line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Archive::Zip::Member; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# A generic member of an archive |
4
|
|
|
|
|
|
|
|
5
|
26
|
|
|
26
|
|
186
|
use strict; |
|
26
|
|
|
|
|
61
|
|
|
26
|
|
|
|
|
917
|
|
6
|
26
|
|
|
26
|
|
145
|
use vars qw( $VERSION @ISA ); |
|
26
|
|
|
|
|
67
|
|
|
26
|
|
|
|
|
2447
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
BEGIN { |
9
|
26
|
|
|
26
|
|
112
|
$VERSION = '1.66'; |
10
|
26
|
|
|
|
|
551
|
@ISA = qw( Archive::Zip ); |
11
|
|
|
|
|
|
|
|
12
|
26
|
50
|
|
|
|
922
|
if ($^O eq 'MSWin32') { |
13
|
0
|
|
|
|
|
0
|
require Win32; |
14
|
0
|
|
|
|
|
0
|
require Encode; |
15
|
0
|
|
|
|
|
0
|
Encode->import(qw{ decode_utf8 }); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
26
|
|
|
|
|
10078
|
use Archive::Zip qw( |
20
|
|
|
|
|
|
|
:CONSTANTS |
21
|
|
|
|
|
|
|
:MISC_CONSTANTS |
22
|
|
|
|
|
|
|
:ERROR_CODES |
23
|
|
|
|
|
|
|
:PKZIP_CONSTANTS |
24
|
|
|
|
|
|
|
:UTILITY_METHODS |
25
|
26
|
|
|
26
|
|
182
|
); |
|
26
|
|
|
|
|
61
|
|
26
|
|
|
|
|
|
|
|
27
|
26
|
|
|
26
|
|
11825
|
use Time::Local (); |
|
26
|
|
|
|
|
37441
|
|
|
26
|
|
|
|
|
754
|
|
28
|
26
|
|
|
26
|
|
184
|
use Compress::Raw::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS ); |
|
26
|
|
|
|
|
52
|
|
|
26
|
|
|
|
|
2453
|
|
29
|
26
|
|
|
26
|
|
167
|
use File::Path; |
|
26
|
|
|
|
|
46
|
|
|
26
|
|
|
|
|
1376
|
|
30
|
26
|
|
|
26
|
|
162
|
use File::Basename; |
|
26
|
|
|
|
|
55
|
|
|
26
|
|
|
|
|
1363
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Unix perms for default creation of files/dirs. |
33
|
26
|
|
|
26
|
|
145
|
use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755; |
|
26
|
|
|
|
|
52
|
|
|
26
|
|
|
|
|
1606
|
|
34
|
26
|
|
|
26
|
|
186
|
use constant DEFAULT_FILE_PERMISSIONS => 0100666; |
|
26
|
|
|
|
|
51
|
|
|
26
|
|
|
|
|
1255
|
|
35
|
26
|
|
|
26
|
|
152
|
use constant DIRECTORY_ATTRIB => 040000; |
|
26
|
|
|
|
|
61
|
|
|
26
|
|
|
|
|
1196
|
|
36
|
26
|
|
|
26
|
|
153
|
use constant FILE_ATTRIB => 0100000; |
|
26
|
|
|
|
|
59
|
|
|
26
|
|
|
|
|
1901
|
|
37
|
26
|
|
|
|
|
62
|
use constant OS_SUPPORTS_SYMLINK => do { |
38
|
26
|
|
|
|
|
49
|
local $@; |
39
|
26
|
|
|
|
|
52
|
!!eval { symlink("",""); 1 }; |
|
26
|
|
|
|
|
367
|
|
|
26
|
|
|
|
|
67577
|
|
40
|
26
|
|
|
26
|
|
163
|
}; |
|
26
|
|
|
|
|
51
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Returns self if successful, else undef |
43
|
|
|
|
|
|
|
# Assumes that fh is positioned at beginning of central directory file header. |
44
|
|
|
|
|
|
|
# Leaves fh positioned immediately after file header or EOCD signature. |
45
|
|
|
|
|
|
|
sub _newFromZipFile { |
46
|
118
|
|
|
118
|
|
220
|
my $class = shift; |
47
|
118
|
|
|
|
|
640
|
my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_); |
48
|
118
|
|
|
|
|
258
|
return $self; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub newFromString { |
52
|
15
|
|
|
15
|
1
|
1951
|
my $class = shift; |
53
|
|
|
|
|
|
|
|
54
|
15
|
|
|
|
|
38
|
my ($stringOrStringRef, $fileName); |
55
|
15
|
50
|
|
|
|
51
|
if (ref($_[0]) eq 'HASH') { |
56
|
0
|
|
|
|
|
0
|
$stringOrStringRef = $_[0]->{string}; |
57
|
0
|
|
|
|
|
0
|
$fileName = $_[0]->{zipName}; |
58
|
|
|
|
|
|
|
} else { |
59
|
15
|
|
|
|
|
47
|
($stringOrStringRef, $fileName) = @_; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
15
|
|
|
|
|
167
|
my $self = |
63
|
|
|
|
|
|
|
Archive::Zip::StringMember->_newFromString($stringOrStringRef, $fileName); |
64
|
15
|
|
|
|
|
55
|
return $self; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub newFromFile { |
68
|
314
|
|
|
314
|
1
|
456
|
my $class = shift; |
69
|
|
|
|
|
|
|
|
70
|
314
|
|
|
|
|
408
|
my ($fileName, $zipName); |
71
|
314
|
50
|
|
|
|
522
|
if (ref($_[0]) eq 'HASH') { |
72
|
0
|
|
|
|
|
0
|
$fileName = $_[0]->{fileName}; |
73
|
0
|
|
|
|
|
0
|
$zipName = $_[0]->{zipName}; |
74
|
|
|
|
|
|
|
} else { |
75
|
314
|
|
|
|
|
541
|
($fileName, $zipName) = @_; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
314
|
|
|
|
|
1020
|
my $self = |
79
|
|
|
|
|
|
|
Archive::Zip::NewFileMember->_newFromFileNamed($fileName, $zipName); |
80
|
314
|
|
|
|
|
665
|
return $self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub newDirectoryNamed { |
84
|
11
|
|
|
11
|
1
|
36
|
my $class = shift; |
85
|
|
|
|
|
|
|
|
86
|
11
|
|
|
|
|
32
|
my ($directoryName, $newName); |
87
|
11
|
50
|
|
|
|
42
|
if (ref($_[0]) eq 'HASH') { |
88
|
0
|
|
|
|
|
0
|
$directoryName = $_[0]->{directoryName}; |
89
|
0
|
|
|
|
|
0
|
$newName = $_[0]->{zipName}; |
90
|
|
|
|
|
|
|
} else { |
91
|
11
|
|
|
|
|
42
|
($directoryName, $newName) = @_; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
11
|
|
|
|
|
173
|
my $self = |
95
|
|
|
|
|
|
|
Archive::Zip::DirectoryMember->_newNamed($directoryName, $newName); |
96
|
11
|
|
|
|
|
33
|
return $self; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub new { |
100
|
458
|
|
|
458
|
1
|
844
|
my $class = shift; |
101
|
|
|
|
|
|
|
# Info-Zip 3.0 (I guess) seems to use the following values |
102
|
|
|
|
|
|
|
# for the version fields in local and central directory |
103
|
|
|
|
|
|
|
# headers, regardless of whether the member has an zip64 |
104
|
|
|
|
|
|
|
# extended information extra field or not: |
105
|
|
|
|
|
|
|
# |
106
|
|
|
|
|
|
|
# version made by: |
107
|
|
|
|
|
|
|
# 30 |
108
|
|
|
|
|
|
|
# |
109
|
|
|
|
|
|
|
# version needed to extract: |
110
|
|
|
|
|
|
|
# 10 for directory and stored entries |
111
|
|
|
|
|
|
|
# 20 for anything else |
112
|
458
|
100
|
|
|
|
5589
|
my $self = { |
113
|
|
|
|
|
|
|
'lastModFileDateTime' => 0, |
114
|
|
|
|
|
|
|
'fileAttributeFormat' => FA_UNIX, |
115
|
|
|
|
|
|
|
'zip64' => 0, |
116
|
|
|
|
|
|
|
'desiredZip64Mode' => ZIP64_AS_NEEDED, |
117
|
|
|
|
|
|
|
'versionMadeBy' => 20, |
118
|
|
|
|
|
|
|
'versionNeededToExtract' => 20, |
119
|
|
|
|
|
|
|
'bitFlag' => ($Archive::Zip::UNICODE ? 0x0800 : 0), |
120
|
|
|
|
|
|
|
'compressionMethod' => COMPRESSION_STORED, |
121
|
|
|
|
|
|
|
'desiredCompressionMethod' => COMPRESSION_STORED, |
122
|
|
|
|
|
|
|
'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE, |
123
|
|
|
|
|
|
|
'internalFileAttributes' => 0, |
124
|
|
|
|
|
|
|
'externalFileAttributes' => 0, # set later |
125
|
|
|
|
|
|
|
'fileName' => '', |
126
|
|
|
|
|
|
|
'cdExtraField' => '', |
127
|
|
|
|
|
|
|
'localExtraField' => '', |
128
|
|
|
|
|
|
|
'fileComment' => '', |
129
|
|
|
|
|
|
|
'crc32' => 0, |
130
|
|
|
|
|
|
|
'compressedSize' => 0, |
131
|
|
|
|
|
|
|
'uncompressedSize' => 0, |
132
|
|
|
|
|
|
|
'password' => undef, # password for encrypted data |
133
|
|
|
|
|
|
|
'crc32c' => -1, # crc for decrypted data |
134
|
|
|
|
|
|
|
@_ |
135
|
|
|
|
|
|
|
}; |
136
|
458
|
|
|
|
|
892
|
bless($self, $class); |
137
|
458
|
|
|
|
|
2088
|
$self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS); |
138
|
458
|
|
|
|
|
867
|
return $self; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Morph into given class (do whatever cleanup I need to do) |
142
|
|
|
|
|
|
|
sub _become { |
143
|
18
|
|
|
18
|
|
138
|
return bless($_[0], $_[1]); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub fileAttributeFormat { |
147
|
242
|
|
|
242
|
1
|
347
|
my $self = shift; |
148
|
|
|
|
|
|
|
|
149
|
242
|
50
|
|
|
|
428
|
if (@_) { |
150
|
|
|
|
|
|
|
$self->{fileAttributeFormat} = |
151
|
0
|
0
|
|
|
|
0
|
(ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0]; |
152
|
|
|
|
|
|
|
} else { |
153
|
242
|
|
|
|
|
641
|
return $self->{fileAttributeFormat}; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub zip64 { |
158
|
621
|
|
|
621
|
1
|
4878
|
shift->{'zip64'}; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub desiredZip64Mode { |
162
|
348
|
|
|
348
|
1
|
483
|
my $self = shift; |
163
|
348
|
|
|
|
|
518
|
my $desiredZip64Mode = $self->{'desiredZip64Mode'}; |
164
|
348
|
100
|
|
|
|
633
|
if (@_) { |
165
|
|
|
|
|
|
|
$self->{'desiredZip64Mode'} = |
166
|
1
|
50
|
|
|
|
7
|
ref($_[0]) eq 'HASH' ? shift->{desiredZip64Mode} : shift; |
167
|
|
|
|
|
|
|
} |
168
|
348
|
|
|
|
|
1131
|
return $desiredZip64Mode; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub versionMadeBy { |
172
|
0
|
|
|
0
|
1
|
0
|
shift->{'versionMadeBy'}; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub versionNeededToExtract { |
176
|
0
|
|
|
0
|
1
|
0
|
shift->{'versionNeededToExtract'}; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub bitFlag { |
180
|
242
|
|
|
242
|
1
|
331
|
my $self = shift; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# Set General Purpose Bit Flags according to the desiredCompressionLevel setting |
183
|
242
|
50
|
33
|
|
|
484
|
if ( $self->desiredCompressionLevel == 1 |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
184
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 2) { |
185
|
0
|
|
|
|
|
0
|
$self->{'bitFlag'} |= DEFLATING_COMPRESSION_FAST; |
186
|
|
|
|
|
|
|
} elsif ($self->desiredCompressionLevel == 3 |
187
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 4 |
188
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 5 |
189
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 6 |
190
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 7) { |
191
|
0
|
|
|
|
|
0
|
$self->{'bitFlag'} |= DEFLATING_COMPRESSION_NORMAL; |
192
|
|
|
|
|
|
|
} elsif ($self->desiredCompressionLevel == 8 |
193
|
|
|
|
|
|
|
|| $self->desiredCompressionLevel == 9) { |
194
|
0
|
|
|
|
|
0
|
$self->{'bitFlag'} |= DEFLATING_COMPRESSION_MAXIMUM; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
242
|
100
|
|
|
|
514
|
if ($Archive::Zip::UNICODE) { |
198
|
5
|
|
|
|
|
9
|
$self->{'bitFlag'} |= 0x0800; |
199
|
|
|
|
|
|
|
} |
200
|
242
|
|
|
|
|
465
|
$self->{'bitFlag'}; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub password { |
204
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
205
|
8
|
100
|
|
|
|
22
|
$self->{'password'} = shift if @_; |
206
|
8
|
|
|
|
|
38
|
$self->{'password'}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub compressionMethod { |
210
|
1987
|
|
|
1987
|
1
|
5232
|
shift->{'compressionMethod'}; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub desiredCompressionMethod { |
214
|
1776
|
|
|
1776
|
1
|
4588
|
my $self = shift; |
215
|
|
|
|
|
|
|
my $newDesiredCompressionMethod = |
216
|
1776
|
50
|
|
|
|
2934
|
(ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift; |
217
|
1776
|
|
|
|
|
2355
|
my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'}; |
218
|
1776
|
100
|
|
|
|
3016
|
if (defined($newDesiredCompressionMethod)) { |
219
|
614
|
|
|
|
|
763
|
$self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod; |
220
|
614
|
100
|
|
|
|
1265
|
if ($newDesiredCompressionMethod == COMPRESSION_STORED) { |
|
|
100
|
|
|
|
|
|
221
|
229
|
|
|
|
|
401
|
$self->{'desiredCompressionLevel'} = 0; |
222
|
229
|
100
|
|
|
|
522
|
$self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK |
223
|
|
|
|
|
|
|
if $self->uncompressedSize() == 0; |
224
|
|
|
|
|
|
|
} elsif ($oldDesiredCompressionMethod == COMPRESSION_STORED) { |
225
|
380
|
|
|
|
|
570
|
$self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
1776
|
|
|
|
|
3694
|
return $oldDesiredCompressionMethod; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub desiredCompressionLevel { |
232
|
2672
|
|
|
2672
|
1
|
3165
|
my $self = shift; |
233
|
|
|
|
|
|
|
my $newDesiredCompressionLevel = |
234
|
2672
|
50
|
|
|
|
3753
|
(ref($_[0]) eq 'HASH') ? shift->{compressionLevel} : shift; |
235
|
2672
|
|
|
|
|
3055
|
my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'}; |
236
|
2672
|
50
|
|
|
|
3774
|
if (defined($newDesiredCompressionLevel)) { |
237
|
0
|
|
|
|
|
0
|
$self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel; |
238
|
0
|
0
|
|
|
|
0
|
$self->{'desiredCompressionMethod'} = ( |
239
|
|
|
|
|
|
|
$newDesiredCompressionLevel |
240
|
|
|
|
|
|
|
? COMPRESSION_DEFLATED |
241
|
|
|
|
|
|
|
: COMPRESSION_STORED |
242
|
|
|
|
|
|
|
); |
243
|
|
|
|
|
|
|
} |
244
|
2672
|
|
|
|
|
6620
|
return $oldDesiredCompressionLevel; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub fileName { |
248
|
10370
|
|
|
10370
|
1
|
11609
|
my $self = shift; |
249
|
10370
|
|
|
|
|
10446
|
my $newName = shift; |
250
|
10370
|
100
|
|
|
|
13634
|
if (defined $newName) { |
251
|
54
|
|
|
|
|
342
|
$newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems |
252
|
54
|
|
|
|
|
123
|
$self->{'fileName'} = $newName; |
253
|
|
|
|
|
|
|
} |
254
|
10370
|
|
|
|
|
21823
|
return $self->{'fileName'}; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub fileNameAsBytes { |
258
|
1077
|
|
|
1077
|
0
|
1373
|
my $self = shift; |
259
|
1077
|
|
|
|
|
1393
|
my $bytes = $self->{'fileName'}; |
260
|
1077
|
100
|
|
|
|
1825
|
if($self->{'bitFlag'} & 0x800){ |
261
|
35
|
|
|
|
|
99
|
$bytes = Encode::encode_utf8($bytes); |
262
|
|
|
|
|
|
|
} |
263
|
1077
|
|
|
|
|
3371
|
return $bytes; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub lastModFileDateTime { |
267
|
895
|
|
|
895
|
1
|
1452
|
my $modTime = shift->{'lastModFileDateTime'}; |
268
|
895
|
|
|
|
|
3763
|
$modTime =~ m/^(\d+)$/; # untaint |
269
|
895
|
|
|
|
|
3517
|
return $1; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub lastModTime { |
273
|
321
|
|
|
321
|
1
|
551
|
my $self = shift; |
274
|
321
|
|
|
|
|
618
|
return _dosToUnixTime($self->lastModFileDateTime()); |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub setLastModFileDateTimeFromUnix { |
278
|
356
|
|
|
356
|
1
|
428
|
my $self = shift; |
279
|
356
|
|
|
|
|
456
|
my $time_t = shift; |
280
|
356
|
|
|
|
|
679
|
$self->{'lastModFileDateTime'} = _unixToDosTime($time_t); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub internalFileAttributes { |
284
|
610
|
|
|
610
|
1
|
1326
|
shift->{'internalFileAttributes'}; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub externalFileAttributes { |
288
|
243
|
|
|
243
|
1
|
861
|
shift->{'externalFileAttributes'}; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Convert UNIX permissions into proper value for zip file |
292
|
|
|
|
|
|
|
# Usable as a function or a method |
293
|
|
|
|
|
|
|
sub _mapPermissionsFromUnix { |
294
|
798
|
|
|
798
|
|
966
|
my $self = shift; |
295
|
798
|
|
|
|
|
1014
|
my $mode = shift; |
296
|
798
|
|
|
|
|
1098
|
my $attribs = $mode << 16; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Microsoft Windows Explorer needs this bit set for directories |
299
|
798
|
100
|
|
|
|
1347
|
if ($mode & DIRECTORY_ATTRIB) { |
300
|
22
|
|
|
|
|
41
|
$attribs |= 16; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
798
|
|
|
|
|
1147
|
return $attribs; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# TODO: map more MS-DOS perms |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Convert ZIP permissions into Unix ones |
309
|
|
|
|
|
|
|
# |
310
|
|
|
|
|
|
|
# This was taken from Info-ZIP group's portable UnZip |
311
|
|
|
|
|
|
|
# zipfile-extraction program, version 5.50. |
312
|
|
|
|
|
|
|
# http://www.info-zip.org/pub/infozip/ |
313
|
|
|
|
|
|
|
# |
314
|
|
|
|
|
|
|
# See the mapattr() function in unix/unix.c |
315
|
|
|
|
|
|
|
# See the attribute format constants in unzpriv.h |
316
|
|
|
|
|
|
|
# |
317
|
|
|
|
|
|
|
# XXX Note that there's one situation that is not implemented |
318
|
|
|
|
|
|
|
# yet that depends on the "extra field." |
319
|
|
|
|
|
|
|
sub _mapPermissionsToUnix { |
320
|
859
|
|
|
859
|
|
1086
|
my $self = shift; |
321
|
|
|
|
|
|
|
|
322
|
859
|
|
|
|
|
1402
|
my $format = $self->{'fileAttributeFormat'}; |
323
|
859
|
|
|
|
|
1020
|
my $attribs = $self->{'externalFileAttributes'}; |
324
|
|
|
|
|
|
|
|
325
|
859
|
|
|
|
|
1007
|
my $mode = 0; |
326
|
|
|
|
|
|
|
|
327
|
859
|
50
|
|
|
|
1562
|
if ($format == FA_AMIGA) { |
328
|
0
|
|
|
|
|
0
|
$attribs = $attribs >> 17 & 7; # Amiga RWE bits |
329
|
0
|
|
|
|
|
0
|
$mode = $attribs << 6 | $attribs << 3 | $attribs; |
330
|
0
|
|
|
|
|
0
|
return $mode; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
859
|
50
|
|
|
|
1461
|
if ($format == FA_THEOS) { |
334
|
0
|
|
|
|
|
0
|
$attribs &= 0xF1FFFFFF; |
335
|
0
|
0
|
|
|
|
0
|
if (($attribs & 0xF0000000) != 0x40000000) { |
336
|
0
|
|
|
|
|
0
|
$attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits |
337
|
|
|
|
|
|
|
} else { |
338
|
0
|
|
|
|
|
0
|
$attribs &= 0x41FFFFFF; # leave directory bit as set |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
859
|
50
|
66
|
|
|
1779
|
if ( $format == FA_UNIX |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
343
|
|
|
|
|
|
|
|| $format == FA_VAX_VMS |
344
|
|
|
|
|
|
|
|| $format == FA_ACORN |
345
|
|
|
|
|
|
|
|| $format == FA_ATARI_ST |
346
|
|
|
|
|
|
|
|| $format == FA_BEOS |
347
|
|
|
|
|
|
|
|| $format == FA_QDOS |
348
|
|
|
|
|
|
|
|| $format == FA_TANDEM) { |
349
|
855
|
|
|
|
|
1079
|
$mode = $attribs >> 16; |
350
|
855
|
50
|
66
|
|
|
2272
|
return $mode if $mode != 0 or not $self->localExtraField; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# warn("local extra field is: ", $self->localExtraField, "\n"); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# XXX This condition is not implemented |
355
|
|
|
|
|
|
|
# I'm just including the comments from the info-zip section for now. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# Some (non-Info-ZIP) implementations of Zip for Unix and |
358
|
|
|
|
|
|
|
# VMS (and probably others ??) leave 0 in the upper 16-bit |
359
|
|
|
|
|
|
|
# part of the external_file_attributes field. Instead, they |
360
|
|
|
|
|
|
|
# store file permission attributes in some extra field. |
361
|
|
|
|
|
|
|
# As a work-around, we search for the presence of one of |
362
|
|
|
|
|
|
|
# these extra fields and fall back to the MSDOS compatible |
363
|
|
|
|
|
|
|
# part of external_file_attributes if one of the known |
364
|
|
|
|
|
|
|
# e.f. types has been detected. |
365
|
|
|
|
|
|
|
# Later, we might implement extraction of the permission |
366
|
|
|
|
|
|
|
# bits from the VMS extra field. But for now, the work-around |
367
|
|
|
|
|
|
|
# should be sufficient to provide "readable" extracted files. |
368
|
|
|
|
|
|
|
# (For ASI Unix e.f., an experimental remap from the e.f. |
369
|
|
|
|
|
|
|
# mode value IS already provided!) |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the |
373
|
|
|
|
|
|
|
# Unix attributes in the upper 16 bits of the external attributes |
374
|
|
|
|
|
|
|
# field, just like Info-ZIP's Zip for Unix. We try to use that |
375
|
|
|
|
|
|
|
# value, after a check for consistency with the MSDOS attribute |
376
|
|
|
|
|
|
|
# bits (see below). |
377
|
4
|
50
|
|
|
|
11
|
if ($format == FA_MSDOS) { |
378
|
4
|
|
|
|
|
7
|
$mode = $attribs >> 16; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20 |
382
|
4
|
|
|
|
|
10
|
$attribs = !($attribs & 1) << 1 | ($attribs & 0x10) >> 4; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# keep previous $mode setting when its "owner" |
385
|
|
|
|
|
|
|
# part appears to be consistent with DOS attribute flags! |
386
|
4
|
50
|
|
|
|
9
|
return $mode if ($mode & 0700) == (0400 | $attribs << 6); |
387
|
4
|
|
|
|
|
8
|
$mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs; |
388
|
4
|
|
|
|
|
7
|
return $mode; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub unixFileAttributes { |
392
|
859
|
|
|
859
|
1
|
1096
|
my $self = shift; |
393
|
859
|
|
|
|
|
1551
|
my $oldPerms = $self->_mapPermissionsToUnix; |
394
|
|
|
|
|
|
|
|
395
|
859
|
|
|
|
|
1101
|
my $perms; |
396
|
859
|
100
|
|
|
|
1321
|
if (@_) { |
397
|
798
|
50
|
|
|
|
1401
|
$perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0]; |
398
|
|
|
|
|
|
|
|
399
|
798
|
100
|
|
|
|
1617
|
if ($self->isDirectory) { |
400
|
22
|
|
|
|
|
41
|
$perms &= ~FILE_ATTRIB; |
401
|
22
|
|
|
|
|
38
|
$perms |= DIRECTORY_ATTRIB; |
402
|
|
|
|
|
|
|
} else { |
403
|
776
|
|
|
|
|
975
|
$perms &= ~DIRECTORY_ATTRIB; |
404
|
776
|
|
|
|
|
985
|
$perms |= FILE_ATTRIB; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
$self->{externalFileAttributes} = |
407
|
798
|
|
|
|
|
1515
|
$self->_mapPermissionsFromUnix($perms); |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
859
|
|
|
|
|
2060
|
return $oldPerms; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub localExtraField { |
414
|
802
|
|
|
802
|
1
|
1820
|
my $self = shift; |
415
|
|
|
|
|
|
|
|
416
|
802
|
100
|
|
|
|
1521
|
if (@_) { |
417
|
|
|
|
|
|
|
my $localExtraField = |
418
|
6
|
50
|
|
|
|
24
|
(ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; |
419
|
6
|
|
|
|
|
42
|
my ($status, $zip64) = |
420
|
|
|
|
|
|
|
$self->_extractZip64ExtraField($localExtraField, undef, undef); |
421
|
6
|
100
|
|
|
|
17
|
if ($status != AZ_OK) { |
|
|
100
|
|
|
|
|
|
422
|
2
|
|
|
|
|
25
|
return $status; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
elsif ($zip64) { |
425
|
1
|
|
|
|
|
4
|
return _formatError('invalid extra field (contains zip64 information)'); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
else { |
428
|
3
|
|
|
|
|
6
|
$self->{localExtraField} = $localExtraField; |
429
|
3
|
|
|
|
|
13
|
return AZ_OK; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} else { |
432
|
796
|
|
|
|
|
2520
|
return $self->{localExtraField}; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub cdExtraField { |
437
|
260
|
|
|
260
|
1
|
619
|
my $self = shift; |
438
|
|
|
|
|
|
|
|
439
|
260
|
100
|
|
|
|
466
|
if (@_) { |
440
|
|
|
|
|
|
|
my $cdExtraField = |
441
|
6
|
50
|
|
|
|
23
|
(ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; |
442
|
6
|
|
|
|
|
46
|
my ($status, $zip64) = |
443
|
|
|
|
|
|
|
$self->_extractZip64ExtraField($cdExtraField, undef, undef); |
444
|
6
|
100
|
|
|
|
27
|
if ($status != AZ_OK) { |
|
|
100
|
|
|
|
|
|
445
|
2
|
|
|
|
|
28
|
return $status; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
elsif ($zip64) { |
448
|
1
|
|
|
|
|
10
|
return _formatError('invalid extra field (contains zip64 information)'); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
else { |
451
|
3
|
|
|
|
|
12
|
$self->{cdExtraField} = $cdExtraField; |
452
|
3
|
|
|
|
|
25
|
return AZ_OK; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
} else { |
455
|
254
|
|
|
|
|
599
|
return $self->{cdExtraField}; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub extraFields { |
460
|
6
|
|
|
6
|
1
|
17
|
my $self = shift; |
461
|
6
|
|
|
|
|
20
|
return $self->localExtraField() . $self->cdExtraField(); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub fileComment { |
465
|
242
|
|
|
242
|
1
|
341
|
my $self = shift; |
466
|
|
|
|
|
|
|
|
467
|
242
|
50
|
|
|
|
430
|
if (@_) { |
468
|
|
|
|
|
|
|
$self->{fileComment} = |
469
|
|
|
|
|
|
|
(ref($_[0]) eq 'HASH') |
470
|
|
|
|
|
|
|
? pack('C0a*', $_[0]->{comment}) |
471
|
0
|
0
|
|
|
|
0
|
: pack('C0a*', $_[0]); |
472
|
|
|
|
|
|
|
} else { |
473
|
242
|
|
|
|
|
424
|
return $self->{fileComment}; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub hasDataDescriptor { |
478
|
607
|
|
|
607
|
1
|
795
|
my $self = shift; |
479
|
607
|
100
|
|
|
|
1078
|
if (@_) { |
480
|
24
|
|
|
|
|
44
|
my $shouldHave = shift; |
481
|
24
|
50
|
|
|
|
48
|
if ($shouldHave) { |
482
|
24
|
|
|
|
|
66
|
$self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK; |
483
|
|
|
|
|
|
|
} else { |
484
|
0
|
|
|
|
|
0
|
$self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
} |
487
|
607
|
|
|
|
|
1391
|
return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub crc32 { |
491
|
580
|
|
|
580
|
1
|
9002
|
shift->{'crc32'}; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub crc32String { |
495
|
3
|
|
|
3
|
1
|
26
|
sprintf("%08x", shift->{'crc32'}); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
sub compressedSize { |
499
|
428
|
|
|
428
|
1
|
1350
|
shift->{'compressedSize'}; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub uncompressedSize { |
503
|
2326
|
|
|
2326
|
1
|
7524
|
shift->{'uncompressedSize'}; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
sub isEncrypted { |
507
|
279
|
|
|
279
|
1
|
933
|
shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub isTextFile { |
511
|
341
|
|
|
341
|
1
|
569
|
my $self = shift; |
512
|
341
|
|
|
|
|
596
|
my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; |
513
|
341
|
100
|
|
|
|
871
|
if (@_) { |
514
|
314
|
50
|
|
|
|
695
|
my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift; |
515
|
314
|
|
|
|
|
406
|
$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; |
516
|
314
|
100
|
|
|
|
554
|
$self->{'internalFileAttributes'} |= |
517
|
|
|
|
|
|
|
($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE); |
518
|
|
|
|
|
|
|
} |
519
|
341
|
|
|
|
|
584
|
return $bit == IFA_TEXT_FILE; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
sub isBinaryFile { |
523
|
27
|
|
|
27
|
1
|
2730
|
my $self = shift; |
524
|
27
|
|
|
|
|
45
|
my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; |
525
|
27
|
50
|
|
|
|
46
|
if (@_) { |
526
|
0
|
|
|
|
|
0
|
my $flag = shift; |
527
|
0
|
|
|
|
|
0
|
$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; |
528
|
0
|
0
|
|
|
|
0
|
$self->{'internalFileAttributes'} |= |
529
|
|
|
|
|
|
|
($flag ? IFA_BINARY_FILE : IFA_TEXT_FILE); |
530
|
|
|
|
|
|
|
} |
531
|
27
|
|
|
|
|
55
|
return $bit == IFA_BINARY_FILE; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub extractToFileNamed { |
535
|
54
|
|
|
54
|
1
|
508
|
my $self = shift; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# local FS name |
538
|
54
|
50
|
|
|
|
158
|
my $name = (ref($_[0]) eq 'HASH') ? $_[0]->{name} : $_[0]; |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# Create directory for regular files as well as for symbolic |
541
|
|
|
|
|
|
|
# links |
542
|
54
|
50
|
33
|
|
|
237
|
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { |
543
|
0
|
|
|
|
|
0
|
$name = decode_utf8(Win32::GetFullPathName($name)); |
544
|
0
|
|
|
|
|
0
|
mkpath_win32($name); |
545
|
|
|
|
|
|
|
} else { |
546
|
54
|
|
|
|
|
3862
|
mkpath(dirname($name)); # croaks on error |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# Check if the file / directory is a symbolic link *and* if |
550
|
|
|
|
|
|
|
# the operating system supports these. Only in that case |
551
|
|
|
|
|
|
|
# call method extractToFileHandle with the name of the |
552
|
|
|
|
|
|
|
# symbolic link. If the operating system does not support |
553
|
|
|
|
|
|
|
# symbolic links, process the member using the usual |
554
|
|
|
|
|
|
|
# extraction routines, which creates a file containing the |
555
|
|
|
|
|
|
|
# link target. |
556
|
54
|
100
|
100
|
|
|
276
|
if ($self->isSymbolicLink() && OS_SUPPORTS_SYMLINK) { |
557
|
5
|
|
|
|
|
81
|
return $self->extractToFileHandle($name); |
558
|
|
|
|
|
|
|
} else { |
559
|
49
|
|
|
|
|
91
|
my ($status, $fh); |
560
|
49
|
50
|
33
|
|
|
186
|
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { |
561
|
0
|
|
|
|
|
0
|
Win32::CreateFile($name); |
562
|
0
|
|
|
|
|
0
|
($status, $fh) = _newFileHandle(Win32::GetANSIPathName($name), 'w'); |
563
|
|
|
|
|
|
|
} else { |
564
|
49
|
|
|
|
|
179
|
($status, $fh) = _newFileHandle($name, 'w'); |
565
|
|
|
|
|
|
|
} |
566
|
49
|
50
|
|
|
|
165
|
return _ioError("Can't open file $name for write") unless $status; |
567
|
49
|
|
|
|
|
276
|
$status = $self->extractToFileHandle($fh); |
568
|
49
|
|
|
|
|
154
|
$fh->close(); |
569
|
49
|
50
|
|
|
|
2245
|
chmod($self->unixFileAttributes(), $name) |
570
|
|
|
|
|
|
|
or return _error("Can't chmod() ${name}: $!"); |
571
|
49
|
|
|
|
|
249
|
utime($self->lastModTime(), $self->lastModTime(), $name); |
572
|
49
|
|
|
|
|
367
|
return $status; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub mkpath_win32 { |
577
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
578
|
26
|
|
|
26
|
|
227
|
use File::Spec; |
|
26
|
|
|
|
|
67
|
|
|
26
|
|
|
|
|
101764
|
|
579
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
0
|
my ($volume, @path) = File::Spec->splitdir($path); |
581
|
0
|
|
|
|
|
0
|
$path = File::Spec->catfile($volume, shift @path); |
582
|
0
|
|
|
|
|
0
|
pop @path; |
583
|
0
|
|
|
|
|
0
|
while (@path) { |
584
|
0
|
|
|
|
|
0
|
$path = File::Spec->catfile($path, shift @path); |
585
|
0
|
|
|
|
|
0
|
Win32::CreateDirectory($path); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub isSymbolicLink { |
590
|
352
|
|
|
352
|
0
|
1204
|
return shift->{'externalFileAttributes'} == 0xA1FF0000; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub isDirectory { |
594
|
685
|
|
|
685
|
1
|
1081
|
return 0; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub externalFileName { |
598
|
0
|
|
|
0
|
1
|
0
|
return undef; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# Search the given extra field string for a zip64 extended |
602
|
|
|
|
|
|
|
# information extra field and "correct" the header fields given |
603
|
|
|
|
|
|
|
# in the remaining parameters with the information from that |
604
|
|
|
|
|
|
|
# extra field, if required. Writes back the extra field string |
605
|
|
|
|
|
|
|
# sans the zip64 information. The extra field string and all |
606
|
|
|
|
|
|
|
# header fields must be passed as lvalues or the undefined value. |
607
|
|
|
|
|
|
|
# |
608
|
|
|
|
|
|
|
# This method returns a pair ($status, $zip64) in list context, |
609
|
|
|
|
|
|
|
# where the latter flag specifies whether a zip64 extended |
610
|
|
|
|
|
|
|
# information extra field was found. |
611
|
|
|
|
|
|
|
# |
612
|
|
|
|
|
|
|
# This method must be called with two header fields for local |
613
|
|
|
|
|
|
|
# file headers and with four header fields for Central Directory |
614
|
|
|
|
|
|
|
# headers. |
615
|
|
|
|
|
|
|
sub _extractZip64ExtraField |
616
|
|
|
|
|
|
|
{ |
617
|
51
|
|
|
51
|
|
716
|
my $classOrSelf = shift; |
618
|
|
|
|
|
|
|
|
619
|
51
|
|
|
|
|
106
|
my $extraField = $_[0]; |
620
|
|
|
|
|
|
|
|
621
|
51
|
|
|
|
|
122
|
my ($zip64Data, $newExtraField) = (undef, ''); |
622
|
51
|
|
|
|
|
154
|
while (length($extraField) >= 4) { |
623
|
42
|
|
|
|
|
129
|
my ($headerId, $dataSize) = unpack('v v', $extraField); |
624
|
42
|
100
|
|
|
|
169
|
if (length($extraField) < 4 + $dataSize) { |
|
|
100
|
|
|
|
|
|
625
|
2
|
|
|
|
|
11
|
return _formatError('invalid extra field (bad data)'); |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
elsif ($headerId != 0x0001) { |
628
|
4
|
|
|
|
|
16
|
$newExtraField .= substr($extraField, 0, 4 + $dataSize); |
629
|
4
|
|
|
|
|
21
|
$extraField = substr($extraField, 4 + $dataSize); |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
else { |
632
|
36
|
|
|
|
|
88
|
$zip64Data = substr($extraField, 4, $dataSize); |
633
|
36
|
|
|
|
|
121
|
$extraField = substr($extraField, 4 + $dataSize); |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
} |
636
|
49
|
100
|
|
|
|
103
|
if (length($extraField) != 0) { |
637
|
2
|
|
|
|
|
10
|
return _formatError('invalid extra field (bad header ID or data size)'); |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
47
|
|
|
|
|
68
|
my $zip64 = 0; |
641
|
47
|
100
|
|
|
|
93
|
if (defined($zip64Data)) { |
642
|
36
|
|
|
|
|
48
|
my $dataLength = length($zip64Data); |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# Try to be tolerant with respect to the fields to be |
645
|
|
|
|
|
|
|
# extracted from the zip64 extended information extra |
646
|
|
|
|
|
|
|
# field and derive that information from the data itself, |
647
|
|
|
|
|
|
|
# if possible. This works around, for example, incorrect |
648
|
|
|
|
|
|
|
# extra fields written by certain versions of package |
649
|
|
|
|
|
|
|
# IO::Compress::Zip. That package provides the disk |
650
|
|
|
|
|
|
|
# number start in the extra field without setting the |
651
|
|
|
|
|
|
|
# corresponding regular field to 0xffff. Plus it |
652
|
|
|
|
|
|
|
# provides the full set of fields even for the local file |
653
|
|
|
|
|
|
|
# header. |
654
|
|
|
|
|
|
|
# |
655
|
|
|
|
|
|
|
# Field zero is the extra field string which we must keep |
656
|
|
|
|
|
|
|
# in @_ for future modification, so account for that. |
657
|
36
|
|
|
|
|
48
|
my @fields; |
658
|
36
|
100
|
100
|
|
|
308
|
if (@_ == 3 && $dataLength == 16) { |
|
|
50
|
66
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
659
|
25
|
|
|
|
|
46
|
@fields = (undef, 0xffffffff, 0xffffffff); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
elsif (@_ == 3 && $dataLength == 24) { |
662
|
0
|
|
|
|
|
0
|
push(@_, undef); |
663
|
0
|
|
|
|
|
0
|
@fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff); |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
elsif (@_ == 3 && $dataLength == 28) { |
666
|
0
|
|
|
|
|
0
|
push(@_, undef, undef); |
667
|
0
|
|
|
|
|
0
|
@fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff, 0xffff); |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
elsif (@_ == 5 && $dataLength == 24) { |
670
|
0
|
|
|
|
|
0
|
@fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff); |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
elsif (@_ == 5 && $dataLength == 28) { |
673
|
1
|
|
|
|
|
17
|
@fields = (undef, 0xffffffff, 0xffffffff, 0xffffffff, 0xffff); |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
else { |
676
|
10
|
|
100
|
|
|
27
|
@fields = map { $_ // 0 } @_; |
|
44
|
|
|
|
|
99
|
|
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
36
|
|
|
|
|
67
|
my @fieldIndexes = (0); |
680
|
36
|
|
|
|
|
61
|
my $fieldFormat = ''; |
681
|
36
|
|
|
|
|
53
|
my $expDataLength = 0; |
682
|
36
|
100
|
|
|
|
70
|
if ($fields[1] == 0xffffffff) { |
683
|
28
|
|
|
|
|
52
|
push(@fieldIndexes, 1); |
684
|
28
|
|
|
|
|
44
|
$fieldFormat .= 'Q< '; |
685
|
28
|
|
|
|
|
38
|
$expDataLength += 8; |
686
|
|
|
|
|
|
|
} |
687
|
36
|
100
|
|
|
|
73
|
if ($fields[2] == 0xffffffff) { |
688
|
27
|
|
|
|
|
43
|
push(@fieldIndexes, 2); |
689
|
27
|
|
|
|
|
40
|
$fieldFormat .= 'Q< '; |
690
|
27
|
|
|
|
|
38
|
$expDataLength += 8; |
691
|
|
|
|
|
|
|
} |
692
|
36
|
100
|
100
|
|
|
116
|
if (@fields > 3 && $fields[3] == 0xffffffff) { |
693
|
7
|
|
|
|
|
17
|
push(@fieldIndexes, 3); |
694
|
7
|
|
|
|
|
22
|
$fieldFormat .= 'Q< '; |
695
|
7
|
|
|
|
|
22
|
$expDataLength += 8; |
696
|
|
|
|
|
|
|
} |
697
|
36
|
100
|
100
|
|
|
117
|
if (@fields > 3 && $fields[4] == 0xffff) { |
698
|
1
|
|
|
|
|
4
|
push(@fieldIndexes, 4); |
699
|
1
|
|
|
|
|
7
|
$fieldFormat .= 'L< '; |
700
|
1
|
|
|
|
|
7
|
$expDataLength += 4; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
36
|
100
|
|
|
|
74
|
if ($dataLength == $expDataLength) { |
704
|
35
|
|
|
|
|
98
|
@_[@fieldIndexes] = ($newExtraField, unpack($fieldFormat, $zip64Data)); |
705
|
35
|
|
|
|
|
76
|
$zip64 = 1; |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
else { |
708
|
1
|
|
|
|
|
7
|
return _formatError('invalid zip64 extended information extra field'); |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
46
|
|
|
|
|
132
|
return (AZ_OK, $zip64); |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# The following are used when copying data |
716
|
|
|
|
|
|
|
sub _writeOffset { |
717
|
1224
|
|
|
1224
|
|
2107
|
shift->{'writeOffset'}; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub _readOffset { |
721
|
88
|
|
|
88
|
|
282
|
shift->{'readOffset'}; |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
sub writeLocalHeaderRelativeOffset { |
725
|
498
|
|
|
498
|
1
|
955
|
shift->{'writeLocalHeaderRelativeOffset'}; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# Maintained in method Archive::Zip::Archive::writeToFileHandle |
729
|
|
|
|
|
|
|
sub wasWritten { |
730
|
0
|
|
|
0
|
1
|
0
|
shift->{'wasWritten'} |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
sub _dataEnded { |
734
|
532
|
|
|
532
|
|
1552
|
shift->{'dataEnded'}; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
sub _readDataRemaining { |
738
|
1422
|
|
|
1422
|
|
3830
|
shift->{'readDataRemaining'}; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub _inflater { |
742
|
15
|
|
|
15
|
|
847
|
shift->{'inflater'}; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
sub _deflater { |
746
|
124
|
|
|
124
|
|
6089
|
shift->{'deflater'}; |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# DOS date/time format |
750
|
|
|
|
|
|
|
# 0-4 (5) Second divided by 2 |
751
|
|
|
|
|
|
|
# 5-10 (6) Minute (0-59) |
752
|
|
|
|
|
|
|
# 11-15 (5) Hour (0-23 on a 24-hour clock) |
753
|
|
|
|
|
|
|
# 16-20 (5) Day of the month (1-31) |
754
|
|
|
|
|
|
|
# 21-24 (4) Month (1 = January, 2 = February, etc.) |
755
|
|
|
|
|
|
|
# 25-31 (7) Year offset from 1980 (add 1980 to get actual year) |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
# Convert DOS date/time format to unix time_t format |
758
|
|
|
|
|
|
|
# NOT AN OBJECT METHOD! |
759
|
|
|
|
|
|
|
sub _dosToUnixTime { |
760
|
337
|
|
|
337
|
|
615
|
my $dt = shift; |
761
|
337
|
50
|
|
|
|
637
|
return time() unless defined($dt); |
762
|
|
|
|
|
|
|
|
763
|
337
|
|
|
|
|
792
|
my $year = (($dt >> 25) & 0x7f) + 1980; |
764
|
337
|
|
|
|
|
522
|
my $mon = (($dt >> 21) & 0x0f) - 1; |
765
|
337
|
|
|
|
|
511
|
my $mday = (($dt >> 16) & 0x1f); |
766
|
|
|
|
|
|
|
|
767
|
337
|
|
|
|
|
440
|
my $hour = (($dt >> 11) & 0x1f); |
768
|
337
|
|
|
|
|
455
|
my $min = (($dt >> 5) & 0x3f); |
769
|
337
|
|
|
|
|
550
|
my $sec = (($dt << 1) & 0x3e); |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# catch errors |
772
|
|
|
|
|
|
|
my $time_t = |
773
|
337
|
|
|
|
|
439
|
eval { Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year); }; |
|
337
|
|
|
|
|
884
|
|
774
|
337
|
50
|
|
|
|
18602
|
return time() if ($@); |
775
|
337
|
|
|
|
|
2159
|
return $time_t; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# Note, this is not exactly UTC 1980, it's 1980 + 12 hours and 1 |
779
|
|
|
|
|
|
|
# minute so that nothing timezoney can muck us up. |
780
|
|
|
|
|
|
|
my $safe_epoch = 31.666060; |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# convert a unix time to DOS date/time |
783
|
|
|
|
|
|
|
# NOT AN OBJECT METHOD! |
784
|
|
|
|
|
|
|
sub _unixToDosTime { |
785
|
373
|
|
|
373
|
|
19131
|
my $time_t = shift; |
786
|
373
|
100
|
|
|
|
641
|
unless ($time_t) { |
787
|
1
|
|
|
|
|
6
|
_error("Tried to add member with zero or undef value for time"); |
788
|
1
|
|
|
|
|
2
|
$time_t = $safe_epoch; |
789
|
|
|
|
|
|
|
} |
790
|
373
|
50
|
|
|
|
755
|
if ($time_t < $safe_epoch) { |
791
|
0
|
|
|
|
|
0
|
_ioError("Unsupported date before 1980 encountered, moving to 1980"); |
792
|
0
|
|
|
|
|
0
|
$time_t = $safe_epoch; |
793
|
|
|
|
|
|
|
} |
794
|
373
|
|
|
|
|
6911
|
my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time_t); |
795
|
373
|
|
|
|
|
1025
|
my $dt = 0; |
796
|
373
|
|
|
|
|
522
|
$dt += ($sec >> 1); |
797
|
373
|
|
|
|
|
519
|
$dt += ($min << 5); |
798
|
373
|
|
|
|
|
451
|
$dt += ($hour << 11); |
799
|
373
|
|
|
|
|
435
|
$dt += ($mday << 16); |
800
|
373
|
|
|
|
|
456
|
$dt += (($mon + 1) << 21); |
801
|
373
|
|
|
|
|
608
|
$dt += (($year - 80) << 25); |
802
|
373
|
|
|
|
|
1183
|
return $dt; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
# Write my local header to a file handle. |
806
|
|
|
|
|
|
|
# Returns a pair (AZ_OK, $headerSize) on success. |
807
|
|
|
|
|
|
|
sub _writeLocalFileHeader { |
808
|
326
|
|
|
326
|
|
482
|
my $self = shift; |
809
|
326
|
|
|
|
|
416
|
my $fh = shift; |
810
|
326
|
|
100
|
|
|
902
|
my $refresh = shift // 0; |
811
|
|
|
|
|
|
|
|
812
|
326
|
|
|
|
|
673
|
my $zip64 = $self->zip64(); |
813
|
326
|
|
|
|
|
733
|
my $hasDataDescriptor = $self->hasDataDescriptor(); |
814
|
|
|
|
|
|
|
|
815
|
326
|
|
|
|
|
858
|
my $versionNeededToExtract; |
816
|
|
|
|
|
|
|
my $crc32; |
817
|
326
|
|
|
|
|
0
|
my $compressedSize; |
818
|
326
|
|
|
|
|
0
|
my $uncompressedSize; |
819
|
326
|
|
|
|
|
719
|
my $localExtraField = $self->localExtraField(); |
820
|
|
|
|
|
|
|
|
821
|
326
|
100
|
|
|
|
661
|
if (! $zip64) { |
822
|
231
|
|
|
|
|
307
|
$versionNeededToExtract = 20; |
823
|
|
|
|
|
|
|
|
824
|
231
|
100
|
|
|
|
655
|
if ($refresh) { |
|
|
100
|
|
|
|
|
|
825
|
59
|
|
|
|
|
116
|
$crc32 = $self->crc32(); |
826
|
59
|
|
|
|
|
129
|
$compressedSize = $self->_writeOffset(); |
827
|
59
|
|
|
|
|
125
|
$uncompressedSize = $self->uncompressedSize(); |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
# Handle a brain-dead corner case gracefully. |
830
|
|
|
|
|
|
|
# Otherwise we a) would always need to write zip64 |
831
|
|
|
|
|
|
|
# format or b) re-write the complete member data on |
832
|
|
|
|
|
|
|
# refresh (which might not always be possible). |
833
|
59
|
50
|
|
|
|
128
|
if ($compressedSize > 0xffffffff) { |
834
|
0
|
|
|
|
|
0
|
return _formatError('compressed size too large for refresh'); |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
elsif ($hasDataDescriptor) { |
838
|
67
|
|
|
|
|
89
|
$crc32 = 0; |
839
|
67
|
|
|
|
|
83
|
$compressedSize = 0; |
840
|
67
|
|
|
|
|
83
|
$uncompressedSize = 0; |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
else { |
843
|
105
|
|
|
|
|
280
|
$crc32 = $self->crc32(); |
844
|
105
|
|
|
|
|
307
|
$compressedSize = $self->_writeOffset(); |
845
|
105
|
|
|
|
|
246
|
$uncompressedSize = $self->uncompressedSize(); |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
else { |
849
|
95
|
|
|
|
|
141
|
$versionNeededToExtract = 45; |
850
|
|
|
|
|
|
|
|
851
|
95
|
|
|
|
|
151
|
my $zip64CompressedSize; |
852
|
|
|
|
|
|
|
my $zip64UncompressedSize; |
853
|
95
|
100
|
|
|
|
223
|
if ($refresh) { |
|
|
100
|
|
|
|
|
|
854
|
25
|
|
|
|
|
48
|
$crc32 = $self->crc32(); |
855
|
25
|
|
|
|
|
36
|
$compressedSize = 0xffffffff; |
856
|
25
|
|
|
|
|
34
|
$uncompressedSize = 0xffffffff; |
857
|
25
|
|
|
|
|
47
|
$zip64CompressedSize = $self->_writeOffset(); |
858
|
25
|
|
|
|
|
54
|
$zip64UncompressedSize = $self->uncompressedSize(); |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
elsif ($hasDataDescriptor) { |
861
|
31
|
|
|
|
|
61
|
$crc32 = 0; |
862
|
31
|
|
|
|
|
58
|
$compressedSize = 0xffffffff; |
863
|
31
|
|
|
|
|
40
|
$uncompressedSize = 0xffffffff; |
864
|
31
|
|
|
|
|
43
|
$zip64CompressedSize = 0; |
865
|
31
|
|
|
|
|
44
|
$zip64UncompressedSize = 0; |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
else { |
868
|
39
|
|
|
|
|
111
|
$crc32 = $self->crc32(); |
869
|
39
|
|
|
|
|
69
|
$compressedSize = 0xffffffff; |
870
|
39
|
|
|
|
|
62
|
$uncompressedSize = 0xffffffff; |
871
|
39
|
|
|
|
|
95
|
$zip64CompressedSize = $self->_writeOffset(); |
872
|
39
|
|
|
|
|
74
|
$zip64UncompressedSize = $self->uncompressedSize(); |
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
|
875
|
95
|
|
|
|
|
343
|
$localExtraField .= pack('S< S< Q< Q<', |
876
|
|
|
|
|
|
|
0x0001, 16, |
877
|
|
|
|
|
|
|
$zip64UncompressedSize, |
878
|
|
|
|
|
|
|
$zip64CompressedSize); |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
|
881
|
326
|
|
|
|
|
751
|
my $fileNameLength = length($self->fileNameAsBytes()); |
882
|
326
|
|
|
|
|
435
|
my $localFieldLength = length($localExtraField); |
883
|
|
|
|
|
|
|
|
884
|
326
|
|
|
|
|
476
|
my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE); |
885
|
326
|
50
|
|
|
|
901
|
$self->_print($fh, $signatureData) |
886
|
|
|
|
|
|
|
or return _ioError("writing local header signature"); |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
my $header = |
889
|
|
|
|
|
|
|
pack(LOCAL_FILE_HEADER_FORMAT, |
890
|
|
|
|
|
|
|
$versionNeededToExtract, |
891
|
326
|
|
|
|
|
3572
|
$self->{'bitFlag'}, |
892
|
|
|
|
|
|
|
$self->desiredCompressionMethod(), |
893
|
|
|
|
|
|
|
$self->lastModFileDateTime(), |
894
|
|
|
|
|
|
|
$crc32, |
895
|
|
|
|
|
|
|
$compressedSize, |
896
|
|
|
|
|
|
|
$uncompressedSize, |
897
|
|
|
|
|
|
|
$fileNameLength, |
898
|
|
|
|
|
|
|
$localFieldLength); |
899
|
326
|
50
|
|
|
|
1197
|
$self->_print($fh, $header) |
900
|
|
|
|
|
|
|
or return _ioError("writing local header"); |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
# Write these only if required |
903
|
326
|
100
|
100
|
|
|
3069
|
if (! $refresh || $zip64) { |
904
|
267
|
50
|
|
|
|
478
|
if ($fileNameLength) { |
905
|
267
|
50
|
|
|
|
522
|
$self->_print($fh, $self->fileNameAsBytes()) |
906
|
|
|
|
|
|
|
or return _ioError("writing local header filename"); |
907
|
|
|
|
|
|
|
} |
908
|
267
|
100
|
|
|
|
2073
|
if ($localFieldLength) { |
909
|
96
|
50
|
|
|
|
285
|
$self->_print($fh, $localExtraField) |
910
|
|
|
|
|
|
|
or return _ioError("writing local extra field"); |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
return |
915
|
326
|
|
|
|
|
1318
|
(AZ_OK, |
916
|
|
|
|
|
|
|
LOCAL_FILE_HEADER_LENGTH + |
917
|
|
|
|
|
|
|
SIGNATURE_LENGTH + |
918
|
|
|
|
|
|
|
$fileNameLength + |
919
|
|
|
|
|
|
|
$localFieldLength); |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
# Re-writes the local file header with new crc32 and compressedSize fields. |
923
|
|
|
|
|
|
|
# To be called after writing the data stream. |
924
|
|
|
|
|
|
|
# Assumes that filename and extraField sizes didn't change since last written. |
925
|
|
|
|
|
|
|
sub _refreshLocalFileHeader { |
926
|
84
|
|
|
84
|
|
124
|
my $self = shift; |
927
|
84
|
|
|
|
|
105
|
my $fh = shift; |
928
|
|
|
|
|
|
|
|
929
|
84
|
|
|
|
|
236
|
my $here = $fh->tell(); |
930
|
84
|
50
|
|
|
|
482
|
$fh->seek($self->writeLocalHeaderRelativeOffset(), IO::Seekable::SEEK_SET) |
931
|
|
|
|
|
|
|
or return _ioError("seeking to rewrite local header"); |
932
|
|
|
|
|
|
|
|
933
|
84
|
|
|
|
|
2618
|
my ($status, undef) = $self->_writeLocalFileHeader($fh, 1); |
934
|
84
|
50
|
|
|
|
201
|
return $status if $status != AZ_OK; |
935
|
|
|
|
|
|
|
|
936
|
84
|
50
|
|
|
|
234
|
$fh->seek($here, IO::Seekable::SEEK_SET) |
937
|
|
|
|
|
|
|
or return _ioError("seeking after rewrite of local header"); |
938
|
|
|
|
|
|
|
|
939
|
84
|
|
|
|
|
1660
|
return AZ_OK; |
940
|
|
|
|
|
|
|
} |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
# Write central directory file header. |
943
|
|
|
|
|
|
|
# Returns a pair (AZ_OK, $headerSize) on success. |
944
|
|
|
|
|
|
|
sub _writeCentralDirectoryFileHeader { |
945
|
242
|
|
|
242
|
|
327
|
my $self = shift; |
946
|
242
|
|
|
|
|
283
|
my $fh = shift; |
947
|
242
|
|
|
|
|
430
|
my $adz64m = shift; # $archiveDesiredZip64Mode |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
# (Re-)Determine whether to write zip64 format. Assume |
950
|
|
|
|
|
|
|
# {'diskNumberStart'} is always zero. |
951
|
242
|
|
33
|
|
|
760
|
my $zip64 = $adz64m == ZIP64_HEADERS |
952
|
|
|
|
|
|
|
|| $self->desiredZip64Mode() == ZIP64_HEADERS |
953
|
|
|
|
|
|
|
|| $self->_writeOffset() > 0xffffffff |
954
|
|
|
|
|
|
|
|| $self->uncompressedSize() > 0xffffffff |
955
|
|
|
|
|
|
|
|| $self->writeLocalHeaderRelativeOffset() > 0xffffffff; |
956
|
|
|
|
|
|
|
|
957
|
242
|
|
66
|
|
|
946
|
$self->{'zip64'} ||= $zip64; |
958
|
|
|
|
|
|
|
|
959
|
242
|
|
|
|
|
319
|
my $versionMadeBy; |
960
|
|
|
|
|
|
|
my $versionNeededToExtract; |
961
|
242
|
|
|
|
|
522
|
my $compressedSize = $self->_writeOffset(); |
962
|
242
|
|
|
|
|
405
|
my $uncompressedSize = $self->uncompressedSize(); |
963
|
242
|
|
|
|
|
466
|
my $localHeaderRelativeOffset = $self->writeLocalHeaderRelativeOffset(); |
964
|
242
|
|
|
|
|
494
|
my $cdExtraField = $self->cdExtraField(); |
965
|
|
|
|
|
|
|
|
966
|
242
|
100
|
|
|
|
476
|
if (! $zip64) { |
967
|
172
|
|
|
|
|
200
|
$versionMadeBy = 20; |
968
|
172
|
|
|
|
|
211
|
$versionNeededToExtract = 20; |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
else { |
971
|
70
|
|
|
|
|
88
|
$versionMadeBy = 45; |
972
|
70
|
|
|
|
|
87
|
$versionNeededToExtract = 45; |
973
|
|
|
|
|
|
|
|
974
|
70
|
|
|
|
|
104
|
my $extraFieldFormat = ''; |
975
|
70
|
|
|
|
|
90
|
my @extraFieldValues = (); |
976
|
70
|
|
|
|
|
91
|
my $extraFieldSize = 0; |
977
|
70
|
50
|
|
|
|
130
|
if ($uncompressedSize > 0xffffffff) { |
978
|
0
|
|
|
|
|
0
|
$extraFieldFormat .= 'Q< '; |
979
|
0
|
|
|
|
|
0
|
push(@extraFieldValues, $uncompressedSize); |
980
|
0
|
|
|
|
|
0
|
$extraFieldSize += 8; |
981
|
0
|
|
|
|
|
0
|
$uncompressedSize = 0xffffffff; |
982
|
|
|
|
|
|
|
} |
983
|
70
|
50
|
|
|
|
141
|
if ($compressedSize > 0xffffffff) { |
984
|
0
|
|
|
|
|
0
|
$extraFieldFormat .= 'Q< '; |
985
|
0
|
|
|
|
|
0
|
push(@extraFieldValues, $compressedSize); |
986
|
0
|
|
|
|
|
0
|
$extraFieldSize += 8; |
987
|
0
|
|
|
|
|
0
|
$compressedSize = 0xffffffff; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
# Avoid empty zip64 extended information extra fields |
990
|
70
|
50
|
33
|
|
|
5082
|
if ( $localHeaderRelativeOffset > 0xffffffff |
991
|
|
|
|
|
|
|
|| @extraFieldValues == 0) { |
992
|
70
|
|
|
|
|
151
|
$extraFieldFormat .= 'Q< '; |
993
|
70
|
|
|
|
|
95
|
push(@extraFieldValues, $localHeaderRelativeOffset); |
994
|
70
|
|
|
|
|
76
|
$extraFieldSize += 8; |
995
|
70
|
|
|
|
|
89
|
$localHeaderRelativeOffset = 0xffffffff; |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
$cdExtraField .= |
999
|
70
|
|
|
|
|
200
|
pack("S< S< $extraFieldFormat", |
1000
|
|
|
|
|
|
|
0x0001, $extraFieldSize, |
1001
|
|
|
|
|
|
|
@extraFieldValues); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
242
|
|
|
|
|
416
|
my $fileNameLength = length($self->fileNameAsBytes()); |
1005
|
242
|
|
|
|
|
376
|
my $extraFieldLength = length($cdExtraField); |
1006
|
242
|
|
|
|
|
569
|
my $fileCommentLength = length($self->fileComment()); |
1007
|
|
|
|
|
|
|
|
1008
|
242
|
|
|
|
|
341
|
my $sigData = |
1009
|
|
|
|
|
|
|
pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE); |
1010
|
242
|
50
|
|
|
|
533
|
$self->_print($fh, $sigData) |
1011
|
|
|
|
|
|
|
or return _ioError("writing central directory header signature"); |
1012
|
|
|
|
|
|
|
|
1013
|
242
|
|
|
|
|
1950
|
my $header = pack( |
1014
|
|
|
|
|
|
|
CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, |
1015
|
|
|
|
|
|
|
$versionMadeBy, |
1016
|
|
|
|
|
|
|
$self->fileAttributeFormat(), |
1017
|
|
|
|
|
|
|
$versionNeededToExtract, |
1018
|
|
|
|
|
|
|
$self->bitFlag(), |
1019
|
|
|
|
|
|
|
$self->desiredCompressionMethod(), |
1020
|
|
|
|
|
|
|
$self->lastModFileDateTime(), |
1021
|
|
|
|
|
|
|
$self->crc32(), # these three fields should have been updated |
1022
|
|
|
|
|
|
|
$compressedSize, # by writing the data stream out |
1023
|
|
|
|
|
|
|
$uncompressedSize, # |
1024
|
|
|
|
|
|
|
$fileNameLength, |
1025
|
|
|
|
|
|
|
$extraFieldLength, |
1026
|
|
|
|
|
|
|
$fileCommentLength, |
1027
|
|
|
|
|
|
|
0, # {'diskNumberStart'}, |
1028
|
|
|
|
|
|
|
$self->internalFileAttributes(), |
1029
|
|
|
|
|
|
|
$self->externalFileAttributes(), |
1030
|
|
|
|
|
|
|
$localHeaderRelativeOffset); |
1031
|
|
|
|
|
|
|
|
1032
|
242
|
50
|
|
|
|
604
|
$self->_print($fh, $header) |
1033
|
|
|
|
|
|
|
or return _ioError("writing central directory header"); |
1034
|
|
|
|
|
|
|
|
1035
|
242
|
50
|
|
|
|
1834
|
if ($fileNameLength) { |
1036
|
242
|
50
|
|
|
|
457
|
$self->_print($fh, $self->fileNameAsBytes()) |
1037
|
|
|
|
|
|
|
or return _ioError("writing central directory header signature"); |
1038
|
|
|
|
|
|
|
} |
1039
|
242
|
100
|
|
|
|
1672
|
if ($extraFieldLength) { |
1040
|
71
|
50
|
|
|
|
157
|
$self->_print($fh, $cdExtraField) |
1041
|
|
|
|
|
|
|
or return _ioError("writing central directory extra field"); |
1042
|
|
|
|
|
|
|
} |
1043
|
242
|
50
|
|
|
|
769
|
if ($fileCommentLength) { |
1044
|
0
|
0
|
|
|
|
0
|
$self->_print($fh, $self->fileComment()) |
1045
|
|
|
|
|
|
|
or return _ioError("writing central directory file comment"); |
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# Update object members with information which might have |
1049
|
|
|
|
|
|
|
# changed while writing this member. We already did the |
1050
|
|
|
|
|
|
|
# zip64 flag. We must not update the extra fields with any |
1051
|
|
|
|
|
|
|
# zip64 information, since we consider that internal. |
1052
|
242
|
|
|
|
|
397
|
$self->{'versionMadeBy'} = $versionMadeBy; |
1053
|
242
|
|
|
|
|
389
|
$self->{'versionNeededToExtract'} = $versionNeededToExtract; |
1054
|
242
|
|
|
|
|
480
|
$self->{'compressedSize'} = $self->_writeOffset(); |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
return |
1057
|
242
|
|
|
|
|
708
|
(AZ_OK, |
1058
|
|
|
|
|
|
|
CENTRAL_DIRECTORY_FILE_HEADER_LENGTH + |
1059
|
|
|
|
|
|
|
SIGNATURE_LENGTH + |
1060
|
|
|
|
|
|
|
$fileNameLength + |
1061
|
|
|
|
|
|
|
$extraFieldLength + |
1062
|
|
|
|
|
|
|
$fileCommentLength) |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
# This writes a data descriptor to the given file handle. |
1066
|
|
|
|
|
|
|
# Assumes that crc32, writeOffset, and uncompressedSize are |
1067
|
|
|
|
|
|
|
# set correctly (they should be after a write). |
1068
|
|
|
|
|
|
|
# Returns a pair (AZ_OK, $dataDescriptorSize) on success. |
1069
|
|
|
|
|
|
|
# Further, the local file header should have the |
1070
|
|
|
|
|
|
|
# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set. |
1071
|
|
|
|
|
|
|
sub _writeDataDescriptor { |
1072
|
98
|
|
|
98
|
|
140
|
my $self = shift; |
1073
|
98
|
|
|
|
|
138
|
my $fh = shift; |
1074
|
|
|
|
|
|
|
|
1075
|
98
|
|
|
|
|
112
|
my $descriptor; |
1076
|
98
|
100
|
|
|
|
179
|
if (! $self->zip64()) { |
1077
|
67
|
|
|
|
|
125
|
$descriptor = |
1078
|
|
|
|
|
|
|
pack(SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT, |
1079
|
|
|
|
|
|
|
DATA_DESCRIPTOR_SIGNATURE, |
1080
|
|
|
|
|
|
|
$self->crc32(), |
1081
|
|
|
|
|
|
|
$self->_writeOffset(), # compressed size |
1082
|
|
|
|
|
|
|
$self->uncompressedSize()); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
else { |
1085
|
31
|
|
|
|
|
69
|
$descriptor = |
1086
|
|
|
|
|
|
|
pack(SIGNATURE_FORMAT . DATA_DESCRIPTOR_ZIP64_FORMAT, |
1087
|
|
|
|
|
|
|
DATA_DESCRIPTOR_SIGNATURE, |
1088
|
|
|
|
|
|
|
$self->crc32(), |
1089
|
|
|
|
|
|
|
$self->_writeOffset(), # compressed size |
1090
|
|
|
|
|
|
|
$self->uncompressedSize()); |
1091
|
|
|
|
|
|
|
} |
1092
|
|
|
|
|
|
|
|
1093
|
98
|
50
|
|
|
|
257
|
$self->_print($fh, $descriptor) |
1094
|
|
|
|
|
|
|
or return _ioError("writing data descriptor"); |
1095
|
|
|
|
|
|
|
|
1096
|
98
|
|
|
|
|
704
|
return (AZ_OK, length($descriptor)); |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
sub readChunk { |
1100
|
272
|
|
|
272
|
1
|
384
|
my $self = shift; |
1101
|
272
|
50
|
|
|
|
618
|
my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0]; |
1102
|
|
|
|
|
|
|
|
1103
|
272
|
100
|
|
|
|
593
|
if ($self->readIsDone()) { |
1104
|
12
|
|
|
|
|
31
|
$self->endRead(); |
1105
|
12
|
|
|
|
|
35
|
my $dummy = ''; |
1106
|
12
|
|
|
|
|
33
|
return (\$dummy, AZ_STREAM_END); |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
|
1109
|
260
|
50
|
|
|
|
552
|
$chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize); |
1110
|
260
|
100
|
|
|
|
503
|
$chunkSize = $self->_readDataRemaining() |
1111
|
|
|
|
|
|
|
if $chunkSize > $self->_readDataRemaining(); |
1112
|
|
|
|
|
|
|
|
1113
|
260
|
|
|
|
|
402
|
my $buffer = ''; |
1114
|
260
|
|
|
|
|
324
|
my $outputRef; |
1115
|
260
|
|
|
|
|
900
|
my ($bytesRead, $status) = $self->_readRawChunk(\$buffer, $chunkSize); |
1116
|
260
|
50
|
|
|
|
599
|
return (\$buffer, $status) unless $status == AZ_OK; |
1117
|
|
|
|
|
|
|
|
1118
|
260
|
100
|
66
|
|
|
968
|
$buffer && $self->isEncrypted and $buffer = $self->_decode($buffer); |
1119
|
260
|
|
|
|
|
472
|
$self->{'readDataRemaining'} -= $bytesRead; |
1120
|
260
|
|
|
|
|
380
|
$self->{'readOffset'} += $bytesRead; |
1121
|
|
|
|
|
|
|
|
1122
|
260
|
100
|
|
|
|
481
|
if ($self->compressionMethod() == COMPRESSION_STORED) { |
1123
|
213
|
|
|
|
|
761
|
$self->{'crc32'} = $self->computeCRC32($buffer, $self->{'crc32'}); |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
|
1126
|
260
|
|
|
|
|
525
|
($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer); |
|
260
|
|
|
|
|
1035
|
|
1127
|
260
|
|
|
|
|
588
|
$self->{'writeOffset'} += length($$outputRef); |
1128
|
|
|
|
|
|
|
|
1129
|
260
|
100
|
|
|
|
526
|
$self->endRead() |
1130
|
|
|
|
|
|
|
if $self->readIsDone(); |
1131
|
|
|
|
|
|
|
|
1132
|
260
|
|
|
|
|
587
|
return ($outputRef, $status); |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
# Read the next raw chunk of my data. Subclasses MUST implement. |
1136
|
|
|
|
|
|
|
# my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize ); |
1137
|
|
|
|
|
|
|
sub _readRawChunk { |
1138
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1139
|
0
|
|
|
|
|
0
|
return $self->_subclassResponsibility(); |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
# A place holder to catch rewindData errors if someone ignores |
1143
|
|
|
|
|
|
|
# the error code. |
1144
|
|
|
|
|
|
|
sub _noChunk { |
1145
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1146
|
0
|
|
|
|
|
0
|
return (\undef, _error("trying to copy chunk when init failed")); |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
# Basically a no-op so that I can have a consistent interface. |
1150
|
|
|
|
|
|
|
# ( $outputRef, $status) = $self->_copyChunk( \$buffer ); |
1151
|
|
|
|
|
|
|
sub _copyChunk { |
1152
|
182
|
|
|
182
|
|
435
|
my ($self, $dataRef) = @_; |
1153
|
182
|
|
|
|
|
337
|
return ($dataRef, AZ_OK); |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
# ( $outputRef, $status) = $self->_deflateChunk( \$buffer ); |
1157
|
|
|
|
|
|
|
sub _deflateChunk { |
1158
|
63
|
|
|
63
|
|
198
|
my ($self, $buffer) = @_; |
1159
|
63
|
|
|
|
|
181
|
my ($status) = $self->_deflater()->deflate($buffer, my $out); |
1160
|
|
|
|
|
|
|
|
1161
|
63
|
100
|
|
|
|
191
|
if ($self->_readDataRemaining() == 0) { |
|
|
50
|
|
|
|
|
|
1162
|
61
|
|
|
|
|
85
|
my $extraOutput; |
1163
|
61
|
|
|
|
|
143
|
($status) = $self->_deflater()->flush($extraOutput); |
1164
|
61
|
|
|
|
|
312
|
$out .= $extraOutput; |
1165
|
61
|
|
|
|
|
211
|
$self->endRead(); |
1166
|
61
|
|
|
|
|
193
|
return (\$out, AZ_STREAM_END); |
1167
|
|
|
|
|
|
|
} elsif ($status == Z_OK) { |
1168
|
2
|
|
|
|
|
13
|
return (\$out, AZ_OK); |
1169
|
|
|
|
|
|
|
} else { |
1170
|
0
|
|
|
|
|
0
|
$self->endRead(); |
1171
|
0
|
|
|
|
|
0
|
my $retval = _error('deflate error', $status); |
1172
|
0
|
|
|
|
|
0
|
my $dummy = ''; |
1173
|
0
|
|
|
|
|
0
|
return (\$dummy, $retval); |
1174
|
|
|
|
|
|
|
} |
1175
|
|
|
|
|
|
|
} |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
# ( $outputRef, $status) = $self->_inflateChunk( \$buffer ); |
1178
|
|
|
|
|
|
|
sub _inflateChunk { |
1179
|
15
|
|
|
15
|
|
35
|
my ($self, $buffer) = @_; |
1180
|
15
|
|
|
|
|
49
|
my ($status) = $self->_inflater()->inflate($buffer, my $out); |
1181
|
15
|
|
|
|
|
35
|
my $retval; |
1182
|
15
|
100
|
|
|
|
57
|
$self->endRead() unless $status == Z_OK; |
1183
|
15
|
50
|
66
|
|
|
48
|
if ($status == Z_OK || $status == Z_STREAM_END) { |
1184
|
15
|
100
|
|
|
|
235
|
$retval = ($status == Z_STREAM_END) ? AZ_STREAM_END : AZ_OK; |
1185
|
15
|
|
|
|
|
113
|
return (\$out, $retval); |
1186
|
|
|
|
|
|
|
} else { |
1187
|
0
|
|
|
|
|
0
|
$retval = _error('inflate error', $status); |
1188
|
0
|
|
|
|
|
0
|
my $dummy = ''; |
1189
|
0
|
|
|
|
|
0
|
return (\$dummy, $retval); |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
sub rewindData { |
1194
|
320
|
|
|
320
|
1
|
454
|
my $self = shift; |
1195
|
320
|
|
|
|
|
395
|
my $status; |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
# set to trap init errors |
1198
|
320
|
|
|
|
|
1275
|
$self->{'chunkHandler'} = $self->can('_noChunk'); |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
# Work around WinZip bug with 0-length DEFLATED files |
1201
|
320
|
100
|
|
|
|
593
|
$self->desiredCompressionMethod(COMPRESSION_STORED) |
1202
|
|
|
|
|
|
|
if $self->uncompressedSize() == 0; |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
# assume that we're going to read the whole file, and compute the CRC anew. |
1205
|
320
|
100
|
|
|
|
720
|
$self->{'crc32'} = 0 |
1206
|
|
|
|
|
|
|
if ($self->compressionMethod() == COMPRESSION_STORED); |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
# These are the only combinations of methods we deal with right now. |
1209
|
320
|
100
|
100
|
|
|
530
|
if ( $self->compressionMethod() == COMPRESSION_STORED |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED) { |
1211
|
61
|
|
|
|
|
198
|
($self->{'deflater'}, $status) = Compress::Raw::Zlib::Deflate->new( |
1212
|
|
|
|
|
|
|
'-Level' => $self->desiredCompressionLevel(), |
1213
|
|
|
|
|
|
|
'-WindowBits' => -MAX_WBITS(), # necessary magic |
1214
|
|
|
|
|
|
|
'-Bufsize' => $Archive::Zip::ChunkSize, |
1215
|
|
|
|
|
|
|
@_ |
1216
|
|
|
|
|
|
|
); # pass additional options |
1217
|
61
|
50
|
|
|
|
35639
|
return _error('deflateInit error:', $status) |
1218
|
|
|
|
|
|
|
unless $status == Z_OK; |
1219
|
61
|
|
|
|
|
623
|
$self->{'chunkHandler'} = $self->can('_deflateChunk'); |
1220
|
|
|
|
|
|
|
} elsif ($self->compressionMethod() == COMPRESSION_DEFLATED |
1221
|
|
|
|
|
|
|
and $self->desiredCompressionMethod() == COMPRESSION_STORED) { |
1222
|
20
|
|
|
|
|
85
|
($self->{'inflater'}, $status) = Compress::Raw::Zlib::Inflate->new( |
1223
|
|
|
|
|
|
|
'-WindowBits' => -MAX_WBITS(), # necessary magic |
1224
|
|
|
|
|
|
|
'-Bufsize' => $Archive::Zip::ChunkSize, |
1225
|
|
|
|
|
|
|
@_ |
1226
|
|
|
|
|
|
|
); # pass additional options |
1227
|
20
|
50
|
|
|
|
9599
|
return _error('inflateInit error:', $status) |
1228
|
|
|
|
|
|
|
unless $status == Z_OK; |
1229
|
20
|
|
|
|
|
307
|
$self->{'chunkHandler'} = $self->can('_inflateChunk'); |
1230
|
|
|
|
|
|
|
} elsif ($self->compressionMethod() == $self->desiredCompressionMethod()) { |
1231
|
239
|
|
|
|
|
755
|
$self->{'chunkHandler'} = $self->can('_copyChunk'); |
1232
|
|
|
|
|
|
|
} else { |
1233
|
0
|
|
|
|
|
0
|
return _error( |
1234
|
|
|
|
|
|
|
sprintf( |
1235
|
|
|
|
|
|
|
"Unsupported compression combination: read %d, write %d", |
1236
|
|
|
|
|
|
|
$self->compressionMethod(), |
1237
|
|
|
|
|
|
|
$self->desiredCompressionMethod())); |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
|
1240
|
320
|
100
|
|
|
|
883
|
$self->{'readDataRemaining'} = |
1241
|
|
|
|
|
|
|
($self->compressionMethod() == COMPRESSION_STORED) |
1242
|
|
|
|
|
|
|
? $self->uncompressedSize() |
1243
|
|
|
|
|
|
|
: $self->compressedSize(); |
1244
|
320
|
|
|
|
|
519
|
$self->{'dataEnded'} = 0; |
1245
|
320
|
|
|
|
|
516
|
$self->{'readOffset'} = 0; |
1246
|
|
|
|
|
|
|
|
1247
|
320
|
|
|
|
|
589
|
return AZ_OK; |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
sub endRead { |
1251
|
721
|
|
|
721
|
1
|
1031
|
my $self = shift; |
1252
|
721
|
|
|
|
|
1062
|
delete $self->{'inflater'}; |
1253
|
721
|
|
|
|
|
2017
|
delete $self->{'deflater'}; |
1254
|
721
|
|
|
|
|
1013
|
$self->{'dataEnded'} = 1; |
1255
|
721
|
|
|
|
|
864
|
$self->{'readDataRemaining'} = 0; |
1256
|
721
|
|
|
|
|
1085
|
return AZ_OK; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
sub readIsDone { |
1260
|
532
|
|
|
532
|
1
|
698
|
my $self = shift; |
1261
|
532
|
|
100
|
|
|
966
|
return ($self->_dataEnded() or !$self->_readDataRemaining()); |
1262
|
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub contents { |
1265
|
18
|
|
|
18
|
1
|
10012
|
my $self = shift; |
1266
|
18
|
|
|
|
|
39
|
my $newContents = shift; |
1267
|
|
|
|
|
|
|
|
1268
|
18
|
100
|
|
|
|
48
|
if (defined($newContents)) { |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
# Change our type and ensure that succeeded to avoid |
1271
|
|
|
|
|
|
|
# endless recursion |
1272
|
6
|
|
|
|
|
75
|
$self->_become('Archive::Zip::StringMember'); |
1273
|
6
|
0
|
|
|
|
38
|
$self->_ISA('Archive::Zip::StringMember') or |
|
|
50
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
return |
1275
|
|
|
|
|
|
|
wantarray |
1276
|
|
|
|
|
|
|
? (undef, $self->_error('becoming Archive::Zip::StringMember')) |
1277
|
|
|
|
|
|
|
: undef; |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
# Now call the subclass contents method |
1280
|
6
|
|
|
|
|
62
|
my $retval = |
1281
|
|
|
|
|
|
|
$self->contents(pack('C0a*', $newContents)); # in case of Unicode |
1282
|
|
|
|
|
|
|
|
1283
|
6
|
50
|
|
|
|
40
|
return wantarray ? ($retval, AZ_OK) : $retval; |
1284
|
|
|
|
|
|
|
} else { |
1285
|
12
|
|
|
|
|
31
|
my $oldCompression = |
1286
|
|
|
|
|
|
|
$self->desiredCompressionMethod(COMPRESSION_STORED); |
1287
|
12
|
|
|
|
|
42
|
my $status = $self->rewindData(@_); |
1288
|
12
|
50
|
|
|
|
35
|
if ($status != AZ_OK) { |
1289
|
0
|
|
|
|
|
0
|
$self->endRead(); |
1290
|
0
|
0
|
|
|
|
0
|
return wantarray ? (undef, $status) : undef; |
1291
|
|
|
|
|
|
|
} |
1292
|
12
|
|
|
|
|
24
|
my $retval = ''; |
1293
|
12
|
|
|
|
|
29
|
while ($status == AZ_OK) { |
1294
|
23
|
|
|
|
|
31
|
my $ref; |
1295
|
23
|
|
|
|
|
61
|
($ref, $status) = $self->readChunk($self->_readDataRemaining()); |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
# did we get it in one chunk? |
1298
|
23
|
100
|
|
|
|
50
|
if (length($$ref) == $self->uncompressedSize()) { |
1299
|
11
|
|
|
|
|
35
|
$retval = $$ref; |
1300
|
|
|
|
|
|
|
} else { |
1301
|
12
|
|
|
|
|
41
|
$retval .= $$ref |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
} |
1304
|
12
|
|
|
|
|
1190
|
$self->desiredCompressionMethod($oldCompression); |
1305
|
12
|
|
|
|
|
35
|
$self->endRead(); |
1306
|
12
|
50
|
|
|
|
24
|
$status = AZ_OK if $status == AZ_STREAM_END; |
1307
|
12
|
50
|
|
|
|
25
|
$retval = undef unless $status == AZ_OK; |
1308
|
12
|
100
|
|
|
|
60
|
return wantarray ? ($retval, $status) : $retval; |
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
sub extractToFileHandle { |
1313
|
56
|
|
|
56
|
1
|
1855
|
my $self = shift; |
1314
|
|
|
|
|
|
|
# This can be the link name when "extracting" symbolic links |
1315
|
56
|
50
|
|
|
|
181
|
my $fhOrName = (ref($_[0]) eq 'HASH') ? shift->{fileHandle} : shift; |
1316
|
56
|
100
|
|
|
|
251
|
_binmode($fhOrName) if ref($fhOrName); |
1317
|
56
|
|
|
|
|
476
|
my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED); |
1318
|
56
|
|
|
|
|
207
|
my $status = $self->rewindData(@_); |
1319
|
56
|
50
|
|
|
|
305
|
$status = $self->_writeData($fhOrName) if $status == AZ_OK; |
1320
|
56
|
|
|
|
|
170
|
$self->desiredCompressionMethod($oldCompression); |
1321
|
56
|
|
|
|
|
144
|
$self->endRead(); |
1322
|
56
|
|
|
|
|
111
|
return $status; |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
# write local header and data stream to file handle. |
1326
|
|
|
|
|
|
|
# Returns a pair ($status, $memberSize) if successful. |
1327
|
|
|
|
|
|
|
# Stores the offset to the start of the header in my |
1328
|
|
|
|
|
|
|
# writeLocalHeaderRelativeOffset member. |
1329
|
|
|
|
|
|
|
sub _writeToFileHandle { |
1330
|
242
|
|
|
242
|
|
372
|
my $self = shift; |
1331
|
242
|
|
|
|
|
313
|
my $fh = shift; |
1332
|
242
|
|
|
|
|
306
|
my $fhIsSeekable = shift; |
1333
|
242
|
|
|
|
|
326
|
my $offset = shift; |
1334
|
242
|
|
|
|
|
343
|
my $adz64m = shift; # $archiveDesiredZip64Mode |
1335
|
|
|
|
|
|
|
|
1336
|
242
|
50
|
|
|
|
561
|
return _error("no member name given for $self") |
1337
|
|
|
|
|
|
|
if $self->fileName() eq ''; |
1338
|
|
|
|
|
|
|
|
1339
|
242
|
|
|
|
|
468
|
$self->{'writeLocalHeaderRelativeOffset'} = $offset; |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
# Determine if I need to write a data descriptor |
1342
|
|
|
|
|
|
|
# I need to do this if I can't refresh the header |
1343
|
|
|
|
|
|
|
# and I don't know compressed size or crc32 fields. |
1344
|
242
|
|
66
|
|
|
547
|
my $headerFieldsUnknown = ( |
1345
|
|
|
|
|
|
|
($self->uncompressedSize() > 0) |
1346
|
|
|
|
|
|
|
and ($self->compressionMethod() == COMPRESSION_STORED |
1347
|
|
|
|
|
|
|
or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED)); |
1348
|
|
|
|
|
|
|
|
1349
|
242
|
|
100
|
|
|
777
|
my $shouldWriteDataDescriptor = |
1350
|
|
|
|
|
|
|
($headerFieldsUnknown and not $fhIsSeekable); |
1351
|
|
|
|
|
|
|
|
1352
|
242
|
100
|
|
|
|
420
|
$self->hasDataDescriptor(1) |
1353
|
|
|
|
|
|
|
if ($shouldWriteDataDescriptor); |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
# Determine whether to write zip64 format |
1356
|
242
|
|
66
|
|
|
773
|
my $zip64 = $adz64m == ZIP64_HEADERS |
1357
|
|
|
|
|
|
|
|| $self->desiredZip64Mode() == ZIP64_HEADERS |
1358
|
|
|
|
|
|
|
|| $self->uncompressedSize() > 0xffffffff; |
1359
|
|
|
|
|
|
|
|
1360
|
242
|
|
66
|
|
|
973
|
$self->{'zip64'} ||= $zip64; |
1361
|
|
|
|
|
|
|
|
1362
|
242
|
|
|
|
|
434
|
$self->{'writeOffset'} = 0; |
1363
|
|
|
|
|
|
|
|
1364
|
242
|
|
|
|
|
848
|
my $status = $self->rewindData(); |
1365
|
242
|
50
|
|
|
|
475
|
return $status if $status != AZ_OK; |
1366
|
|
|
|
|
|
|
|
1367
|
242
|
|
|
|
|
327
|
my $memberSize; |
1368
|
242
|
|
|
|
|
854
|
($status, $memberSize) = $self->_writeLocalFileHeader($fh); |
1369
|
242
|
50
|
|
|
|
518
|
return $status if $status != AZ_OK; |
1370
|
|
|
|
|
|
|
|
1371
|
242
|
|
|
|
|
625
|
$status = $self->_writeData($fh); |
1372
|
242
|
50
|
|
|
|
640
|
return $status if $status != AZ_OK; |
1373
|
242
|
|
|
|
|
541
|
$memberSize += $self->_writeOffset(); |
1374
|
|
|
|
|
|
|
|
1375
|
242
|
100
|
|
|
|
460
|
if ($self->hasDataDescriptor()) { |
|
|
100
|
|
|
|
|
|
1376
|
98
|
|
|
|
|
138
|
my $ddSize; |
1377
|
98
|
|
|
|
|
297
|
($status, $ddSize) = $self->_writeDataDescriptor($fh); |
1378
|
98
|
|
|
|
|
145
|
$memberSize += $ddSize; |
1379
|
|
|
|
|
|
|
} elsif ($headerFieldsUnknown) { |
1380
|
84
|
|
|
|
|
244
|
$status = $self->_refreshLocalFileHeader($fh); |
1381
|
|
|
|
|
|
|
} |
1382
|
242
|
50
|
|
|
|
475
|
return $status if $status != AZ_OK; |
1383
|
|
|
|
|
|
|
|
1384
|
242
|
|
|
|
|
761
|
return ($status, $memberSize); |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
# Copy my (possibly compressed) data to given file handle. |
1388
|
|
|
|
|
|
|
# Returns C on success |
1389
|
|
|
|
|
|
|
sub _writeData { |
1390
|
298
|
|
|
298
|
|
478
|
my $self = shift; |
1391
|
298
|
|
|
|
|
416
|
my $fhOrName = shift; |
1392
|
|
|
|
|
|
|
|
1393
|
298
|
100
|
100
|
|
|
692
|
if ($self->isSymbolicLink() && OS_SUPPORTS_SYMLINK) { |
1394
|
7
|
|
|
|
|
16
|
my $chunkSize = $Archive::Zip::ChunkSize; |
1395
|
7
|
|
|
|
|
29
|
my ($outRef, $status) = $self->readChunk($chunkSize); |
1396
|
7
|
100
|
|
|
|
231
|
symlink($$outRef, $fhOrName) |
1397
|
|
|
|
|
|
|
or return _ioError("creating symbolic link"); |
1398
|
|
|
|
|
|
|
} else { |
1399
|
291
|
100
|
|
|
|
567
|
return AZ_OK if ($self->uncompressedSize() == 0); |
1400
|
228
|
|
|
|
|
325
|
my $status; |
1401
|
228
|
|
|
|
|
398
|
my $chunkSize = $Archive::Zip::ChunkSize; |
1402
|
228
|
|
|
|
|
578
|
while ($self->_readDataRemaining() > 0) { |
1403
|
234
|
|
|
|
|
295
|
my $outRef; |
1404
|
234
|
|
|
|
|
576
|
($outRef, $status) = $self->readChunk($chunkSize); |
1405
|
234
|
50
|
66
|
|
|
789
|
return $status if ($status != AZ_OK and $status != AZ_STREAM_END); |
1406
|
|
|
|
|
|
|
|
1407
|
234
|
100
|
|
|
|
514
|
if (length($$outRef) > 0) { |
1408
|
232
|
50
|
|
|
|
637
|
$self->_print($fhOrName, $$outRef) |
1409
|
|
|
|
|
|
|
or return _ioError("write error during copy"); |
1410
|
|
|
|
|
|
|
} |
1411
|
|
|
|
|
|
|
|
1412
|
234
|
100
|
|
|
|
3099
|
last if $status == AZ_STREAM_END; |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
} |
1415
|
233
|
|
|
|
|
557
|
return AZ_OK; |
1416
|
|
|
|
|
|
|
} |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
# Return true if I depend on the named file |
1419
|
|
|
|
|
|
|
sub _usesFileNamed { |
1420
|
108
|
|
|
108
|
|
324
|
return 0; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
# ############################################################################## |
1424
|
|
|
|
|
|
|
# |
1425
|
|
|
|
|
|
|
# Decrypt section |
1426
|
|
|
|
|
|
|
# |
1427
|
|
|
|
|
|
|
# H.Merijn Brand (Tux) 2011-06-28 |
1428
|
|
|
|
|
|
|
# |
1429
|
|
|
|
|
|
|
# ############################################################################## |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
# This code is derived from the crypt source of unzip-6.0 dated 05 Jan 2007 |
1432
|
|
|
|
|
|
|
# Its license states: |
1433
|
|
|
|
|
|
|
# |
1434
|
|
|
|
|
|
|
# --8<--- |
1435
|
|
|
|
|
|
|
# Copyright (c) 1990-2007 Info-ZIP. All rights reserved. |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
# See the accompanying file LICENSE, version 2005-Feb-10 or later |
1438
|
|
|
|
|
|
|
# (the contents of which are also included in (un)zip.h) for terms of use. |
1439
|
|
|
|
|
|
|
# If, for some reason, all these files are missing, the Info-ZIP license |
1440
|
|
|
|
|
|
|
# also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html |
1441
|
|
|
|
|
|
|
# |
1442
|
|
|
|
|
|
|
# crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h] |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
# The main encryption/decryption source code for Info-Zip software was |
1445
|
|
|
|
|
|
|
# originally written in Europe. To the best of our knowledge, it can |
1446
|
|
|
|
|
|
|
# be freely distributed in both source and object forms from any country, |
1447
|
|
|
|
|
|
|
# including the USA under License Exception TSU of the U.S. Export |
1448
|
|
|
|
|
|
|
# Administration Regulations (section 740.13(e)) of 6 June 2002. |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
# NOTE on copyright history: |
1451
|
|
|
|
|
|
|
# Previous versions of this source package (up to version 2.8) were |
1452
|
|
|
|
|
|
|
# not copyrighted and put in the public domain. If you cannot comply |
1453
|
|
|
|
|
|
|
# with the Info-Zip LICENSE, you may want to look for one of those |
1454
|
|
|
|
|
|
|
# public domain versions. |
1455
|
|
|
|
|
|
|
# |
1456
|
|
|
|
|
|
|
# This encryption code is a direct transcription of the algorithm from |
1457
|
|
|
|
|
|
|
# Roger Schlafly, described by Phil Katz in the file appnote.txt. This |
1458
|
|
|
|
|
|
|
# file (appnote.txt) is distributed with the PKZIP program (even in the |
1459
|
|
|
|
|
|
|
# version without encryption capabilities). |
1460
|
|
|
|
|
|
|
# -->8--- |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
# As of January 2000, US export regulations were amended to allow export |
1463
|
|
|
|
|
|
|
# of free encryption source code from the US. As of June 2002, these |
1464
|
|
|
|
|
|
|
# regulations were further relaxed to allow export of encryption binaries |
1465
|
|
|
|
|
|
|
# associated with free encryption source code. The Zip 2.31, UnZip 5.52 |
1466
|
|
|
|
|
|
|
# and Wiz 5.02 archives now include full crypto source code. As of the |
1467
|
|
|
|
|
|
|
# Zip 2.31 release, all official binaries include encryption support; the |
1468
|
|
|
|
|
|
|
# former "zcr" archives ceased to exist. |
1469
|
|
|
|
|
|
|
# (Note that restrictions may still exist in other countries, of course.) |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
# For now, we just support the decrypt stuff |
1472
|
|
|
|
|
|
|
# All below methods are supposed to be private |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
# use Data::Peek; |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
my @keys; |
1477
|
|
|
|
|
|
|
my @crct = do { |
1478
|
|
|
|
|
|
|
my $xor = 0xedb88320; |
1479
|
|
|
|
|
|
|
my @crc = (0) x 1024; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
# generate a crc for every 8-bit value |
1482
|
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
1483
|
|
|
|
|
|
|
my $c = $n; |
1484
|
|
|
|
|
|
|
$c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8; |
1485
|
|
|
|
|
|
|
$crc[$n] = _revbe($c); |
1486
|
|
|
|
|
|
|
} |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
# generate crc for each value followed by one, two, and three zeros */ |
1489
|
|
|
|
|
|
|
foreach my $n (0 .. 255) { |
1490
|
|
|
|
|
|
|
my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff; |
1491
|
|
|
|
|
|
|
$crc[$_ * 256 + $n] = $c for 1 .. 3; |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
map { _revbe($crc[$_]) } 0 .. 1023; |
1494
|
|
|
|
|
|
|
}; |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
sub _crc32 { |
1497
|
194
|
|
|
194
|
|
274
|
my ($c, $b) = @_; |
1498
|
194
|
|
|
|
|
271
|
return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8)); |
1499
|
|
|
|
|
|
|
} # _crc32 |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
sub _revbe { |
1502
|
33280
|
|
|
33280
|
|
36147
|
my $w = shift; |
1503
|
33280
|
|
|
|
|
55460
|
return (($w >> 24) + |
1504
|
|
|
|
|
|
|
(($w >> 8) & 0xff00) + |
1505
|
|
|
|
|
|
|
(($w & 0xff00) << 8) + |
1506
|
|
|
|
|
|
|
(($w & 0xff) << 24)); |
1507
|
|
|
|
|
|
|
} # _revbe |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
sub _update_keys { |
1510
|
26
|
|
|
26
|
|
13130
|
use integer; |
|
26
|
|
|
|
|
428
|
|
|
26
|
|
|
|
|
142
|
|
1511
|
97
|
|
|
97
|
|
107
|
my $c = shift; # signed int |
1512
|
97
|
|
|
|
|
129
|
$keys[0] = _crc32($keys[0], $c); |
1513
|
97
|
|
|
|
|
150
|
$keys[1] = (($keys[1] + ($keys[0] & 0xff)) * 0x08088405 + 1) & 0xffffffff; |
1514
|
97
|
|
|
|
|
110
|
my $keyshift = $keys[1] >> 24; |
1515
|
97
|
|
|
|
|
117
|
$keys[2] = _crc32($keys[2], $keyshift); |
1516
|
|
|
|
|
|
|
} # _update_keys |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
sub _zdecode ($) { |
1519
|
84
|
|
|
84
|
|
99
|
my $c = shift; |
1520
|
84
|
|
|
|
|
111
|
my $t = ($keys[2] & 0xffff) | 2; |
1521
|
84
|
|
|
|
|
165
|
_update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff)); |
1522
|
84
|
|
|
|
|
148
|
return $c; |
1523
|
|
|
|
|
|
|
} # _zdecode |
1524
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
sub _decode { |
1526
|
3
|
|
|
3
|
|
6
|
my $self = shift; |
1527
|
3
|
|
|
|
|
4
|
my $buff = shift; |
1528
|
|
|
|
|
|
|
|
1529
|
3
|
50
|
|
|
|
8
|
$self->isEncrypted or return $buff; |
1530
|
|
|
|
|
|
|
|
1531
|
3
|
|
|
|
|
9
|
my $pass = $self->password; |
1532
|
3
|
50
|
|
|
|
8
|
defined $pass or return ""; |
1533
|
|
|
|
|
|
|
|
1534
|
3
|
|
|
|
|
11
|
@keys = (0x12345678, 0x23456789, 0x34567890); |
1535
|
3
|
|
|
|
|
13
|
_update_keys($_) for unpack "C*", $pass; |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
# DDumper { uk => [ @keys ] }; |
1538
|
|
|
|
|
|
|
|
1539
|
3
|
|
|
|
|
12
|
my $head = substr $buff, 0, 12, ""; |
1540
|
3
|
|
|
|
|
9
|
my @head = map { _zdecode($_) } unpack "C*", $head; |
|
36
|
|
|
|
|
63
|
|
1541
|
|
|
|
|
|
|
my $x = |
1542
|
|
|
|
|
|
|
$self->{externalFileAttributes} |
1543
|
|
|
|
|
|
|
? ($self->{lastModFileDateTime} >> 8) & 0xff |
1544
|
3
|
50
|
|
|
|
21
|
: $self->{crc32} >> 24; |
1545
|
3
|
100
|
|
|
|
10
|
$head[-1] == $x or return ""; # Password fail |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
# Worth checking ... |
1548
|
2
|
|
|
|
|
16
|
$self->{crc32c} = (unpack LOCAL_FILE_HEADER_FORMAT, pack "C*", @head)[3]; |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
# DHexDump ($buff); |
1551
|
2
|
|
|
|
|
7
|
$buff = pack "C*" => map { _zdecode($_) } unpack "C*" => $buff; |
|
48
|
|
|
|
|
58
|
|
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
# DHexDump ($buff); |
1554
|
2
|
|
|
|
|
9
|
return $buff; |
1555
|
|
|
|
|
|
|
} # _decode |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
1; |