1#!/usr/bin/perl
2
3# zipdetails
4#
5# Display info on the contents of a Zip file
6#
7
8BEGIN { pop @INC if $INC[-1] eq '.' }
9use strict;
10use warnings ;
11
12use IO::File;
13use Encode;
14
15# Compression types
16use constant ZIP_CM_STORE                      => 0 ;
17use constant ZIP_CM_IMPLODE                    => 6 ;
18use constant ZIP_CM_DEFLATE                    => 8 ;
19use constant ZIP_CM_BZIP2                      => 12 ;
20use constant ZIP_CM_LZMA                       => 14 ;
21use constant ZIP_CM_PPMD                       => 98 ;
22
23# General Purpose Flag
24use constant ZIP_GP_FLAG_ENCRYPTED_MASK        => (1 << 0) ;
25use constant ZIP_GP_FLAG_STREAMING_MASK        => (1 << 3) ;
26use constant ZIP_GP_FLAG_PATCHED_MASK          => (1 << 5) ;
27use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ;
28use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT      => (1 << 1) ;
29use constant ZIP_GP_FLAG_LANGUAGE_ENCODING     => (1 << 11) ;
30
31# Internal File Attributes
32use constant ZIP_IFA_TEXT_MASK                 => 1;
33
34# Signatures for each of the headers
35use constant ZIP_LOCAL_HDR_SIG                 => 0x04034b50;
36use constant ZIP_DATA_HDR_SIG                  => 0x08074b50;
37use constant ZIP_CENTRAL_HDR_SIG               => 0x02014b50;
38use constant ZIP_END_CENTRAL_HDR_SIG           => 0x06054b50;
39use constant ZIP64_END_CENTRAL_REC_HDR_SIG     => 0x06064b50;
40use constant ZIP64_END_CENTRAL_LOC_HDR_SIG     => 0x07064b50;
41use constant ZIP64_ARCHIVE_EXTRA_SIG           => 0x08064b50;
42use constant ZIP64_DIGITAL_SIGNATURE_SIG       => 0x05054b50;
43
44use constant ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG => 0x08064b50;
45
46# Extra sizes
47use constant ZIP_EXTRA_HEADER_SIZE          => 2 ;
48use constant ZIP_EXTRA_MAX_SIZE             => 0xFFFF ;
49use constant ZIP_EXTRA_SUBFIELD_ID_SIZE     => 2 ;
50use constant ZIP_EXTRA_SUBFIELD_LEN_SIZE    => 2 ;
51use constant ZIP_EXTRA_SUBFIELD_HEADER_SIZE => ZIP_EXTRA_SUBFIELD_ID_SIZE +
52                                               ZIP_EXTRA_SUBFIELD_LEN_SIZE;
53use constant ZIP_EXTRA_SUBFIELD_MAX_SIZE    => ZIP_EXTRA_MAX_SIZE -
54                                               ZIP_EXTRA_SUBFIELD_HEADER_SIZE;
55
56my %ZIP_CompressionMethods =
57    (
58          0 => 'Stored',
59          1 => 'Shrunk',
60          2 => 'Reduced compression factor 1',
61          3 => 'Reduced compression factor 2',
62          4 => 'Reduced compression factor 3',
63          5 => 'Reduced compression factor 4',
64          6 => 'Imploded',
65          7 => 'Reserved for Tokenizing compression algorithm',
66          8 => 'Deflated',
67          9 => 'Enhanced Deflating using Deflate64(tm)',
68         10 => 'PKWARE Data Compression Library Imploding',
69         11 => 'Reserved by PKWARE',
70         12 => 'BZIP2 ',
71         13 => 'Reserved by PKWARE',
72         14 => 'LZMA',
73         15 => 'Reserved by PKWARE',
74         16 => 'Reserved by PKWARE',
75         17 => 'Reserved by PKWARE',
76         18 => 'File is compressed using IBM TERSE (new)',
77         19 => 'IBM LZ77 z Architecture (PFS)',
78         95 => 'XZ',
79         96 => 'WinZip JPEG Compression',
80         97 => 'WavPack compressed data',
81         98 => 'PPMd version I, Rev 1',
82         99 => 'AES Encryption',
83     );
84
85my %OS_Lookup = (
86    0   => "MS-DOS",
87    1   => "Amiga",
88    2   => "OpenVMS",
89    3   => "Unix",
90    4   => "VM/CMS",
91    5   => "Atari ST",
92    6   => "HPFS (OS/2, NT 3.x)",
93    7   => "Macintosh",
94    8   => "Z-System",
95    9   => "CP/M",
96    10  => "Windoxs NTFS or TOPS-20",
97    11  => "MVS or NTFS",
98    12  => "VSE or SMS/QDOS",
99    13  => "Acorn RISC OS",
100    14  => "VFAT",
101    15  => "alternate MVS",
102    16  => "BeOS",
103    17  => "Tandem",
104    18  => "OS/400",
105    19  => "OS/X (Darwin)",
106    30  => "AtheOS/Syllable",
107    );
108
109
110my %Lookup = (
111    ZIP_LOCAL_HDR_SIG,             \&LocalHeader,
112    ZIP_DATA_HDR_SIG,              \&DataHeader,
113    ZIP_CENTRAL_HDR_SIG,           \&CentralHeader,
114    ZIP_END_CENTRAL_HDR_SIG,       \&EndCentralHeader,
115    ZIP64_END_CENTRAL_REC_HDR_SIG, \&Zip64EndCentralHeader,
116    ZIP64_END_CENTRAL_LOC_HDR_SIG, \&Zip64EndCentralLocator,
117
118    # TODO - Archive Encryption Headers
119    #ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG
120);
121
122my %Extras = (
123      0x0001,  ['ZIP64', \&decode_Zip64],
124      0x0007,  ['AV Info', undef],
125      0x0008,  ['Extended Language Encoding', undef],
126      0x0009,  ['OS/2 extended attributes', undef],
127      0x000a,  ['NTFS FileTimes', \&decode_NTFS_Filetimes],
128      0x000c,  ['OpenVMS', undef],
129      0x000d,  ['Unix', undef],
130      0x000e,  ['Stream & Fork Descriptors', undef],
131      0x000f,  ['Patch Descriptor', undef],
132      0x0014,  ['PKCS#7 Store for X.509 Certificates', undef],
133      0x0015,  ['X.509 Certificate ID and Signature for individual file', undef],
134      0x0016,  ['X.509 Certificate ID for Central Directory', undef],
135      0x0017,  ['Strong Encryption Header', undef],
136      0x0018,  ['Record Management Controls', undef],
137      0x0019,  ['PKCS#7 Encryption Recipient Certificate List', undef],
138
139
140      # The Header ID mappings defined by Info-ZIP and third parties are:
141
142      0x0065,  ['IBM S/390 attributes - uncompressed', \&decodeMVS],
143      0x0066,  ['IBM S/390 attributes - compressed', undef],
144      0x07c8,  ['Info-ZIP Macintosh (old, J. Lee)', undef],
145      0x2605,  ['ZipIt Macintosh (first version)', undef],
146      0x2705,  ['ZipIt Macintosh v 1.3.5 and newer (w/o full filename)', undef],
147      0x2805,  ['ZipIt Macintosh v 1.3.5 and newer ', undef],
148      0x334d,  ["Info-ZIP Macintosh (new, D. Haase's 'Mac3' field)", undef],
149      0x4154,  ['Tandem NSK', undef],
150      0x4341,  ['Acorn/SparkFS (David Pilling)', undef],
151      0x4453,  ['Windows NT security descriptor', \&decode_NT_security],
152      0x4690,  ['POSZIP 4690', undef],
153      0x4704,  ['VM/CMS', undef],
154      0x470f,  ['MVS', undef],
155      0x4854,  ['Theos, old inofficial port', undef],
156      0x4b46,  ['FWKCS MD5 (see below)', undef],
157      0x4c41,  ['OS/2 access control list (text ACL)', undef],
158      0x4d49,  ['Info-ZIP OpenVMS (obsolete)', undef],
159      0x4d63,  ['Macintosh SmartZIP, by Macro Bambini', undef],
160      0x4f4c,  ['Xceed original location extra field', undef],
161      0x5356,  ['AOS/VS (binary ACL)', undef],
162      0x5455,  ['Extended Timestamp', \&decode_UT],
163      0x554e,  ['Xceed unicode extra field', \&decode_Xceed_unicode],
164      0x5855,  ['Info-ZIP Unix (original; also OS/2, NT, etc.)', \&decode_UX],
165      0x5a4c,  ['ZipArchive Unicode Filename', undef],
166      0x5a4d,  ['ZipArchive Offsets Array', undef],
167      0x6375,  ['Info-ZIP Unicode Comment', \&decode_up ],
168      0x6542,  ['BeOS (BeBox, PowerMac, etc.)', undef],
169      0x6854,  ['Theos', undef],
170      0x7075,  ['Info-ZIP Unicode Path', \&decode_up ],
171      0x756e,  ['ASi Unix', undef],
172      0x7441,  ['AtheOS (AtheOS/Syllable attributes)', undef],
173      0x7855,  ['Unix Extra type 2', \&decode_Ux],
174      0x7875,  ['Unix Extra Type 3', \&decode_ux],
175      0x9901,  ['AES Encryption', \&decode_AES],
176      0xa11e,  ['Data Stream Alignment', undef],
177      0xA220,  ['Open Packaging Growth Hint', undef ],
178      0xCAFE,  ['Java Executable', \&decode_Java_exe],
179      0xfb4a,  ['SMS/QDOS', undef],
180
181       );
182
183my $VERSION = "1.11" ;
184
185my $FH;
186
187my $ZIP64 = 0 ;
188my $NIBBLES = 8;
189my $LocalHeaderCount = 0;
190my $CentralHeaderCount = 0;
191
192my $START;
193my $OFFSET = new U64 0;
194my $TRAILING = 0 ;
195my $PAYLOADLIMIT = 256; #new U64 256;
196my $ZERO = new U64 0 ;
197
198sub prOff
199{
200    my $offset = shift;
201    my $s = offset($OFFSET);
202    $OFFSET->add($offset);
203    return $s;
204}
205
206sub offset
207{
208    my $v = shift ;
209
210    if (ref $v eq 'U64') {
211        my $hi = $v->getHigh();
212        my $lo = $v->getLow();
213
214        if ($hi)
215        {
216            my $hiNib = $NIBBLES - 8 ;
217            sprintf("%0${hiNib}X", $hi) .
218            sprintf("%08X", $lo);
219        }
220        else
221        {
222            sprintf("%0${NIBBLES}X", $lo);
223        }
224    }
225    else {
226        sprintf("%0${NIBBLES}X", $v);
227    }
228
229}
230
231my ($OFF,  $LENGTH,  $CONTENT, $TEXT, $VALUE) ;
232
233my $FMT1 ;
234my $FMT2 ;
235
236sub setupFormat
237{
238    my $wantVerbose = shift ;
239    my $nibbles = shift;
240
241    my $width = '@' . ('>' x ($nibbles -1));
242    my $space = " " x length($width);
243
244    my $fmt ;
245
246    if ($wantVerbose) {
247
248        $FMT1 = "
249        format STDOUT =
250$width $width ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
251\$OFF,     \$LENGTH,  \$CONTENT, \$TEXT,               \$VALUE
252$space $space ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
253                    \$CONTENT, \$TEXT,               \$VALUE
254.
255";
256
257        $FMT2 = "
258        format STDOUT =
259$width $width ^<<<<<<<<<<<  ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
260\$OFF,     \$LENGTH,  \$CONTENT, \$TEXT,               \$VALUE
261$space $space ^<<<<<<<<<<<  ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
262              \$CONTENT, \$TEXT,               \$VALUE
263.  " ;
264
265    }
266    else {
267
268        $FMT1 = "
269        format STDOUT =
270$width ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
271\$OFF,      \$TEXT,               \$VALUE
272$space ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
273                    \$TEXT,               \$VALUE
274.
275";
276
277        $FMT2 = "
278    format STDOUT =
279$width   ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
280\$OFF,     \$TEXT,               \$VALUE
281$space   ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
282                    \$TEXT,               \$VALUE
283.
284" ;
285    }
286
287    eval "$FMT1";
288
289    $| = 1;
290
291}
292
293sub mySpr
294{
295    my $format = shift ;
296
297    return "" if ! defined $format;
298    return $format unless @_ ;
299    return sprintf $format, @_ ;
300}
301
302sub out0
303{
304    my $size = shift;
305    my $text = shift;
306    my $format = shift;
307
308    $OFF     = prOff($size);
309    $LENGTH  = offset($size) ;
310    $CONTENT = '...';
311    $TEXT    = $text;
312    $VALUE   = mySpr $format,  @_;
313
314    write;
315
316    skip($FH, $size);
317}
318
319sub xDump
320{
321    my $input = shift;
322
323    $input =~ tr/\0-\37\177-\377/./;
324    return $input;
325}
326
327sub hexDump
328{
329    my $input = shift;
330
331    my $out = unpack('H*', $input) ;
332    $out =~ s#(..)# $1#g ;
333    $out =~ s/^ //;
334    $out = uc $out;
335
336    return $out;
337}
338
339sub out
340{
341    my $data = shift;
342    my $text = shift;
343    my $format = shift;
344
345    my $size = length($data) ;
346
347    $OFF     = prOff($size);
348    $LENGTH  = offset($size) ;
349    $CONTENT = hexDump($data);
350    $TEXT    = $text;
351    $VALUE   = mySpr $format,  @_;
352
353    no warnings;
354
355    write;
356}
357
358sub out1
359{
360    my $text = shift;
361    my $format = shift;
362
363    $OFF     = '';
364    $LENGTH  = '' ;
365    $CONTENT = '';
366    $TEXT    = $text;
367    $VALUE   = mySpr $format,  @_;
368
369    write;
370}
371
372sub out2
373{
374    my $data = shift ;
375    my $text = shift ;
376    my $format = shift;
377
378    my $size = length($data) ;
379    $OFF     = prOff($size);
380    $LENGTH  = offset($size);
381    $CONTENT = hexDump($data);
382    $TEXT    = $text;
383    $VALUE   = mySpr $format,  @_;
384
385    no warnings;
386    eval "$FMT2";
387    write ;
388    eval "$FMT1";
389}
390
391sub Value
392{
393    my $letter = shift;
394    my @value = @_;
395
396    if ($letter eq 'C')
397      { return Value_C(@value) }
398    elsif ($letter eq 'v')
399      { return Value_v(@value) }
400    elsif ($letter eq 'V')
401      { return Value_V(@value) }
402    elsif ($letter eq 'VV')
403      { return Value_VV(@value) }
404}
405
406sub outer
407{
408    my $name = shift ;
409    my $unpack = shift ;
410    my $size = shift ;
411    my $cb1  = shift ;
412    my $cb2  = shift ;
413
414
415    myRead(my $buff, $size);
416    my (@value) = unpack $unpack, $buff;
417    my $hex = Value($unpack,  @value);
418
419    if (defined $cb1) {
420        my $v ;
421        if (ref $cb1 eq 'CODE') {
422            $v = $cb1->(@value) ;
423        }
424        else {
425            $v = $cb1 ;
426        }
427
428        $v = "'" . $v unless $v =~ /^'/;
429        $v .= "'"  unless $v =~ /'$/;
430        $hex .= " $v" ;
431    }
432
433    out $buff, $name, $hex ;
434
435    $cb2->(@value)
436        if defined $cb2 ;
437
438    return $value[0];
439}
440
441sub out_C
442{
443    my $name = shift ;
444    my $cb1  = shift ;
445    my $cb2  = shift ;
446
447    outer($name, 'C', 1, $cb1, $cb2);
448}
449
450sub out_v
451{
452    my $name = shift ;
453    my $cb1  = shift ;
454    my $cb2  = shift ;
455
456    outer($name, 'v', 2, $cb1, $cb2);
457}
458
459sub out_V
460{
461    my $name = shift ;
462    my $cb1  = shift ;
463    my $cb2  = shift ;
464
465    outer($name, 'V', 4, $cb1, $cb2);
466}
467
468sub out_VV
469{
470    my $name = shift ;
471    my $cb1  = shift ;
472    my $cb2  = shift ;
473
474    outer($name, 'VV', 8, $cb1, $cb2);
475}
476
477# sub outSomeData
478# {
479#     my $size = shift;
480#     my $message = shift;
481
482#     my $size64 = U64::mkU64($size);
483
484#     if ($size64->gt($ZERO)) {
485#         my $size32 = $size64->getLow();
486#         if ($size64->gt($PAYLOADLIMIT) ) {
487#             out0 $size32, $message;
488#         } else {
489#             myRead(my $buffer, $size32 );
490#             out $buffer, $message, xDump $buffer ;
491#         }
492#     }
493# }
494
495sub outSomeData
496{
497    my $size = shift;
498    my $message = shift;
499
500    if ($size > 0) {
501        if ($size > $PAYLOADLIMIT) {
502            my $before = $FH->tell();
503            out0 $size, $message;
504            # printf "outSomeData %X %X $size %X\n", $before, $FH->tell(), $size;
505        } else {
506            myRead(my $buffer, $size );
507            out $buffer, $message, xDump $buffer ;
508        }
509    }
510}
511
512sub unpackValue_C
513{
514    Value_v(unpack "C", $_[0]);
515}
516
517sub Value_C
518{
519    sprintf "%02X", $_[0];
520}
521
522
523sub unpackValue_v
524{
525    Value_v(unpack "v", $_[0]);
526}
527
528sub Value_v
529{
530    sprintf "%04X", $_[0];
531}
532
533sub unpackValue_V
534{
535    Value_V(unpack "V", $_[0]);
536}
537
538sub Value_V
539{
540    my $v = defined $_[0] ? $_[0] : 0;
541    sprintf "%08X", $v;
542}
543
544sub unpackValue_VV
545{
546    my ($lo, $hi) = unpack ("V V", $_[0]);
547    Value_VV($lo, $hi);
548}
549
550sub Value_U64
551{
552    my $u64 = shift ;
553    Value_VV($u64->getLow(), $u64->getHigh());
554}
555
556sub Value_VV
557{
558    my $lo = defined $_[0] ? $_[0] : 0;
559    my $hi = defined $_[1] ? $_[1] : 0;
560
561    if ($hi == 0)
562    {
563        sprintf "%016X", $lo;
564    }
565    else
566    {
567        sprintf("%08X", $hi) .
568        sprintf "%08X", $lo;
569    }
570}
571
572sub Value_VV64
573{
574    my $buffer = shift;
575
576    # This needs perl 5.10
577    # return unpack "Q<", $buffer;
578
579    my ($lo, $hi) = unpack ("V V" , $buffer);
580    no warnings 'uninitialized';
581    return $hi * (0xFFFFFFFF+1) + $lo;
582}
583
584sub read_U64
585{
586    my $b ;
587    myRead($b, 8);
588    my ($lo, $hi) = unpack ("V V" , $b);
589    no warnings 'uninitialized';
590    return ($b, new U64 $hi, $lo);
591}
592
593sub read_VV
594{
595    my $b ;
596    myRead($b, 8);
597    my ($lo, $hi) = unpack ("V V" , $b);
598    no warnings 'uninitialized';
599    return ($b, $hi * (0xFFFFFFFF+1) + $lo);
600}
601
602sub read_V
603{
604    my $b ;
605    myRead($b, 4);
606    return ($b, unpack ("V", $b));
607}
608
609sub read_v
610{
611    my $b ;
612    myRead($b, 2);
613    return ($b, unpack "v", $b);
614}
615
616
617sub read_C
618{
619    my $b ;
620    myRead($b, 1);
621    return ($b, unpack "C", $b);
622}
623
624
625my $opt_verbose = 0;
626while (@ARGV && $ARGV[0] =~ /^-/)
627{
628    my $opt = shift;
629
630    if ($opt =~ /^-h/i)
631    {
632        Usage();
633        exit;
634    }
635    elsif ($opt =~ /^-v/i)
636    {
637        $opt_verbose = 1;
638    }
639    else {
640        Usage();
641    }
642}
643
644Usage() unless @ARGV == 1;
645
646my $filename = shift @ARGV;
647
648die "$filename does not exist\n"
649    unless -e $filename ;
650
651die "$filename not a standard file\n"
652    unless -f $filename ;
653
654$FH = new IO::File "<$filename"
655    or die "Cannot open $filename: $!\n";
656
657
658my $FILELEN = -s $filename ;
659$TRAILING = -s $filename ;
660$NIBBLES = U64::nibbles(-s $filename) ;
661#$NIBBLES = int ($NIBBLES / 4) + ( ($NIBBLES % 4) ? 1 : 0 );
662#$NIBBLES = 4 * $NIBBLES;
663# Minimum of 4 nibbles
664$NIBBLES = 4 if $NIBBLES < 4 ;
665
666die "$filename too short to be a zip file\n"
667    if $FILELEN <  22 ;
668
669setupFormat($opt_verbose, $NIBBLES);
670
671if(0)
672{
673    # Sanity check that this is a Zip file
674    my ($buffer, $signature) = read_V();
675
676    warn "$filename doesn't look like a zip file\n"
677        if $signature != ZIP_LOCAL_HDR_SIG ;
678    $FH->seek(0, SEEK_SET) ;
679}
680
681
682our ($CdExists, @CentralDirectory) = scanCentralDirectory($FH);
683
684die "No Central Directory records found\n"
685    if ! $CdExists ;
686
687$OFFSET->reset();
688$FH->seek(0, SEEK_SET) ;
689
690outSomeData($START, "PREFIX DATA")
691    if defined $START && $START > 0 ;
692
693while (1)
694{
695    last if $FH->eof();
696
697    my $here = $FH->tell();
698    if ($here >= $TRAILING) {
699        print "\n" ;
700        outSomeData($FILELEN - $TRAILING, "TRAILING DATA");
701        last;
702
703    }
704
705    my ($buffer, $signature) = read_V();
706
707    my $handler = $Lookup{$signature};
708
709    if (!defined $handler)
710    {
711        if (@CentralDirectory) {
712            # Should be at offset that central directory says
713            my $locOffset = $CentralDirectory[0][0];
714            my $delta = $locOffset - $here ;
715
716            if ($here  < $locOffset ) {
717                for (0 .. 3) {
718                    $FH->ungetc(ord(substr($buffer, $_, 1)))
719                }
720                outSomeData($delta, "UNEXPECTED PADDING");
721                next;
722            }
723        }
724
725        printf "\n\nUnexpecded END at offset %08X, value %s\n", $here, Value_V($signature);
726        last;
727    }
728
729    $ZIP64 = 0 if $signature != ZIP_DATA_HDR_SIG ;
730    $handler->($signature, $buffer);
731}
732
733print "Done\n";
734
735exit ;
736
737sub compressionMethod
738{
739    my $id = shift ;
740    Value_v($id) . " '" . ($ZIP_CompressionMethods{$id} || "Unknown Method") . "'" ;
741}
742
743sub LocalHeader
744{
745    my $signature = shift ;
746    my $data = shift ;
747
748    print "\n";
749    ++ $LocalHeaderCount;
750    out $data, "LOCAL HEADER #" . sprintf("%X", $LocalHeaderCount) , Value_V($signature);
751
752    my $buffer;
753
754    my ($loc, $CDcompressedLength) = @{ shift @CentralDirectory };
755    # print "LocalHeader loc $loc CDL $CDcompressedLength\n";
756    # TODO - add test to check that the loc from central header matches
757
758    out_C  "Extract Zip Spec", \&decodeZipVer;
759    out_C  "Extract OS", \&decodeOS;
760
761    my ($bgp, $gpFlag) = read_v();
762    my ($bcm, $compressedMethod) = read_v();
763
764    out $bgp, "General Purpose Flag", Value_v($gpFlag) ;
765    GeneralPurposeBits($compressedMethod, $gpFlag);
766
767    out $bcm, "Compression Method",   compressionMethod($compressedMethod) ;
768
769    out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) };
770
771    my $crc                = out_V "CRC";
772    my $compressedLength   = out_V "Compressed Length";
773    my $uncompressedLength = out_V "Uncompressed Length";
774    my $filenameLength     = out_v "Filename Length";
775    my $extraLength        = out_v "Extra Length";
776
777    my $filename ;
778    myRead($filename, $filenameLength);
779    out $filename, "Filename",  "'". $filename . "'";
780
781    my $cl64 = new U64 $compressedLength ;
782    my %ExtraContext = ();
783    if ($extraLength)
784    {
785        my @z64 = ($uncompressedLength, $compressedLength, 1, 1);
786        $ExtraContext{Zip64} = \@z64 ;
787        $ExtraContext{InCentralDir} = 0;
788        walkExtra($extraLength, \%ExtraContext);
789    }
790
791    my $size = 0;
792    $size = printAes(\%ExtraContext)
793        if $compressedMethod == 99 ;
794
795    $size += printLzmaProperties()
796        if $compressedMethod == ZIP_CM_LZMA ;
797
798    # $CDcompressedLength->subtract($size)
799        # if $size ;
800    $CDcompressedLength -= $size;
801
802    # if ($CDcompressedLength->getHigh() || $CDcompressedLength->getLow()) {
803    if ($CDcompressedLength) {
804        outSomeData($CDcompressedLength, "PAYLOAD") ;
805    }
806
807    if ($compressedMethod == 99) {
808        my $auth ;
809        myRead($auth, 10);
810        out $auth, "AES Auth",  hexDump($auth);
811    }
812}
813
814
815sub CentralHeader
816{
817    my $signature = shift ;
818    my $data = shift ;
819
820    ++ $CentralHeaderCount;
821    print "\n";
822    out $data, "CENTRAL HEADER #" . sprintf("%X", $CentralHeaderCount) . "", Value_V($signature);
823    my $buffer;
824
825    out_C "Created Zip Spec", \&decodeZipVer;
826    out_C "Created OS", \&decodeOS;
827    out_C  "Extract Zip Spec", \&decodeZipVer;
828    out_C  "Extract OS", \&decodeOS;
829
830    my ($bgp, $gpFlag) = read_v();
831    my ($bcm, $compressedMethod) = read_v();
832
833    out $bgp, "General Purpose Flag", Value_v($gpFlag) ;
834    GeneralPurposeBits($compressedMethod, $gpFlag);
835
836    out $bcm, "Compression Method", compressionMethod($compressedMethod) ;
837
838    out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) };
839
840    my $crc                = out_V "CRC";
841    my $compressedLength   = out_V "Compressed Length";
842    my $uncompressedLength = out_V "Uncompressed Length";
843    my $filenameLength     = out_v "Filename Length";
844    my $extraLength        = out_v "Extra Length";
845    my $comment_length     = out_v "Comment Length";
846    my $disk_start         = out_v "Disk Start";
847    my $int_file_attrib    = out_v "Int File Attributes";
848
849    out1 "[Bit 0]",  $int_file_attrib & 1 ? "1 Text Data" : "0 'Binary Data'";
850
851    my $ext_file_attrib    = out_V "Ext File Attributes";
852    out1 "[Bit 0]",  "Read-Only"
853        if $ext_file_attrib & 0x01 ;
854    out1 "[Bit 1]",  "Hidden"
855        if $ext_file_attrib & 0x02 ;
856    out1 "[Bit 2]",  "System"
857        if $ext_file_attrib & 0x04 ;
858    out1 "[Bit 3]",  "Label"
859        if $ext_file_attrib & 0x08 ;
860    out1 "[Bit 4]",  "Directory"
861        if $ext_file_attrib & 0x10 ;
862    out1 "[Bit 5]",  "Archive"
863        if $ext_file_attrib & 0x20 ;
864
865    my $lcl_hdr_offset     = out_V "Local Header Offset";
866
867    my $filename ;
868    myRead($filename, $filenameLength);
869    out $filename, "Filename",  "'". $filename . "'";
870
871    my %ExtraContext = ();
872    if ($extraLength)
873    {
874        my @z64 = ($uncompressedLength, $compressedLength, $lcl_hdr_offset, $disk_start);
875        $ExtraContext{Zip64} = \@z64 ;
876        $ExtraContext{InCentralDir} = 1;
877        walkExtra($extraLength, \%ExtraContext);
878    }
879
880    if ($comment_length)
881    {
882        my $comment ;
883        myRead($comment, $comment_length);
884        out $comment, "Comment",  "'". $comment . "'";
885    }
886}
887
888sub decodeZipVer
889{
890    my $ver = shift ;
891
892    my $sHi = int($ver /10) ;
893    my $sLo = $ver % 10 ;
894
895    #out1 "Zip Spec", "$sHi.$sLo";
896    "$sHi.$sLo";
897}
898
899sub decodeOS
900{
901    my $ver = shift ;
902
903    $OS_Lookup{$ver} || "Unknown" ;
904}
905
906sub Zip64EndCentralHeader
907{
908    my $signature = shift ;
909    my $data = shift ;
910
911    print "\n";
912    out $data, "ZIP64 END CENTRAL DIR RECORD", Value_V($signature);
913
914    my $buff;
915    myRead($buff, 8);
916
917    out $buff, "Size of record",       unpackValue_VV($buff);
918
919    my $size  = Value_VV64($buff);
920
921    out_C  "Created Zip Spec", \&decodeZipVer;
922    out_C  "Created OS", \&decodeOS;
923    out_C  "Extract Zip Spec", \&decodeZipVer;
924    out_C  "Extract OS", \&decodeOS;
925    out_V  "Number of this disk";
926    out_V  "Central Dir Disk no";
927    out_VV "Entries in this disk";
928    out_VV "Total Entries";
929    out_VV "Size of Central Dir";
930    out_VV "Offset to Central dir";
931
932    # TODO -
933    die "Unsupported Size ($size) in Zip64EndCentralHeader\n"
934        if $size !=  44;
935}
936
937
938sub Zip64EndCentralLocator
939{
940    my $signature = shift ;
941    my $data = shift ;
942
943    print "\n";
944    out $data, "ZIP64 END CENTRAL DIR LOCATOR", Value_V($signature);
945
946    out_V  "Central Dir Disk no";
947    out_VV "Offset to Central dir";
948    out_V  "Total no of Disks";
949}
950
951sub EndCentralHeader
952{
953    my $signature = shift ;
954    my $data = shift ;
955
956    print "\n";
957    out $data, "END CENTRAL HEADER", Value_V($signature);
958
959    out_v "Number of this disk";
960    out_v "Central Dir Disk no";
961    out_v "Entries in this disk";
962    out_v "Total Entries";
963    out_V "Size of Central Dir";
964    out_V "Offset to Central Dir";
965    my $comment_length = out_v "Comment Length";
966
967    if ($comment_length)
968    {
969        my $comment ;
970        myRead($comment, $comment_length);
971        out $comment, "Comment", "'$comment'";
972    }
973}
974
975sub DataHeader
976{
977    my $signature = shift ;
978    my $data = shift ;
979
980    print "\n";
981    out $data, "STREAMING DATA HEADER", Value_V($signature);
982
983    out_V "CRC";
984
985    if ($ZIP64)
986    {
987        out_VV "Compressed Length" ;
988        out_VV "Uncompressed Length" ;
989    }
990    else
991    {
992        out_V "Compressed Length" ;
993        out_V "Uncompressed Length" ;
994    }
995}
996
997
998sub GeneralPurposeBits
999{
1000    my $method = shift;
1001    my $gp = shift;
1002
1003    out1 "[Bit  0]", "1 'Encryption'" if $gp & ZIP_GP_FLAG_ENCRYPTED_MASK;
1004
1005    my %lookup = (
1006        0 =>    "Normal Compression",
1007        1 =>    "Maximum Compression",
1008        2 =>    "Fast Compression",
1009        3 =>    "Super Fast Compression");
1010
1011
1012    if ($method == ZIP_CM_DEFLATE)
1013    {
1014        my $mid = $gp & 0x03;
1015
1016        out1 "[Bits 1-2]", "$mid '$lookup{$mid}'";
1017    }
1018
1019    if ($method == ZIP_CM_LZMA)
1020    {
1021        if ($gp & ZIP_GP_FLAG_LZMA_EOS_PRESENT) {
1022            out1 "[Bit 1]", "1 'LZMA EOS Marker Present'" ;
1023        }
1024        else {
1025            out1 "[Bit 1]", "0 'LZMA EOS Marker Not Present'" ;
1026        }
1027    }
1028
1029    if ($method == ZIP_CM_IMPLODE) # Imploding
1030    {
1031        out1 "[Bit 1]", ($gp & 1 ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ;
1032        out1 "[Bit 2]", ($gp & 2 ? "1 '3" : "0 '2"  ) . " Shannon-Fano
1033        Trees'" ;
1034    }
1035
1036    out1 "[Bit  3]", "1 'Streamed'"           if $gp & ZIP_GP_FLAG_STREAMING_MASK;
1037    out1 "[Bit  4]", "1 'Enhanced Deflating'" if $gp & 1 << 4;
1038    out1 "[Bit  5]", "1 'Compressed Patched'" if $gp & 1 << 5 ;
1039    out1 "[Bit  6]", "1 'Strong Encryption'"  if $gp & ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK;
1040    out1 "[Bit 11]", "1 'Language Encoding'"  if $gp & ZIP_GP_FLAG_LANGUAGE_ENCODING;
1041    out1 "[Bit 12]", "1 'Pkware Enhanced Compression'"  if $gp & 1 <<12 ;
1042    out1 "[Bit 13]", "1 'Encrypted Central Dir'"  if $gp & 1 <<13 ;
1043
1044    return ();
1045}
1046
1047
1048sub seekSet
1049{
1050    my $fh = $_[0] ;
1051    my $size = $_[1];
1052
1053    use Fcntl qw(SEEK_SET);
1054    if (ref $size eq 'U64') {
1055        seek($fh, $size->get64bit(), SEEK_SET);
1056    }
1057    else {
1058        seek($fh, $size, SEEK_SET);
1059    }
1060
1061}
1062
1063sub skip
1064{
1065    my $fh = $_[0] ;
1066    my $size = $_[1];
1067
1068    use Fcntl qw(SEEK_CUR);
1069    if (ref $size eq 'U64') {
1070        seek($fh, $size->get64bit(), SEEK_CUR);
1071    }
1072    else {
1073        seek($fh, $size, SEEK_CUR);
1074    }
1075
1076}
1077
1078
1079sub myRead
1080{
1081    my $got = \$_[0] ;
1082    my $size = $_[1];
1083
1084    my $wantSize = $size;
1085    $$got = '';
1086
1087    if ($size == 0)
1088    {
1089        return ;
1090    }
1091
1092    if ($size > 0)
1093    {
1094        my $buff ;
1095        my $status = $FH->read($buff, $size);
1096        return $status
1097            if $status < 0;
1098        $$got .= $buff ;
1099    }
1100
1101    my $len = length $$got;
1102    die "Truncated file (got $len, wanted $wantSize): $!\n"
1103        if length $$got != $wantSize;
1104}
1105
1106
1107
1108
1109sub walkExtra
1110{
1111    my $XLEN = shift;
1112    my $context = shift;
1113
1114    my $buff ;
1115    my $offset = 0 ;
1116
1117    my $id;
1118    my $subLen;
1119    my $payload ;
1120
1121    my $count = 0 ;
1122
1123    if ($XLEN < ZIP_EXTRA_SUBFIELD_ID_SIZE + ZIP_EXTRA_SUBFIELD_LEN_SIZE)
1124    {
1125        # Android zipalign is prime candidate for this non-standard extra field.
1126        myRead($payload, $XLEN);
1127        my $data = hexDump($payload);
1128
1129        out $payload, "Malformed Extra Data", $data;
1130
1131        return undef;
1132    }
1133
1134    while ($offset < $XLEN) {
1135
1136        ++ $count;
1137
1138        return undef
1139            if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;
1140
1141        myRead($id, ZIP_EXTRA_SUBFIELD_ID_SIZE);
1142        $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE;
1143        my $lookID = unpack "v", $id ;
1144        my ($who, $decoder) =  @{ defined $Extras{$lookID} ? $Extras{$lookID} : ['', undef] };
1145        #my ($who, $decoder) =  @{ $Extras{unpack "v", $id} || ['', undef] };
1146
1147        $who = "$id: $who"
1148            if $id =~ /\w\w/ ;
1149
1150        $who = "'$who'";
1151        out $id, "Extra ID #" . Value_v($count), unpackValue_v($id) . " $who" ;
1152
1153        myRead($buff, ZIP_EXTRA_SUBFIELD_LEN_SIZE);
1154        $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE;
1155
1156        $subLen =  unpack("v", $buff);
1157        out2 $buff, "Length", Value_v($subLen) ;
1158
1159        return undef
1160            if $offset + $subLen > $XLEN ;
1161
1162        if (! defined $decoder)
1163        {
1164            myRead($payload, $subLen);
1165            my $data = hexDump($payload);
1166
1167            out2 $payload, "Extra Payload", $data;
1168        }
1169        else
1170        {
1171            $decoder->($subLen, $context) ;
1172        }
1173
1174        $offset += $subLen ;
1175    }
1176
1177    return undef ;
1178}
1179
1180
1181sub full32
1182{
1183    return $_[0] == 0xFFFFFFFF ;
1184}
1185
1186sub decode_Zip64
1187{
1188    my $len = shift;
1189    my $context = shift;
1190
1191    my $z64Data = $context->{Zip64};
1192
1193    $ZIP64 = 1;
1194
1195    if (full32 $z64Data->[0] ) {
1196        out_VV "  Uncompressed Size";
1197    }
1198
1199    if (full32 $z64Data->[1] ) {
1200        out_VV "  Compressed Size";
1201    }
1202
1203    if (full32 $z64Data->[2] ) {
1204        out_VV "  Offset to Local Dir";
1205    }
1206
1207    if ($z64Data->[3] == 0xFFFF ) {
1208        out_V "  Disk Number";
1209    }
1210}
1211
1212sub Ntfs2Unix
1213{
1214    my $v = shift;
1215    my $u64 = shift;
1216
1217    # NTFS offset is 19DB1DED53E8000
1218
1219    my $hex = Value_U64($u64) ;
1220    my $NTFS_OFFSET = new U64 0x19DB1DE, 0xD53E8000 ;
1221    $u64->subtract($NTFS_OFFSET);
1222    my $elapse = $u64->get64bit();
1223    my $ns = ($elapse % 10000000) * 100;
1224    $elapse = int ($elapse/10000000);
1225    return "$hex '" . localtime($elapse) .
1226           " " . sprintf("%0dns'", $ns);
1227}
1228
1229sub decode_NTFS_Filetimes
1230{
1231    my $len = shift;
1232    my $context = shift;
1233
1234    out_V "  Reserved";
1235    out_v "  Tag1";
1236    out_v "  Size1" ;
1237
1238    my ($m, $s1) = read_U64;
1239    out $m, "  Mtime", Ntfs2Unix($m, $s1);
1240
1241    my ($c, $s2) = read_U64;
1242    out $c, "  Ctime", Ntfs2Unix($m, $s2);
1243
1244    my ($a, $s3) = read_U64;
1245    out $m, "  Atime", Ntfs2Unix($m, $s3);
1246}
1247
1248sub getTime
1249{
1250    my $time = shift ;
1251
1252    return "'" . localtime($time) . "'" ;
1253}
1254
1255sub decode_UT
1256{
1257    my $len = shift;
1258    my $context = shift;
1259
1260    my ($data, $flags) = read_C();
1261
1262    my $f = Value_C $flags;
1263    $f .= " mod"    if $flags & 1;
1264    $f .= " access" if $flags & 2;
1265    $f .= " change" if $flags & 4;
1266
1267    out $data, "  Flags", "'$f'";
1268
1269    -- $len;
1270
1271    if ($flags & 1)
1272    {
1273        my ($data, $time) = read_V();
1274
1275        out2 $data, "Mod Time",    Value_V($time) . " " . getTime($time) ;
1276
1277        $len -= 4 ;
1278    }
1279
1280
1281      if ($flags & 2 && $len > 0 )
1282      {
1283          my ($data, $time) = read_V();
1284
1285          out2 $data, "Access Time",    Value_V($time) . " " . getTime($time) ;
1286          $len -= 4 ;
1287      }
1288
1289      if ($flags & 4 && $len > 0)
1290      {
1291          my ($data, $time) = read_V();
1292
1293          out2 $data, "Change Time",    Value_V($time) . " " . getTime($time) ;
1294      }
1295}
1296
1297
1298
1299sub decode_AES
1300{
1301    my $len = shift;
1302    my $context = shift;
1303
1304    return if $len == 0 ;
1305
1306    my %lookup = ( 1 => "AE-1", 2 => "AE-2");
1307    out_v "  Vendor Version", sub {  $lookup{$_[0]} || "Unknown"  } ;
1308
1309    my $id ;
1310    myRead($id, 2);
1311    out $id, "  Vendor ID", unpackValue_v($id) . " '$id'";
1312
1313    my %strengths = (1 => "128-bit encryption key",
1314                     2 => "192-bit encryption key",
1315                     3 => "256-bit encryption key",
1316                    );
1317
1318    my $strength = out_C "  Encryption Strength", sub {$strengths{$_[0]} || "Unknown" } ;
1319
1320    my ($bmethod, $method) = read_v();
1321    out $bmethod, "  Compression Method", compressionMethod($method) ;
1322
1323    $context->{AesStrength} = $strength ;
1324}
1325
1326sub decode_UX
1327{
1328    my $len = shift;
1329    my $context = shift;
1330    my $inCentralHdr = $context->{InCentralDir} ;
1331
1332    return if $len == 0 ;
1333
1334    my ($data, $time) = read_V();
1335    out2 $data, "Access Time",    Value_V($time) . " " . getTime($time) ;
1336
1337    ($data, $time) = read_V();
1338    out2 $data, "Mod Time",    Value_V($time) . " " . getTime($time) ;
1339
1340    if (! $inCentralHdr ) {
1341        out_v "  UID" ;
1342        out_v "  GID";
1343    }
1344}
1345
1346sub decode_Ux
1347{
1348    my $len = shift;
1349    my $context = shift;
1350
1351    return if $len == 0 ;
1352    out_v "  UID" ;
1353    out_v "  GID";
1354}
1355
1356sub decodeLitteEndian
1357{
1358    my $value = shift ;
1359
1360    if (length $value == 4)
1361    {
1362        return Value_V unpack ("V", $value)
1363    }
1364    else {
1365        # TODO - fix this
1366        die "unsupported\n";
1367    }
1368
1369    my $got = 0 ;
1370    my $shift = 0;
1371
1372    #hexDump
1373    #reverse
1374    #my @a =unpack "C*", $value;
1375    #@a = reverse @a;
1376    #hexDump(@a);
1377
1378    for (reverse unpack "C*", $value)
1379    {
1380        $got = ($got << 8) + $_ ;
1381    }
1382
1383    return $got ;
1384}
1385
1386sub decode_ux
1387{
1388    my $len = shift;
1389    my $context = shift;
1390
1391    return if $len == 0 ;
1392    out_C "  Version" ;
1393    my $uidSize = out_C "  UID Size";
1394    myRead(my $data, $uidSize);
1395    out2 $data, "UID", decodeLitteEndian($data);
1396
1397    my $gidSize = out_C "  GID Size";
1398    myRead($data, $gidSize);
1399    out2 $data, "GID", decodeLitteEndian($data);
1400
1401}
1402
1403sub decode_Java_exe
1404{
1405    my $len = shift;
1406    my $context = shift;
1407
1408}
1409
1410sub decode_up
1411{
1412    my $len = shift;
1413    my $context = shift;
1414
1415
1416    out_C "  Version";
1417    out_V "  NameCRC32";
1418
1419    myRead(my $data, $len - 5);
1420
1421    out $data, "  UnicodeName", $data;
1422}
1423
1424sub decode_Xceed_unicode
1425{
1426    my $len = shift;
1427    my $context = shift;
1428
1429    my $data ;
1430
1431    # guess the fields used for this one
1432    myRead($data, 4);
1433    out $data, "  ID", $data;
1434
1435    out_v "  Length";
1436    out_v "  Null";
1437
1438    myRead($data, $len - 8);
1439
1440    out $data, "  UTF16LE Name", decode("UTF16LE", $data);
1441}
1442
1443
1444sub decode_NT_security
1445{
1446    my $len = shift;
1447    my $context = shift;
1448    my $inCentralHdr = $context->{InCentralDir} ;
1449
1450    out_V "  Uncompressed Size" ;
1451
1452    if (! $inCentralHdr) {
1453
1454        out_C "  Version" ;
1455
1456        out_v "  Type";
1457
1458        out_V "  NameCRC32" ;
1459
1460        my $plen = $len - 4 - 1 - 2 - 4;
1461        myRead(my $payload, $plen);
1462        out $plen, "  Extra Payload", hexDump($payload);
1463    }
1464}
1465
1466sub decodeMVS
1467{
1468    my $len = shift;
1469    my $context = shift;
1470
1471    # data in Big-Endian
1472    myRead(my $data, $len);
1473    my $ID = unpack("N", $data);
1474
1475    if ($ID == 0xE9F3F9F0)
1476    {
1477        out($data, "  ID", "'Z390'");
1478        substr($data, 0, 4) = '';
1479    }
1480
1481    out($data, "  Extra Payload", hexDump($data));
1482}
1483
1484sub printAes
1485{
1486    my $context = shift ;
1487
1488    my %saltSize = (
1489                        1 => 8,
1490                        2 => 12,
1491                        3 => 16,
1492                    );
1493
1494    myRead(my $salt, $saltSize{$context->{AesStrength} });
1495    out $salt, "AES Salt", hexDump($salt);
1496    myRead(my $pwv, 2);
1497    out $pwv, "AES Pwd Ver", hexDump($pwv);
1498
1499    return  $saltSize{$context->{AesStrength}} + 2 + 10;
1500}
1501
1502sub printLzmaProperties
1503{
1504    my $len = 0;
1505
1506    my $b1;
1507    my $b2;
1508    my $buffer;
1509
1510    myRead($b1, 2);
1511    my ($verHi, $verLow) = unpack ("CC", $b1);
1512
1513    out $b1, "LZMA Version", sprintf("%02X%02X", $verHi, $verLow) . " '$verHi.$verLow'";
1514    my $LzmaPropertiesSize = out_v "LZMA Properties Size";
1515    $len += 4;
1516
1517    my $LzmaInfo = out_C "LZMA Info",  sub { $_[0] == 93 ? "(Default)" : ""};
1518
1519    my $PosStateBits = 0;
1520    my $LiteralPosStateBits = 0;
1521    my $LiteralContextBits = 0;
1522    $PosStateBits = int($LzmaInfo / (9 * 5));
1523	$LzmaInfo -= $PosStateBits * 9 * 5;
1524	$LiteralPosStateBits = int($LzmaInfo / 9);
1525	$LiteralContextBits = $LzmaInfo - $LiteralPosStateBits * 9;
1526
1527    out1 "  PosStateBits",        $PosStateBits;
1528    out1 "  LiteralPosStateBits", $LiteralPosStateBits;
1529    out1 "  LiteralContextBits",  $LiteralContextBits;
1530
1531    out_V "LZMA Dictionary Size";
1532
1533    # TODO - assumption that this is 5
1534    $len += $LzmaPropertiesSize;
1535
1536    skip($FH, $LzmaPropertiesSize - 5)
1537        if  $LzmaPropertiesSize != 5 ;
1538
1539    return $len;
1540}
1541
1542sub scanCentralDirectory
1543{
1544    my $fh = shift;
1545
1546    my $here = $fh->tell();
1547
1548    # Use cases
1549    # 1 32-bit CD
1550    # 2 64-bit CD
1551
1552    my @CD = ();
1553    my $offset = findCentralDirectoryOffset($fh);
1554
1555    return ()
1556        if ! defined $offset;
1557
1558    $fh->seek($offset, SEEK_SET) ;
1559
1560    # Now walk the Central Directory Records
1561    my $buffer ;
1562    while ($fh->read($buffer, 46) == 46  &&
1563           unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
1564
1565        my $compressedLength   = unpack("V", substr($buffer, 20, 4));
1566        my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
1567        my $filename_length    = unpack("v", substr($buffer, 28, 2));
1568        my $extra_length       = unpack("v", substr($buffer, 30, 2));
1569        my $comment_length     = unpack("v", substr($buffer, 32, 2));
1570        my $locHeaderOffset    = unpack("V", substr($buffer, 42, 4));
1571
1572        $START = $locHeaderOffset
1573            if ! defined $START;
1574
1575        skip($fh, $filename_length ) ;
1576
1577        if ($extra_length)
1578        {
1579            $fh->read(my $extraField, $extra_length) ;
1580            # $self->smartReadExact(\$extraField, $extra_length);
1581
1582            # Check for Zip64
1583            # my $zip64Extended = findID("\x01\x00", $extraField);
1584            my $zip64Extended = findID(0x0001, $extraField);
1585
1586            if ($zip64Extended)
1587            {
1588                if ($uncompressedLength == 0xFFFFFFFF)
1589                {
1590                    $uncompressedLength = Value_VV64  substr($zip64Extended, 0, 8, "");
1591                    # $uncompressedLength = unpack "Q<", substr($zip64Extended, 0, 8, "");
1592                }
1593                if ($compressedLength == 0xFFFFFFFF)
1594                {
1595                    $compressedLength = Value_VV64  substr($zip64Extended, 0, 8, "");
1596                    # $compressedLength = unpack "Q<", substr($zip64Extended, 0, 8, "");
1597                }
1598                if ($locHeaderOffset == 0xFFFFFFFF)
1599                {
1600                    $locHeaderOffset = Value_VV64  substr($zip64Extended, 0, 8, "");
1601                    # $locHeaderOffset = unpack "Q<", substr($zip64Extended, 0, 8, "");
1602                }
1603            }
1604        }
1605
1606        my $got = [$locHeaderOffset, $compressedLength] ;
1607
1608        # my $v64 = new U64 $compressedLength ;
1609        # my $loc64 = new U64 $locHeaderOffset ;
1610        # my $got = [$loc64, $v64] ;
1611
1612        # if (full32 $compressedLength || full32  $locHeaderOffset) {
1613        #     $fh->read($buffer, $extra_length) ;
1614        #     # TODO - fix this
1615        #     die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer)
1616        #         if length($buffer) != $extra_length;
1617        #     $got = get64Extra($buffer, full32($uncompressedLength),
1618        #                          $v64,
1619        #                          $loc64);
1620
1621        #     # If not Zip64 extra field, assume size is 0xFFFFFFFF
1622        #     #$v64 = $got if defined $got;
1623        # }
1624        # else {
1625        #     skip($fh, $extra_length) ;
1626        # }
1627
1628        skip($fh, $comment_length ) ;
1629
1630        push @CD, $got ;
1631    }
1632
1633    $fh->seek($here, SEEK_SET) ;
1634
1635    # @CD = sort { $a->[0]->cmp($b->[0]) } @CD ;
1636    @CD = sort { $a->[0] <=> $b->[0] } @CD ;
1637    return (1, @CD);
1638}
1639
1640
1641sub offsetFromZip64
1642{
1643    my $fh = shift ;
1644    my $here = shift;
1645
1646    $fh->seek($here - 20, SEEK_SET)
1647    # TODO - fix this
1648        or die "xx $!" ;
1649
1650    my $buffer;
1651    my $got = 0;
1652    ($got = $fh->read($buffer, 20)) == 20
1653    # TODO - fix this
1654        or die "xxx $here $got $!" ;
1655
1656    if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
1657        my $cd64 = Value_VV64 substr($buffer,  8, 8);
1658
1659        $fh->seek($cd64, SEEK_SET) ;
1660
1661        $fh->read($buffer, 4) == 4
1662        # TODO - fix this
1663            or die "xxx" ;
1664
1665        if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {
1666
1667            $fh->read($buffer, 8) ==  8
1668            # TODO - fix this
1669                or die "xxx" ;
1670            my $size  = Value_VV64($buffer);
1671            $fh->read($buffer, $size) ==  $size
1672            # TODO - fix this
1673                or die "xxx" ;
1674
1675            my $cd64 =  Value_VV64 substr($buffer,  36, 8);
1676
1677            return $cd64 ;
1678        }
1679
1680        # TODO - fix this
1681        die "zzz";
1682    }
1683
1684    # TODO - fix this
1685    die "zzz";
1686}
1687
1688use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);
1689
1690sub findCentralDirectoryOffset
1691{
1692    my $fh = shift ;
1693
1694    # Most common use-case is where there is no comment, so
1695    # know exactly where the end of central directory record
1696    # should be.
1697
1698    $fh->seek(-22, SEEK_END) ;
1699    my $here = $fh->tell();
1700
1701    my $buffer;
1702    $fh->read($buffer, 22) == 22
1703    # TODO - fix this
1704        or die "xxx" ;
1705
1706    my $zip64 = 0;
1707    my $centralDirOffset ;
1708    if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
1709        $centralDirOffset = unpack("V", substr($buffer, 16,  4));
1710    }
1711    else {
1712        $fh->seek(0, SEEK_END) ;
1713
1714        my $fileLen = $fh->tell();
1715        my $want = 0 ;
1716
1717        while(1) {
1718            $want += 1024 * 32;
1719            my $seekTo = $fileLen - $want;
1720            if ($seekTo < 0 ) {
1721                $seekTo = 0;
1722                $want = $fileLen ;
1723            }
1724            $fh->seek( $seekTo, SEEK_SET)
1725            # TODO - fix this
1726                or die "xxx $!" ;
1727            my $got;
1728            ($got = $fh->read($buffer, $want)) == $want
1729            # TODO - fix this
1730                or die "xxx $got  $!" ;
1731            my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);
1732
1733            if ($pos >= 0 && $want - $pos > 22) {
1734                $here = $seekTo + $pos ;
1735                $centralDirOffset = unpack("V", substr($buffer, $pos + 16,  4));
1736                my $commentLength = unpack("V", substr($buffer, $pos + 20,  2));
1737                $commentLength = 0 if ! defined $commentLength ;
1738
1739                my $expectedEof = $fileLen - $want + $pos + 22 + $commentLength  ;
1740                # check for trailing data after end of zip
1741                if ($expectedEof < $fileLen ) {
1742                    $TRAILING = $expectedEof ;
1743                }
1744                last ;
1745            }
1746
1747            return undef
1748                if $want == $fileLen;
1749        }
1750    }
1751
1752    $centralDirOffset = offsetFromZip64($fh, $here)
1753        if full32 $centralDirOffset ;
1754
1755    return $centralDirOffset ;
1756}
1757
1758sub findID
1759{
1760    my $id_want = shift ;
1761    my $data    = shift;
1762
1763    my $XLEN = length $data ;
1764
1765    my $offset = 0 ;
1766    while ($offset < $XLEN) {
1767
1768        return undef
1769            if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;
1770
1771        my $id = substr($data, $offset, ZIP_EXTRA_SUBFIELD_ID_SIZE);
1772        $id = unpack("v", $id);
1773        $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE;
1774
1775        my $subLen =  unpack("v", substr($data, $offset,
1776                                            ZIP_EXTRA_SUBFIELD_LEN_SIZE));
1777        $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE ;
1778
1779        return undef
1780            if $offset + $subLen > $XLEN ;
1781
1782        return substr($data, $offset, $subLen)
1783            if $id eq $id_want ;
1784
1785        $offset += $subLen ;
1786    }
1787
1788    return undef ;
1789}
1790
1791
1792sub _dosToUnixTime
1793{
1794    my $dt = shift;
1795
1796    my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
1797    my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
1798    my $mday = ( ( $dt >> 16 ) & 0x1f );
1799
1800    my $hour = ( ( $dt >> 11 ) & 0x1f );
1801    my $min  = ( ( $dt >> 5  ) & 0x3f );
1802    my $sec  = ( ( $dt << 1  ) & 0x3e );
1803
1804
1805    use POSIX 'mktime';
1806
1807    my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 );
1808    return 0 if ! defined $time_t;
1809    return $time_t;
1810}
1811
1812
1813{
1814    package U64;
1815
1816    use constant MAX32 => 0xFFFFFFFF ;
1817    use constant HI_1 => MAX32 + 1 ;
1818    use constant LOW   => 0 ;
1819    use constant HIGH  => 1;
1820
1821    sub new
1822    {
1823        my $class = shift ;
1824
1825        my $high = 0 ;
1826        my $low  = 0 ;
1827
1828        if (@_ == 2) {
1829            $high = shift ;
1830            $low  = shift ;
1831        }
1832        elsif (@_ == 1) {
1833            $low  = shift ;
1834        }
1835
1836        bless [$low, $high], $class;
1837    }
1838
1839    sub newUnpack_V64
1840    {
1841        my $string = shift;
1842
1843        my ($low, $hi) = unpack "V V", $string ;
1844        bless [ $low, $hi ], "U64";
1845    }
1846
1847    sub newUnpack_V32
1848    {
1849        my $string = shift;
1850
1851        my $low = unpack "V", $string ;
1852        bless [ $low, 0 ], "U64";
1853    }
1854
1855    sub reset
1856    {
1857        my $self = shift;
1858        $self->[HIGH] = $self->[LOW] = 0;
1859    }
1860
1861    sub clone
1862    {
1863        my $self = shift;
1864        bless [ @$self ], ref $self ;
1865    }
1866
1867    sub mkU64
1868    {
1869        my $value = shift;
1870
1871        return $value
1872            if ref $value eq 'U64';
1873
1874        bless [  $value, 0 ], "U64" ;
1875    }
1876
1877    sub getHigh
1878    {
1879        my $self = shift;
1880        return $self->[HIGH];
1881    }
1882
1883    sub getLow
1884    {
1885        my $self = shift;
1886        return $self->[LOW];
1887    }
1888
1889    sub get32bit
1890    {
1891        my $self = shift;
1892        return $self->[LOW];
1893    }
1894
1895    sub get64bit
1896    {
1897        my $self = shift;
1898        # Not using << here because the result will still be
1899        # a 32-bit value on systems where int size is 32-bits
1900        return $self->[HIGH] * HI_1 + $self->[LOW];
1901    }
1902
1903    sub add
1904    {
1905        my $self = shift;
1906        my $value = shift;
1907
1908        if (ref $value eq 'U64') {
1909            $self->[HIGH] += $value->[HIGH] ;
1910            $value = $value->[LOW];
1911        }
1912
1913        my $available = MAX32 - $self->[LOW] ;
1914
1915        if ($value > $available) {
1916           ++ $self->[HIGH] ;
1917           $self->[LOW] = $value - $available - 1;
1918        }
1919        else {
1920           $self->[LOW] += $value ;
1921        }
1922
1923    }
1924
1925    sub subtract
1926    {
1927        my $self = shift;
1928        my $value = shift;
1929
1930        if (ref $value eq 'U64') {
1931
1932            if ($value->[HIGH]) {
1933                die "unsupport subtract option"
1934                    if $self->[HIGH] == 0 ||
1935                       $value->[HIGH] > $self->[HIGH] ;
1936
1937               $self->[HIGH] -= $value->[HIGH] ;
1938            }
1939
1940            $value = $value->[LOW] ;
1941        }
1942
1943        if ($value > $self->[LOW]) {
1944           -- $self->[HIGH] ;
1945           $self->[LOW] = MAX32 - $value + $self->[LOW] + 1;
1946        }
1947        else {
1948           $self->[LOW] -= $value;
1949        }
1950    }
1951
1952    sub rshift
1953    {
1954        my $self = shift;
1955        my $count = shift;
1956
1957        for (1 .. $count)
1958        {
1959            $self->[LOW] >>= 1;
1960            $self->[LOW] |= 0x80000000
1961                if $self->[HIGH] & 1 ;
1962            $self->[HIGH] >>= 1;
1963        }
1964    }
1965
1966    sub is64bit
1967    {
1968        my $self = shift;
1969        return $self->[HIGH] > 0 ;
1970    }
1971
1972    sub getPacked_V64
1973    {
1974        my $self = shift;
1975
1976        return pack "V V", @$self ;
1977    }
1978
1979    sub getPacked_V32
1980    {
1981        my $self = shift;
1982
1983        return pack "V", $self->[LOW] ;
1984    }
1985
1986    sub pack_V64
1987    {
1988        my $low  = shift;
1989
1990        return pack "V V", $low, 0;
1991    }
1992
1993    sub max32
1994    {
1995        my $self = shift;
1996        return $self->[HIGH] == 0 && $self->[LOW] == MAX32;
1997    }
1998
1999    sub stringify
2000    {
2001        my $self = shift;
2002
2003        return "High [$self->[HIGH]], Low [$self->[LOW]]";
2004    }
2005
2006    sub equal
2007    {
2008        my $self = shift;
2009        my $other = shift;
2010
2011        return $self->[LOW]  == $other->[LOW] &&
2012               $self->[HIGH] == $other->[HIGH] ;
2013    }
2014
2015    sub gt
2016    {
2017        my $self = shift;
2018        my $other = shift;
2019
2020        return $self->cmp($other) > 0 ;
2021    }
2022
2023    sub cmp
2024    {
2025        my $self = shift;
2026        my $other = shift ;
2027
2028        if ($self->[LOW] == $other->[LOW]) {
2029            return $self->[HIGH] - $other->[HIGH] ;
2030        }
2031        else {
2032            return $self->[LOW] - $other->[LOW] ;
2033        }
2034    }
2035
2036    sub nibbles
2037    {
2038        my @nibbles = (
2039            [ 16 => HI_1 * 0x10000000 ],
2040            [ 15 => HI_1 * 0x1000000 ],
2041            [ 14 => HI_1 * 0x100000 ],
2042            [ 13 => HI_1 * 0x10000 ],
2043            [ 12 => HI_1 * 0x1000 ],
2044            [ 11 => HI_1 * 0x100 ],
2045            [ 10 => HI_1 * 0x10 ],
2046            [  9 => HI_1 * 0x1 ],
2047
2048            [  8 => 0x10000000 ],
2049            [  7 => 0x1000000 ],
2050            [  6 => 0x100000 ],
2051            [  5 => 0x10000 ],
2052            [  4 => 0x1000 ],
2053            [  3 => 0x100 ],
2054            [  2 => 0x10 ],
2055            [  1 => 0x1 ],
2056        );
2057        my $value = shift ;
2058
2059        for my $pair (@nibbles)
2060        {
2061            my ($count, $limit) = @{ $pair };
2062
2063            return $count
2064                if $value >= $limit ;
2065        }
2066
2067    }
2068}
2069
2070sub Usage
2071{
2072    die <<EOM;
2073zipdetails [OPTIONS] file
2074
2075Display details about the internal structure of a Zip file.
2076
2077This is zipdetails version $VERSION
2078
2079OPTIONS
2080     -h     display help
2081     -v     Verbose - output more stuff
2082
2083Copyright (c) 2011-2019 Paul Marquess. All rights reserved.
2084
2085This program is free software; you can redistribute it and/or
2086modify it under the same terms as Perl itself.
2087EOM
2088
2089
2090}
2091
2092__END__
2093
2094=head1 NAME
2095
2096zipdetails - display the internal structure of zip files
2097
2098=head1 SYNOPSIS
2099
2100    zipdetails [-v] zipfile.zip
2101	zipdetails -h
2102
2103=head1 DESCRIPTION
2104
2105Zipdetails displays information about the internal record structure of the
2106zip file. It is not concerned with displaying any details of the compressed
2107data stored in the zip file.
2108
2109The program assumes prior understanding of the internal structure of a Zip
2110file. You should have a copy of the Zip APPNOTE file at hand to help
2111understand the output from this program (L<SEE ALSO> for details).
2112
2113=head2 OPTIONS
2114
2115=over 5
2116
2117=item -v
2118
2119Enable Verbose mode
2120
2121=item -h
2122
2123Display help
2124
2125=back
2126
2127
2128By default zipdetails will output the details of the zip file in three
2129columns.
2130
2131=over 5
2132
2133=item Column 1
2134
2135This contains the offset from the start of the file in hex.
2136
2137=item Column 2
2138
2139This contains a textual description of the field.
2140
2141=item Column 3
2142
2143If the field contains a numeric value it will be displayed in hex. Zip
2144stored most numbers in little-endian format - the value displayed will have
2145the little-endian encoding removed.
2146
2147Next, is an optional description of what the value means.
2148
2149
2150=back
2151
2152If the C<-v> option is present, column 1 is expanded to include
2153
2154=over 5
2155
2156=item *
2157
2158The offset from the start of the file in hex.
2159
2160=item *
2161
2162The length of the filed in hex.
2163
2164=item *
2165
2166A hex dump of the bytes in field in the order they are stored in the zip
2167file.
2168
2169=back
2170
2171
2172=head1 TODO
2173
2174Error handling is still a work in progress.  If the program encounters a
2175problem reading a zip file it is likely to terminate with an unhelpful
2176error message.
2177
2178=head1 SUPPORT
2179
2180General feedback/questions/bug reports should be sent to
2181L<https://github.com/pmqs/IO-Compress/issues> (preferred) or
2182L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>.
2183
2184=head1 SEE ALSO
2185
2186
2187The primary reference for Zip files is the "appnote" document available at
2188L<http://www.pkware.com/documents/casestudies/APPNOTE.TXT>.
2189
2190An alternative reference is the Info-Zip appnote. This is available from
2191L<ftp://ftp.info-zip.org/pub/infozip/doc/>
2192
2193
2194The C<zipinfo> program that comes with the info-zip distribution
2195(L<http://www.info-zip.org/>) can also display details of the structure of
2196a zip file.
2197
2198See also L<Archive::Zip::SimpleZip>, L<IO::Compress::Zip>,
2199L<IO::Uncompress::Unzip>.
2200
2201
2202=head1 AUTHOR
2203
2204Paul Marquess F<pmqs@cpan.org>.
2205
2206=head1 COPYRIGHT
2207
2208Copyright (c) 2011-2019 Paul Marquess. All rights reserved.
2209
2210This program is free software; you can redistribute it and/or modify it
2211under the same terms as Perl itself.
2212
2213