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