File Coverage

blib/lib/IO/Uncompress/Unzip.pm
Criterion Covered Total %
statement 298 431 69.1
branch 104 212 49.0
condition 12 20 60.0
subroutine 33 39 84.6
pod 2 20 10.0
total 449 722 62.1


line stmt bran cond sub pod time code
1             package IO::Uncompress::Unzip;
2              
3             require 5.006 ;
4              
5             # for RFC1952
6              
7 83     83   6488 use strict ;
  83         151  
  83         2152  
8 83     83   376 use warnings;
  83         149  
  83         2016  
9 83     83   421 use bytes;
  83         193  
  83         429  
10              
11 83     83   1765 use IO::File;
  83         162  
  83         11945  
12 83     83   4758 use IO::Uncompress::RawInflate 2.204 ;
  83         1270  
  83         3842  
13 83     83   475 use IO::Compress::Base::Common 2.204 qw(:Status );
  83         1384  
  83         8237  
14 83     83   555 use IO::Uncompress::Adapter::Inflate 2.204 ;
  83         1316  
  83         2225  
15 83     83   32729 use IO::Uncompress::Adapter::Identity 2.204 ;
  83         1532  
  83         2438  
16 83     83   492 use IO::Compress::Zlib::Extra 2.204 ;
  83         1116  
  83         1738  
17 83     83   388 use IO::Compress::Zip::Constants 2.204 ;
  83         839  
  83         16559  
18              
19 83     83   518 use Compress::Raw::Zlib 2.204 () ;
  83         1009  
  83         8009  
20              
21             BEGIN
22             {
23             # Don't trigger any __DIE__ Hooks.
24 83     83   427 local $SIG{__DIE__};
25              
26 83         171 eval{ require IO::Uncompress::Adapter::Bunzip2 ;
  83         6753  
27 83         461 IO::Uncompress::Adapter::Bunzip2->import() } ;
28 83         152 eval{ require IO::Uncompress::Adapter::UnLzma ;
  83         10457  
29 0         0 IO::Uncompress::Adapter::UnLzma->import() } ;
30 83         332 eval{ require IO::Uncompress::Adapter::UnXz ;
  83         8813  
31 0         0 IO::Uncompress::Adapter::UnXz->import() } ;
32 83         312 eval{ require IO::Uncompress::Adapter::UnZstd ;
  83         5731  
33 83         291996 IO::Uncompress::Adapter::UnZstd->import() } ;
34             }
35              
36              
37             require Exporter ;
38              
39             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
40              
41             $VERSION = '2.204';
42             $UnzipError = '';
43              
44             @ISA = qw(IO::Uncompress::RawInflate Exporter);
45             @EXPORT_OK = qw($UnzipError unzip );
46             %EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
47             push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
48             Exporter::export_ok_tags('all');
49              
50             %headerLookup = (
51             ZIP_CENTRAL_HDR_SIG, \&skipCentralDirectory,
52             ZIP_END_CENTRAL_HDR_SIG, \&skipEndCentralDirectory,
53             ZIP64_END_CENTRAL_REC_HDR_SIG, \&skipCentralDirectory64Rec,
54             ZIP64_END_CENTRAL_LOC_HDR_SIG, \&skipCentralDirectory64Loc,
55             ZIP64_ARCHIVE_EXTRA_SIG, \&skipArchiveExtra,
56             ZIP64_DIGITAL_SIGNATURE_SIG, \&skipDigitalSignature,
57             );
58              
59             my %MethodNames = (
60             ZIP_CM_DEFLATE() => 'Deflated',
61             ZIP_CM_BZIP2() => 'Bzip2',
62             ZIP_CM_LZMA() => 'Lzma',
63             ZIP_CM_STORE() => 'Stored',
64             ZIP_CM_XZ() => 'Xz',
65             ZIP_CM_ZSTD() => 'Zstd',
66             );
67              
68             sub new
69             {
70 313     313 1 50766 my $class = shift ;
71 313         1088 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$UnzipError);
72 313         1168 $obj->_create(undef, 0, @_);
73             }
74              
75             sub unzip
76             {
77 172     172 1 82193 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$UnzipError);
78 172         787 return $obj->_inf(@_) ;
79             }
80              
81             sub getExtraParams
82             {
83              
84             return (
85             # # Zip header fields
86 468     468 0 5331 'name' => [IO::Compress::Base::Common::Parse_any, undef],
87              
88             'stream' => [IO::Compress::Base::Common::Parse_boolean, 0],
89             'efs' => [IO::Compress::Base::Common::Parse_boolean, 0],
90              
91             # TODO - This means reading the central directory to get
92             # 1. the local header offsets
93             # 2. The compressed data length
94             );
95             }
96              
97             sub ckParams
98             {
99 476     476 0 722 my $self = shift ;
100 476         673 my $got = shift ;
101              
102             # unzip always needs crc32
103 476         1435 $got->setValue('crc32' => 1);
104              
105 476         1050 *$self->{UnzipData}{Name} = $got->getValue('name');
106 476         1060 *$self->{UnzipData}{efs} = $got->getValue('efs');
107              
108 476         1233 return 1;
109             }
110              
111             sub mkUncomp
112             {
113 475     475 0 765 my $self = shift ;
114 475         648 my $got = shift ;
115              
116 475 100       1015 my $magic = $self->ckMagic()
117             or return 0;
118              
119 421 100       1289 *$self->{Info} = $self->readHeader($magic)
120             or return undef ;
121              
122 418         1101 return 1;
123              
124             }
125              
126             sub ckMagic
127             {
128 1387     1387 0 2067 my $self = shift;
129              
130 1387         1893 my $magic ;
131 1387         4244 $self->smartReadExact(\$magic, 4);
132              
133 1387         2943 *$self->{HeaderPending} = $magic ;
134              
135 1387 100       3091 return $self->HeaderError("Minimum header size is " .
136             4 . " bytes")
137             if length $magic != 4 ;
138              
139 1340 100       2939 return $self->HeaderError("Bad Magic")
140             if ! _isZipMagic($magic) ;
141              
142 1016         2162 *$self->{Type} = 'zip';
143              
144 1016         2568 return $magic ;
145             }
146              
147              
148             sub fastForward
149             {
150 60     60 0 89 my $self = shift;
151 60         82 my $offset = shift;
152              
153             # TODO - if Stream isn't enabled & reading from file, use seek
154              
155 60         82 my $buffer = '';
156 60         77 my $c = 1024 * 16;
157              
158 60         130 while ($offset > 0)
159             {
160 1178 100       1781 $c = length $offset
161             if length $offset < $c ;
162              
163 1178         1274 $offset -= $c;
164              
165 1178 50       1876 $self->smartReadExact(\$buffer, $c)
166             or return 0;
167             }
168              
169 60         131 return 1;
170             }
171              
172              
173             sub readHeader
174             {
175 1016     1016 0 1478 my $self = shift;
176 1016         1459 my $magic = shift ;
177              
178 1016         1845 my $name = *$self->{UnzipData}{Name} ;
179 1016         2518 my $hdr = $self->_readZipHeader($magic) ;
180              
181 1015         2715 while (defined $hdr)
182             {
183 1050 100 100     2804 if (! defined $name || $hdr->{Name} eq $name)
184             {
185 1013         3770 return $hdr ;
186             }
187              
188             # skip the data
189             # TODO - when Stream is off, use seek
190 37         49 my $buffer;
191 37 100       81 if (*$self->{ZipData}{Streaming}) {
192 11         17 while (1) {
193              
194 12         18 my $b;
195 12         48 my $status = $self->smartRead(\$b, 1024 * 16);
196              
197 12 50       33 return $self->saveErrorString(undef, "Truncated file")
198             if $status <= 0 ;
199              
200 12         19 my $temp_buf ;
201             my $out;
202              
203 12         52 $status = *$self->{Uncomp}->uncompr(\$b, \$temp_buf, 0, $out);
204              
205             return $self->saveErrorString(undef, *$self->{Uncomp}{Error},
206             *$self->{Uncomp}{ErrorNo})
207 12 50       54 if $self->saveStatus($status) == STATUS_ERROR;
208              
209 12         38 $self->pushBack($b) ;
210              
211 12 100       31 if ($status == STATUS_ENDSTREAM) {
212 11         44 *$self->{Uncomp}->reset();
213 11         20 last;
214             }
215             }
216              
217             # skip the trailer
218             $self->smartReadExact(\$buffer, $hdr->{TrailerLength})
219 11 50       34 or return $self->saveErrorString(undef, "Truncated file");
220             }
221             else {
222 26         73 my $c = $hdr->{CompressedLength}->get64bit();
223 26 50       60 $self->fastForward($c)
224             or return $self->saveErrorString(undef, "Truncated file");
225 26         38 $buffer = '';
226             }
227              
228 37 50       70 $self->chkTrailer($buffer) == STATUS_OK
229             or return $self->saveErrorString(undef, "Truncated file");
230              
231 37         82 $hdr = $self->_readFullZipHeader();
232              
233 37 50       118 return $self->saveErrorString(undef, "Cannot find '$name'")
234             if $self->smartEof();
235             }
236              
237 2         5 return undef;
238             }
239              
240             sub chkTrailer
241             {
242 1041     1041 0 1542 my $self = shift;
243 1041         1744 my $trailer = shift;
244              
245 1041         1557 my ($sig, $CRC32, $cSize, $uSize) ;
246 1041         1916 my ($cSizeHi, $uSizeHi) = (0, 0);
247 1041 100       2271 if (*$self->{ZipData}{Streaming}) {
248 939         2522 $sig = unpack ("V", substr($trailer, 0, 4));
249 939         1822 $CRC32 = unpack ("V", substr($trailer, 4, 4));
250              
251 939 100       2105 if (*$self->{ZipData}{Zip64} ) {
252 31         101 $cSize = U64::newUnpack_V64 substr($trailer, 8, 8);
253 31         96 $uSize = U64::newUnpack_V64 substr($trailer, 16, 8);
254             }
255             else {
256 908         2790 $cSize = U64::newUnpack_V32 substr($trailer, 8, 4);
257 908         2633 $uSize = U64::newUnpack_V32 substr($trailer, 12, 4);
258             }
259              
260 939 100       2300 return $self->TrailerError("Data Descriptor signature, got $sig")
261             if $sig != ZIP_DATA_HDR_SIG;
262             }
263             else {
264             ($CRC32, $cSize, $uSize) =
265             (*$self->{ZipData}{Crc32},
266             *$self->{ZipData}{CompressedLen},
267 102         290 *$self->{ZipData}{UnCompressedLen});
268             }
269              
270 1039         2110 *$self->{Info}{CRC32} = *$self->{ZipData}{CRC32} ;
271 1039         2308 *$self->{Info}{CompressedLength} = $cSize->get64bit();
272 1039         2095 *$self->{Info}{UncompressedLength} = $uSize->get64bit();
273              
274 1039 100       2292 if (*$self->{Strict}) {
275             return $self->TrailerError("CRC mismatch")
276 489 50       1021 if $CRC32 != *$self->{ZipData}{CRC32} ;
277              
278             return $self->TrailerError("CSIZE mismatch.")
279 489 50       1112 if ! $cSize->equal(*$self->{CompSize});
280              
281             return $self->TrailerError("USIZE mismatch.")
282 489 50       1167 if ! $uSize->equal(*$self->{UnCompSize});
283             }
284              
285 1039         1857 my $reachedEnd = STATUS_ERROR ;
286             # check for central directory or end of central directory
287 1039         1522 while (1)
288             {
289 2113         2549 my $magic ;
290 2113         4473 my $got = $self->smartRead(\$magic, 4);
291              
292             return $self->saveErrorString(STATUS_ERROR, "Truncated file")
293 2113 0 33     4206 if $got != 4 && *$self->{Strict};
294              
295 2113 50       5184 if ($got == 0) {
    50          
    50          
296 0         0 return STATUS_EOF ;
297             }
298             elsif ($got < 0) {
299 0         0 return STATUS_ERROR ;
300             }
301             elsif ($got < 4) {
302 0         0 $self->pushBack($magic) ;
303 0         0 return STATUS_OK ;
304             }
305              
306 2113         3553 my $sig = unpack("V", $magic) ;
307              
308 2113         2763 my $hdr;
309 2113 100       5443 if ($hdr = $headerLookup{$sig})
    50          
310             {
311 1725 50       3239 if (&$hdr($self, $magic) != STATUS_OK ) {
312 0 0       0 if (*$self->{Strict}) {
313 0         0 return STATUS_ERROR ;
314             }
315             else {
316 0         0 $self->clearError();
317 0         0 return STATUS_OK ;
318             }
319             }
320              
321 1725 100       3350 if ($sig == ZIP_END_CENTRAL_HDR_SIG)
322             {
323 651         2393 return STATUS_OK ;
324 0         0 last;
325             }
326             }
327             elsif ($sig == ZIP_LOCAL_HDR_SIG)
328             {
329 388         1308 $self->pushBack($magic) ;
330 388         1509 return STATUS_OK ;
331             }
332             else
333             {
334             # put the data back
335 0         0 $self->pushBack($magic) ;
336 0         0 last;
337             }
338             }
339              
340 0         0 return $reachedEnd ;
341             }
342              
343             sub skipCentralDirectory
344             {
345 1006     1006 0 1565 my $self = shift;
346 1006         1426 my $magic = shift ;
347              
348 1006         1188 my $buffer;
349 1006 50       2357 $self->smartReadExact(\$buffer, 46 - 4)
350             or return $self->TrailerError("Minimum header size is " .
351             46 . " bytes") ;
352              
353 1006         2286 my $keep = $magic . $buffer ;
354 1006         1709 *$self->{HeaderPending} = $keep ;
355              
356             #my $versionMadeBy = unpack ("v", substr($buffer, 4-4, 2));
357             #my $extractVersion = unpack ("v", substr($buffer, 6-4, 2));
358             #my $gpFlag = unpack ("v", substr($buffer, 8-4, 2));
359             #my $compressedMethod = unpack ("v", substr($buffer, 10-4, 2));
360             #my $lastModTime = unpack ("V", substr($buffer, 12-4, 4));
361             #my $crc32 = unpack ("V", substr($buffer, 16-4, 4));
362 1006         1945 my $compressedLength = unpack ("V", substr($buffer, 20-4, 4));
363 1006         1761 my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4));
364 1006         1875 my $filename_length = unpack ("v", substr($buffer, 28-4, 2));
365 1006         1814 my $extra_length = unpack ("v", substr($buffer, 30-4, 2));
366 1006         1626 my $comment_length = unpack ("v", substr($buffer, 32-4, 2));
367             #my $disk_start = unpack ("v", substr($buffer, 34-4, 2));
368             #my $int_file_attrib = unpack ("v", substr($buffer, 36-4, 2));
369             #my $ext_file_attrib = unpack ("V", substr($buffer, 38-4, 2));
370             #my $lcl_hdr_offset = unpack ("V", substr($buffer, 42-4, 2));
371              
372              
373 1006         2322 my $filename;
374             my $extraField;
375 1006         0 my $comment ;
376 1006 100       1939 if ($filename_length)
377             {
378 240 50       658 $self->smartReadExact(\$filename, $filename_length)
379             or return $self->TruncatedTrailer("filename");
380 240         489 $keep .= $filename ;
381             }
382              
383 1006 100       1790 if ($extra_length)
384             {
385 166 50       359 $self->smartReadExact(\$extraField, $extra_length)
386             or return $self->TruncatedTrailer("extra");
387 166         283 $keep .= $extraField ;
388             }
389              
390 1006 100       1755 if ($comment_length)
391             {
392 1 50       5 $self->smartReadExact(\$comment, $comment_length)
393             or return $self->TruncatedTrailer("comment");
394 1         2 $keep .= $comment ;
395             }
396              
397 1006         2209 return STATUS_OK ;
398             }
399              
400             sub skipArchiveExtra
401             {
402 0     0 0 0 my $self = shift;
403 0         0 my $magic = shift ;
404              
405 0         0 my $buffer;
406 0 0       0 $self->smartReadExact(\$buffer, 4)
407             or return $self->TrailerError("Minimum header size is " .
408             4 . " bytes") ;
409              
410 0         0 my $keep = $magic . $buffer ;
411              
412 0         0 my $size = unpack ("V", $buffer);
413              
414 0 0       0 $self->smartReadExact(\$buffer, $size)
415             or return $self->TrailerError("Minimum header size is " .
416             $size . " bytes") ;
417              
418 0         0 $keep .= $buffer ;
419 0         0 *$self->{HeaderPending} = $keep ;
420              
421 0         0 return STATUS_OK ;
422             }
423              
424              
425             sub skipCentralDirectory64Rec
426             {
427 34     34 0 52 my $self = shift;
428 34         51 my $magic = shift ;
429              
430 34         47 my $buffer;
431 34 50       76 $self->smartReadExact(\$buffer, 8)
432             or return $self->TrailerError("Minimum header size is " .
433             8 . " bytes") ;
434              
435 34         367 my $keep = $magic . $buffer ;
436              
437 34         78 my ($sizeLo, $sizeHi) = unpack ("V V", $buffer);
438 34         77 my $size = $sizeHi * U64::MAX32 + $sizeLo;
439              
440 34 50       94 $self->fastForward($size)
441             or return $self->TrailerError("Minimum header size is " .
442             $size . " bytes") ;
443              
444             #$keep .= $buffer ;
445             #*$self->{HeaderPending} = $keep ;
446              
447             #my $versionMadeBy = unpack ("v", substr($buffer, 0, 2));
448             #my $extractVersion = unpack ("v", substr($buffer, 2, 2));
449             #my $diskNumber = unpack ("V", substr($buffer, 4, 4));
450             #my $cntrlDirDiskNo = unpack ("V", substr($buffer, 8, 4));
451             #my $entriesInThisCD = unpack ("V V", substr($buffer, 12, 8));
452             #my $entriesInCD = unpack ("V V", substr($buffer, 20, 8));
453             #my $sizeOfCD = unpack ("V V", substr($buffer, 28, 8));
454             #my $offsetToCD = unpack ("V V", substr($buffer, 36, 8));
455              
456 34         73 return STATUS_OK ;
457             }
458              
459             sub skipCentralDirectory64Loc
460             {
461 34     34 0 48 my $self = shift;
462 34         49 my $magic = shift ;
463              
464 34         40 my $buffer;
465 34 50       85 $self->smartReadExact(\$buffer, 20 - 4)
466             or return $self->TrailerError("Minimum header size is " .
467             20 . " bytes") ;
468              
469 34         79 my $keep = $magic . $buffer ;
470 34         66 *$self->{HeaderPending} = $keep ;
471              
472             #my $startCdDisk = unpack ("V", substr($buffer, 4-4, 4));
473             #my $offsetToCD = unpack ("V V", substr($buffer, 8-4, 8));
474             #my $diskCount = unpack ("V", substr($buffer, 16-4, 4));
475              
476 34         62 return STATUS_OK ;
477             }
478              
479             sub skipEndCentralDirectory
480             {
481 651     651 0 930 my $self = shift;
482 651         888 my $magic = shift ;
483              
484              
485 651         824 my $buffer;
486 651 50       1463 $self->smartReadExact(\$buffer, 22 - 4)
487             or return $self->TrailerError("Minimum header size is " .
488             22 . " bytes") ;
489              
490 651         1464 my $keep = $magic . $buffer ;
491 651         1253 *$self->{HeaderPending} = $keep ;
492              
493             #my $diskNumber = unpack ("v", substr($buffer, 4-4, 2));
494             #my $cntrlDirDiskNo = unpack ("v", substr($buffer, 6-4, 2));
495             #my $entriesInThisCD = unpack ("v", substr($buffer, 8-4, 2));
496             #my $entriesInCD = unpack ("v", substr($buffer, 10-4, 2));
497             #my $sizeOfCD = unpack ("V", substr($buffer, 12-4, 4));
498             #my $offsetToCD = unpack ("V", substr($buffer, 16-4, 4));
499 651         1340 my $comment_length = unpack ("v", substr($buffer, 20-4, 2));
500              
501              
502 651         862 my $comment ;
503 651 50       1211 if ($comment_length)
504             {
505 0 0       0 $self->smartReadExact(\$comment, $comment_length)
506             or return $self->TruncatedTrailer("comment");
507 0         0 $keep .= $comment ;
508             }
509              
510 651         1341 return STATUS_OK ;
511             }
512              
513              
514             sub _isZipMagic
515             {
516 1377     1377   2228 my $buffer = shift ;
517 1377 50       2608 return 0 if length $buffer < 4 ;
518 1377         3418 my $sig = unpack("V", $buffer) ;
519 1377         3926 return $sig == ZIP_LOCAL_HDR_SIG ;
520             }
521              
522              
523             sub _readFullZipHeader($)
524             {
525 37     37   56 my ($self) = @_ ;
526 37         47 my $magic = '' ;
527              
528 37         86 $self->smartReadExact(\$magic, 4);
529              
530 37         68 *$self->{HeaderPending} = $magic ;
531              
532 37 50       67 return $self->HeaderError("Minimum header size is " .
533             30 . " bytes")
534             if length $magic != 4 ;
535              
536              
537 37 50       70 return $self->HeaderError("Bad Magic")
538             if ! _isZipMagic($magic) ;
539              
540 37         78 my $status = $self->_readZipHeader($magic);
541 37 50       81 delete *$self->{Transparent} if ! defined $status ;
542 37         159 return $status ;
543             }
544              
545             sub _readZipHeader($)
546             {
547 1053     1053   1944 my ($self, $magic) = @_ ;
548 1053         1364 my ($HeaderCRC) ;
549 1053         1570 my ($buffer) = '' ;
550              
551 1053 50       2441 $self->smartReadExact(\$buffer, 30 - 4)
552             or return $self->HeaderError("Minimum header size is " .
553             30 . " bytes") ;
554              
555 1053         2587 my $keep = $magic . $buffer ;
556 1053         1780 *$self->{HeaderPending} = $keep ;
557              
558 1053         2483 my $extractVersion = unpack ("v", substr($buffer, 4-4, 2));
559 1053         1943 my $gpFlag = unpack ("v", substr($buffer, 6-4, 2));
560 1053         1881 my $compressedMethod = unpack ("v", substr($buffer, 8-4, 2));
561 1053         2034 my $lastModTime = unpack ("V", substr($buffer, 10-4, 4));
562 1053         1767 my $crc32 = unpack ("V", substr($buffer, 14-4, 4));
563 1053         3706 my $compressedLength = U64::newUnpack_V32 substr($buffer, 18-4, 4);
564 1053         3060 my $uncompressedLength = U64::newUnpack_V32 substr($buffer, 22-4, 4);
565 1053         2467 my $filename_length = unpack ("v", substr($buffer, 26-4, 2));
566 1053         1767 my $extra_length = unpack ("v", substr($buffer, 28-4, 2));
567              
568 1053         1593 my $filename;
569             my $extraField;
570 1053         1604 my @EXTRA = ();
571              
572             # Some programs (some versions of LibreOffice) mark entries as streamed, but still fill out
573             # compressedLength/uncompressedLength & crc32 in the local file header.
574             # The expected data descriptor is not populated.
575             # So only assume streaming if the Streaming bit is set AND the compressed length is zero
576 1053 100 100     3923 my $streamingMode = (($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) && $crc32 == 0) ? 1 : 0 ;
577              
578 1053 100       1923 my $efs_flag = ($gpFlag & ZIP_GP_FLAG_LANGUAGE_ENCODING) ? 1 : 0;
579              
580 1053 100       1994 return $self->HeaderError("Encrypted content not supported")
581             if $gpFlag & (ZIP_GP_FLAG_ENCRYPTED_MASK|ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK);
582              
583 1051 50       1925 return $self->HeaderError("Patch content not supported")
584             if $gpFlag & ZIP_GP_FLAG_PATCHED_MASK;
585              
586 1051         2446 *$self->{ZipData}{Streaming} = $streamingMode;
587              
588              
589 1051 100       1980 if ($filename_length)
590             {
591 276 50       719 $self->smartReadExact(\$filename, $filename_length)
592             or return $self->TruncatedHeader("Filename");
593              
594 276 50 66     819 if (*$self->{UnzipData}{efs} && $efs_flag && $] >= 5.008004)
      66        
595             {
596 5         31 require Encode;
597 5 100       7 eval { $filename = Encode::decode_utf8($filename, 1) }
  5         16  
598             or Carp::croak "Zip Filename not UTF-8" ;
599             }
600              
601 275         795 $keep .= $filename ;
602             }
603              
604 1050         1457 my $zip64 = 0 ;
605              
606 1050 100       2296 if ($extra_length)
607             {
608 197 50       523 $self->smartReadExact(\$extraField, $extra_length)
609             or return $self->TruncatedHeader("Extra Field");
610              
611 197         692 my $bad = IO::Compress::Zlib::Extra::parseRawExtra($extraField,
612             \@EXTRA, 1, 0);
613 197 50       370 return $self->HeaderError($bad)
614             if defined $bad;
615              
616 197         400 $keep .= $extraField ;
617              
618 197         262 my %Extra ;
619 197         356 for (@EXTRA)
620             {
621 400         852 $Extra{$_->[0]} = \$_->[1];
622             }
623              
624 197 100       536 if (defined $Extra{ZIP_EXTRA_ID_ZIP64()})
625             {
626 47         68 $zip64 = 1 ;
627              
628 47         63 my $buff = ${ $Extra{ZIP_EXTRA_ID_ZIP64()} };
  47         86  
629              
630             # This code assumes that all the fields in the Zip64
631             # extra field aren't necessarily present. The spec says that
632             # they only exist if the equivalent local headers are -1.
633              
634 47 100       126 if (! $streamingMode) {
635 16         20 my $offset = 0 ;
636              
637 16 50       37 if (U64::full32 $uncompressedLength->get32bit() ) {
638 16         47 $uncompressedLength
639             = U64::newUnpack_V64 substr($buff, 0, 8);
640              
641 16         46 $offset += 8 ;
642             }
643              
644 16 50       36 if (U64::full32 $compressedLength->get32bit() ) {
645              
646 16         37 $compressedLength
647             = U64::newUnpack_V64 substr($buff, $offset, 8);
648              
649 16         40 $offset += 8 ;
650             }
651             }
652             }
653             }
654              
655 1050         2115 *$self->{ZipData}{Zip64} = $zip64;
656              
657 1050 100       2009 if (! $streamingMode) {
658 108         184 *$self->{ZipData}{Streaming} = 0;
659 108         268 *$self->{ZipData}{Crc32} = $crc32;
660 108         278 *$self->{ZipData}{CompressedLen} = $compressedLength;
661 108         221 *$self->{ZipData}{UnCompressedLen} = $uncompressedLength;
662             *$self->{CompressedInputLengthRemaining} =
663 108         357 *$self->{CompressedInputLength} = $compressedLength->get64bit();
664             }
665              
666 1050         3810 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
667 1050         2221 *$self->{ZipData}{Method} = $compressedMethod;
668 1050 100       2253 if ($compressedMethod == ZIP_CM_DEFLATE)
    100          
    50          
    50          
    50          
    50          
669             {
670 943         1737 *$self->{Type} = 'zip-deflate';
671 943         2964 my $obj = IO::Uncompress::Adapter::Inflate::mkUncompObject(1,0,0);
672              
673 943         3605 *$self->{Uncomp} = $obj;
674             }
675             elsif ($compressedMethod == ZIP_CM_BZIP2)
676             {
677 32 50       88 return $self->HeaderError("Unsupported Compression format $compressedMethod")
678             if ! defined $IO::Uncompress::Adapter::Bunzip2::VERSION ;
679              
680 32         80 *$self->{Type} = 'zip-bzip2';
681              
682 32         141 my $obj = IO::Uncompress::Adapter::Bunzip2::mkUncompObject();
683              
684 32         117 *$self->{Uncomp} = $obj;
685             }
686             elsif ($compressedMethod == ZIP_CM_XZ)
687             {
688 0 0       0 return $self->HeaderError("Unsupported Compression format $compressedMethod")
689             if ! defined $IO::Uncompress::Adapter::UnXz::VERSION ;
690              
691 0         0 *$self->{Type} = 'zip-xz';
692              
693 0         0 my $obj = IO::Uncompress::Adapter::UnXz::mkUncompObject();
694              
695 0         0 *$self->{Uncomp} = $obj;
696             }
697             elsif ($compressedMethod == ZIP_CM_ZSTD)
698             {
699 0 0       0 return $self->HeaderError("Unsupported Compression format $compressedMethod")
700             if ! defined $IO::Uncompress::Adapter::UnZstd::VERSION ;
701              
702 0         0 *$self->{Type} = 'zip-zstd';
703              
704 0         0 my $obj = IO::Uncompress::Adapter::UnZstd::mkUncompObject();
705              
706 0         0 *$self->{Uncomp} = $obj;
707             }
708             elsif ($compressedMethod == ZIP_CM_LZMA)
709             {
710 0 0       0 return $self->HeaderError("Unsupported Compression format $compressedMethod")
711             if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ;
712              
713 0         0 *$self->{Type} = 'zip-lzma';
714 0         0 my $LzmaHeader;
715 0 0       0 $self->smartReadExact(\$LzmaHeader, 4)
716             or return $self->saveErrorString(undef, "Truncated file");
717 0         0 my ($verHi, $verLo) = unpack ("CC", substr($LzmaHeader, 0, 2));
718 0         0 my $LzmaPropertiesSize = unpack ("v", substr($LzmaHeader, 2, 2));
719              
720              
721 0         0 my $LzmaPropertyData;
722 0 0       0 $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize)
723             or return $self->saveErrorString(undef, "Truncated file");
724              
725 0 0       0 if (! $streamingMode) {
726 0         0 *$self->{ZipData}{CompressedLen}->subtract(4 + $LzmaPropertiesSize) ;
727             *$self->{CompressedInputLengthRemaining} =
728 0         0 *$self->{CompressedInputLength} = *$self->{ZipData}{CompressedLen}->get64bit();
729             }
730              
731 0         0 my $obj =
732             IO::Uncompress::Adapter::UnLzma::mkUncompZipObject($LzmaPropertyData);
733              
734 0         0 *$self->{Uncomp} = $obj;
735             }
736             elsif ($compressedMethod == ZIP_CM_STORE)
737             {
738 75         156 *$self->{Type} = 'zip-stored';
739              
740 75         256 my $obj =
741             IO::Uncompress::Adapter::Identity::mkUncompObject($streamingMode,
742             $zip64);
743              
744 75         269 *$self->{Uncomp} = $obj;
745             }
746             else
747             {
748 0         0 return $self->HeaderError("Unsupported Compression format $compressedMethod");
749             }
750              
751             return {
752             'Type' => 'zip',
753             'FingerprintLength' => 4,
754             #'HeaderLength' => $compressedMethod == 8 ? length $keep : 0,
755             'HeaderLength' => length $keep,
756             'Zip64' => $zip64,
757             'TrailerLength' => ! $streamingMode ? 0 : $zip64 ? 24 : 16,
758             'Header' => $keep,
759             'CompressedLength' => $compressedLength ,
760             'UncompressedLength' => $uncompressedLength ,
761             'CRC32' => $crc32 ,
762             'Name' => $filename,
763             'efs' => $efs_flag, # language encoding flag
764             'Time' => _dosToUnixTime($lastModTime),
765             'Stream' => $streamingMode,
766              
767             'MethodID' => $compressedMethod,
768 1050 100 50     4493 'MethodName' => $MethodNames{$compressedMethod} || 'Unknown',
    100          
769              
770             # 'TextFlag' => $flag & GZIP_FLG_FTEXT ? 1 : 0,
771             # 'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
772             # 'NameFlag' => $flag & GZIP_FLG_FNAME ? 1 : 0,
773             # 'CommentFlag' => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
774             # 'ExtraFlag' => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
775             # 'Comment' => $comment,
776             # 'OsID' => $os,
777             # 'OsName' => defined $GZIP_OS_Names{$os}
778             # ? $GZIP_OS_Names{$os} : "Unknown",
779             # 'HeaderCRC' => $HeaderCRC,
780             # 'Flags' => $flag,
781             # 'ExtraFlags' => $xfl,
782             'ExtraFieldRaw' => $extraField,
783             'ExtraField' => [ @EXTRA ],
784              
785              
786             }
787             }
788              
789             sub filterUncompressed
790             {
791 1220     1220 0 1840 my $self = shift ;
792              
793 1220 100       2785 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
794 1125         2924 *$self->{ZipData}{CRC32} = *$self->{Uncomp}->crc32() ;
795             }
796             else {
797 95         128 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}, $_[1]);
  95         447  
798             }
799             }
800              
801              
802             # from Archive::Zip & info-zip
803             sub _dosToUnixTime
804             {
805 1050     1050   1576 my $dt = shift;
806              
807 1050         1901 my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
808 1050         1590 my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
809 1050         1526 my $mday = ( ( $dt >> 16 ) & 0x1f );
810              
811 1050         1335 my $hour = ( ( $dt >> 11 ) & 0x1f );
812 1050         1373 my $min = ( ( $dt >> 5 ) & 0x3f );
813 1050         1588 my $sec = ( ( $dt << 1 ) & 0x3e );
814              
815 83     83   37177 use Time::Local ;
  83         125443  
  83         10417  
816 1050         3252 my $time_t = Time::Local::timelocal( $sec, $min, $hour, $mday, $mon, $year);
817 1050 50       68151 return 0 if ! defined $time_t;
818 1050         15028 return $time_t;
819              
820             }
821              
822             #sub scanCentralDirectory
823             #{
824             # # Use cases
825             # # 1 32-bit CD
826             # # 2 64-bit CD
827             #
828             # my $self = shift ;
829             #
830             # my @CD = ();
831             # my $offset = $self->findCentralDirectoryOffset();
832             #
833             # return 0
834             # if ! defined $offset;
835             #
836             # $self->smarkSeek($offset, 0, SEEK_SET) ;
837             #
838             # # Now walk the Central Directory Records
839             # my $buffer ;
840             # while ($self->smartReadExact(\$buffer, 46) &&
841             # unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
842             #
843             # my $compressedLength = unpack ("V", substr($buffer, 20, 4));
844             # my $filename_length = unpack ("v", substr($buffer, 28, 2));
845             # my $extra_length = unpack ("v", substr($buffer, 30, 2));
846             # my $comment_length = unpack ("v", substr($buffer, 32, 2));
847             #
848             # $self->smarkSeek($filename_length + $extra_length + $comment_length, 0, SEEK_CUR)
849             # if $extra_length || $comment_length || $filename_length;
850             # push @CD, $compressedLength ;
851             # }
852             #
853             #}
854             #
855             #sub findCentralDirectoryOffset
856             #{
857             # my $self = shift ;
858             #
859             # # Most common use-case is where there is no comment, so
860             # # know exactly where the end of central directory record
861             # # should be.
862             #
863             # $self->smarkSeek(-22, 0, SEEK_END) ;
864             #
865             # my $buffer;
866             # $self->smartReadExact(\$buffer, 22) ;
867             #
868             # my $zip64 = 0;
869             # my $centralDirOffset ;
870             # if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
871             # $centralDirOffset = unpack ("V", substr($buffer, 16, 2));
872             # }
873             # else {
874             # die "xxxx";
875             # }
876             #
877             # return $centralDirOffset ;
878             #}
879             #
880             #sub is84BitCD
881             #{
882             # # TODO
883             # my $self = shift ;
884             #}
885              
886              
887             sub skip
888             {
889 0     0 0   my $self = shift;
890 0           my $size = shift;
891              
892 83     83   617 use Fcntl qw(SEEK_CUR);
  83         167  
  83         52234  
893 0 0         if (ref $size eq 'U64') {
894 0           $self->smartSeek($size->get64bit(), SEEK_CUR);
895             }
896             else {
897 0           $self->smartSeek($size, SEEK_CUR);
898             }
899              
900             }
901              
902              
903             sub scanCentralDirectory
904             {
905 0     0 0   my $self = shift;
906              
907 0           my $here = $self->tell();
908              
909             # Use cases
910             # 1 32-bit CD
911             # 2 64-bit CD
912              
913 0           my @CD = ();
914 0           my $offset = $self->findCentralDirectoryOffset();
915              
916             return ()
917 0 0         if ! defined $offset;
918              
919 0           $self->smarkSeek($offset, 0, SEEK_SET) ;
920              
921             # Now walk the Central Directory Records
922 0           my $buffer ;
923 0   0       while ($self->smartReadExact(\$buffer, 46) &&
924             unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
925              
926 0           my $compressedLength = unpack("V", substr($buffer, 20, 4));
927 0           my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
928 0           my $filename_length = unpack("v", substr($buffer, 28, 2));
929 0           my $extra_length = unpack("v", substr($buffer, 30, 2));
930 0           my $comment_length = unpack("v", substr($buffer, 32, 2));
931              
932 0           $self->skip($filename_length ) ;
933              
934 0           my $v64 = U64->new( $compressedLength );
935              
936 0 0         if (U64::full32 $compressedLength ) {
937 0           $self->smartReadExact(\$buffer, $extra_length) ;
938 0 0         die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer)
939             if length($buffer) != $extra_length;
940 0           my $got = $self->get64Extra($buffer, U64::full32 $uncompressedLength);
941              
942             # If not Zip64 extra field, assume size is 0xFFFFFFFF
943 0 0         $v64 = $got if defined $got;
944             }
945             else {
946 0           $self->skip($extra_length) ;
947             }
948              
949 0           $self->skip($comment_length ) ;
950              
951 0           push @CD, $v64 ;
952             }
953              
954 0           $self->smartSeek($here, 0, SEEK_SET) ;
955              
956 0           return @CD;
957             }
958              
959             sub get64Extra
960             {
961 0     0 0   my $self = shift ;
962              
963 0           my $buffer = shift;
964 0           my $is_uncomp = shift ;
965              
966 0           my $extra = IO::Compress::Zlib::Extra::findID(0x0001, $buffer);
967              
968 0 0         if (! defined $extra)
969             {
970 0           return undef;
971             }
972             else
973             {
974 0 0         my $u64 = U64::newUnpack_V64(substr($extra, $is_uncomp ? 8 : 0)) ;
975 0           return $u64;
976             }
977             }
978              
979             sub offsetFromZip64
980             {
981 0     0 0   my $self = shift ;
982 0           my $here = shift;
983              
984 0 0         $self->smartSeek($here - 20, 0, SEEK_SET)
985             or die "xx $!" ;
986              
987 0           my $buffer;
988 0           my $got = 0;
989 0 0         $self->smartReadExact(\$buffer, 20)
990             or die "xxx $here $got $!" ;
991              
992 0 0         if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
993 0           my $cd64 = U64::Value_VV64 substr($buffer, 8, 8);
994              
995 0           $self->smartSeek($cd64, 0, SEEK_SET) ;
996              
997 0 0         $self->smartReadExact(\$buffer, 4)
998             or die "xxx" ;
999              
1000 0 0         if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {
1001              
1002 0 0         $self->smartReadExact(\$buffer, 8)
1003             or die "xxx" ;
1004 0           my $size = U64::Value_VV64($buffer);
1005 0 0         $self->smartReadExact(\$buffer, $size)
1006             or die "xxx" ;
1007              
1008 0           my $cd64 = U64::Value_VV64 substr($buffer, 36, 8);
1009              
1010 0           return $cd64 ;
1011             }
1012              
1013 0           die "zzz";
1014             }
1015              
1016 0           die "zzz";
1017             }
1018              
1019 83     83   607 use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);
  83         188  
  83         24783  
1020              
1021             sub findCentralDirectoryOffset
1022             {
1023 0     0 0   my $self = shift ;
1024              
1025             # Most common use-case is where there is no comment, so
1026             # know exactly where the end of central directory record
1027             # should be.
1028              
1029 0           $self->smartSeek(-22, 0, SEEK_END) ;
1030 0           my $here = $self->tell();
1031              
1032 0           my $buffer;
1033 0 0         $self->smartReadExact(\$buffer, 22)
1034             or die "xxx" ;
1035              
1036 0           my $zip64 = 0;
1037 0           my $centralDirOffset ;
1038 0 0         if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
1039 0           $centralDirOffset = unpack("V", substr($buffer, 16, 4));
1040             }
1041             else {
1042 0           $self->smartSeek(0, 0, SEEK_END) ;
1043              
1044 0           my $fileLen = $self->tell();
1045 0           my $want = 0 ;
1046              
1047 0           while(1) {
1048 0           $want += 1024;
1049 0           my $seekTo = $fileLen - $want;
1050 0 0         if ($seekTo < 0 ) {
1051 0           $seekTo = 0;
1052 0           $want = $fileLen ;
1053             }
1054 0 0         $self->smartSeek( $seekTo, 0, SEEK_SET)
1055             or die "xxx $!" ;
1056 0           my $got;
1057 0 0         $self->smartReadExact($buffer, $want)
1058             or die "xxx " ;
1059 0           my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);
1060              
1061 0 0         if ($pos >= 0) {
1062             #$here = $self->tell();
1063 0           $here = $seekTo + $pos ;
1064 0           $centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4));
1065 0           last ;
1066             }
1067              
1068             return undef
1069 0 0         if $want == $fileLen;
1070             }
1071             }
1072              
1073 0 0         $centralDirOffset = $self->offsetFromZip64($here)
1074             if U64::full32 $centralDirOffset ;
1075              
1076 0           return $centralDirOffset ;
1077             }
1078              
1079             1;
1080              
1081             __END__