--- /dev/null
+#!/usr/bin/perl
+
+# zipdetails
+#
+# Display info on the contents of a Zip file
+#
+
+use strict;
+use warnings ;
+
+use IO::File;
+use Encode;
+
+# Compression types
+use constant ZIP_CM_STORE => 0 ;
+use constant ZIP_CM_IMPLODE => 6 ;
+use constant ZIP_CM_DEFLATE => 8 ;
+use constant ZIP_CM_BZIP2 => 12 ;
+use constant ZIP_CM_LZMA => 14 ;
+use constant ZIP_CM_PPMD => 98 ;
+
+# General Purpose Flag
+use constant ZIP_GP_FLAG_ENCRYPTED_MASK => (1 << 0) ;
+use constant ZIP_GP_FLAG_STREAMING_MASK => (1 << 3) ;
+use constant ZIP_GP_FLAG_PATCHED_MASK => (1 << 5) ;
+use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ;
+use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT => (1 << 1) ;
+use constant ZIP_GP_FLAG_LANGUAGE_ENCODING => (1 << 11) ;
+
+# Internal File Attributes
+use constant ZIP_IFA_TEXT_MASK => 1;
+
+# Signatures for each of the headers
+use constant ZIP_LOCAL_HDR_SIG => 0x04034b50;
+use constant ZIP_DATA_HDR_SIG => 0x08074b50;
+use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50;
+use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50;
+use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50;
+use constant ZIP64_END_CENTRAL_LOC_HDR_SIG => 0x07064b50;
+use constant ZIP64_ARCHIVE_EXTRA_SIG => 0x08064b50;
+use constant ZIP64_DIGITAL_SIGNATURE_SIG => 0x05054b50;
+
+use constant ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG => 0x08064b50;
+
+# Extra sizes
+use constant ZIP_EXTRA_HEADER_SIZE => 2 ;
+use constant ZIP_EXTRA_MAX_SIZE => 0xFFFF ;
+use constant ZIP_EXTRA_SUBFIELD_ID_SIZE => 2 ;
+use constant ZIP_EXTRA_SUBFIELD_LEN_SIZE => 2 ;
+use constant ZIP_EXTRA_SUBFIELD_HEADER_SIZE => ZIP_EXTRA_SUBFIELD_ID_SIZE +
+ ZIP_EXTRA_SUBFIELD_LEN_SIZE;
+use constant ZIP_EXTRA_SUBFIELD_MAX_SIZE => ZIP_EXTRA_MAX_SIZE -
+ ZIP_EXTRA_SUBFIELD_HEADER_SIZE;
+
+my %ZIP_CompressionMethods =
+ (
+ 0 => 'Stored',
+ 1 => 'Shrunk',
+ 2 => 'Reduced compression factor 1',
+ 3 => 'Reduced compression factor 2',
+ 4 => 'Reduced compression factor 3',
+ 5 => 'Reduced compression factor 4',
+ 6 => 'Imploded',
+ 7 => 'Reserved for Tokenizing compression algorithm',
+ 8 => 'Deflated',
+ 9 => 'Enhanced Deflating using Deflate64(tm)',
+ 10 => 'PKWARE Data Compression Library Imploding',
+ 11 => 'Reserved by PKWARE',
+ 12 => 'BZIP2 ',
+ 13 => 'Reserved by PKWARE',
+ 14 => 'LZMA',
+ 15 => 'Reserved by PKWARE',
+ 16 => 'Reserved by PKWARE',
+ 17 => 'Reserved by PKWARE',
+ 18 => 'File is compressed using IBM TERSE (new)',
+ 19 => 'IBM LZ77 z Architecture (PFS)',
+ 96 => 'WinZip JPEG Compression',
+ 97 => 'WavPack compressed data',
+ 98 => 'PPMd version I, Rev 1',
+ 99 => 'AES Encryption',
+ );
+
+my %OS_Lookup = (
+ 0 => "MS-DOS",
+ 1 => "Amiga",
+ 2 => "OpenVMS",
+ 3 => "Unix",
+ 4 => "VM/CMS",
+ 5 => "Atari ST",
+ 6 => "HPFS (OS/2, NT 3.x)",
+ 7 => "Macintosh",
+ 8 => "Z-System",
+ 9 => "CP/M",
+ 10 => "Windoxs NTFS or TOPS-20",
+ 11 => "MVS or NTFS",
+ 12 => "VSE or SMS/QDOS",
+ 13 => "Acorn RISC OS",
+ 14 => "VFAT",
+ 15 => "alternate MVS",
+ 16 => "BeOS",
+ 17 => "Tandem",
+ 18 => "OS/400",
+ 19 => "OS/X (Darwin)",
+ 30 => "AtheOS/Syllable",
+ );
+
+
+my %Lookup = (
+ ZIP_LOCAL_HDR_SIG, \&LocalHeader,
+ ZIP_DATA_HDR_SIG, \&DataHeader,
+ ZIP_CENTRAL_HDR_SIG, \&CentralHeader,
+ ZIP_END_CENTRAL_HDR_SIG, \&EndCentralHeader,
+ ZIP64_END_CENTRAL_REC_HDR_SIG, \&Zip64EndCentralHeader,
+ ZIP64_END_CENTRAL_LOC_HDR_SIG, \&Zip64EndCentralLocator,
+
+ # TODO - Archive Encryption Headers
+ #ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG
+);
+
+my %Extras = (
+ 0x0001, ['ZIP64', \&decode_Zip64],
+ 0x0007, ['AV Info', undef],
+ 0x0008, ['Extended Language Encoding', undef],
+ 0x0009, ['OS/2 extended attributes', undef],
+ 0x000a, ['NTFS FileTimes', \&decode_NTFS_Filetimes],
+ 0x000c, ['OpenVMS', undef],
+ 0x000d, ['Unix', undef],
+ 0x000e, ['Stream & Fork Descriptors', undef],
+ 0x000f, ['Patch Descriptor', undef],
+ 0x0014, ['PKCS#7 Store for X.509 Certificates', undef],
+ 0x0015, ['X.509 Certificate ID and Signature for individual file', undef],
+ 0x0016, ['X.509 Certificate ID for Central Directory', undef],
+ 0x0017, ['Strong Encryption Header', undef],
+ 0x0018, ['Record Management Controls', undef],
+ 0x0019, ['PKCS#7 Encryption Recipient Certificate List', undef],
+
+
+ #The Header ID mappings defined by Info-ZIP and third parties are:
+
+ 0x0065, ['IBM S/390 attributes - uncompressed', undef],
+ 0x0066, ['IBM S/390 attributes - compressed', undef],
+ 0x07c8, ['Info-ZIP Macintosh (old, J. Lee)', undef],
+ 0x2605, ['ZipIt Macintosh (first version)', undef],
+ 0x2705, ['ZipIt Macintosh v 1.3.5 and newer (w/o full filename)', undef],
+ 0x2805, ['ZipIt Macintosh v 1.3.5 and newer ', undef],
+ 0x334d, ["Info-ZIP Macintosh (new, D. Haase's 'Mac3' field)", undef],
+ 0x4154, ['Tandem NSK', undef],
+ 0x4341, ['Acorn/SparkFS (David Pilling)', undef],
+ 0x4453, ['Windows NT security descriptor', \&decode_NT_security],
+ 0x4690, ['POSZIP 4690', undef],
+ 0x4704, ['VM/CMS', undef],
+ 0x470f, ['MVS', undef],
+ 0x4854, ['Theos, old inofficial port', undef],
+ 0x4b46, ['FWKCS MD5 (see below)', undef],
+ 0x4c41, ['OS/2 access control list (text ACL)', undef],
+ 0x4d49, ['Info-ZIP OpenVMS (obsolete)', undef],
+ 0x4d63, ['Macintosh SmartZIP, by Macro Bambini', undef],
+ 0x4f4c, ['Xceed original location extra field', undef],
+ 0x5356, ['AOS/VS (binary ACL)', undef],
+ 0x5455, ['Extended Timestamp', \&decode_UT],
+ 0x554e, ['Xceed unicode extra field', \&decode_Xceed_unicode],
+ 0x5855, ['Info-ZIP Unix (original; also OS/2, NT, etc.)', \&decode_UX],
+ 0x5a4c, ['ZipArchive Unicode Filename', undef],
+ 0x5a4d, ['ZipArchive Offsets Array', undef],
+ 0x6375, ["Info-ZIP Unicode Comment", \&decode_up ],
+ 0x6542, ['BeOS (BeBox, PowerMac, etc.)', undef],
+ 0x6854, ['Theos', undef],
+ 0x7075, ["Info-ZIP Unicode Path", \&decode_up ],
+ 0x756e, ['ASi Unix', undef],
+ 0x7441, ['AtheOS (AtheOS/Syllable attributes)', undef],
+ 0x7855, ["Unix Extra type 2", \&decode_Ux],
+ 0x7875, ["Unix Extra Type 3", \&decode_ux],
+ 0x9901, ['AES Encryption', \&decode_AES],
+ 0xA220, ["Microsoft Microsoft Open Packaging Growth Hint", undef ],
+ 0xCAFE, ["Java Executable", \&decode_Java_exe],
+ 0xfb4a, ['SMS/QDOS', undef],
+
+ );
+
+my $VERSION = "1.04" ;
+
+my $FH;
+
+my $ZIP64 = 0 ;
+my $NIBBLES = 8;
+my $LocalHeaderCount = 0;
+my $CentralHeaderCount = 0;
+
+my $START;
+my $OFFSET = new U64 0;
+my $TRAILING = 0 ;
+
+sub prOff
+{
+ my $offset = shift;
+ my $s = offset($OFFSET);
+ $OFFSET->add($offset);
+ return $s;
+}
+
+sub offset
+{
+ my $v = shift ;
+
+ if (ref $v eq 'U64') {
+ my $hi = $v->getHigh();
+ my $lo = $v->getLow();
+
+ if ($hi)
+ {
+ my $hiNib = $NIBBLES - 8 ;
+ sprintf("%0${hiNib}X", $hi) .
+ sprintf("%08X", $lo);
+ }
+ else
+ {
+ sprintf("%0${NIBBLES}X", $lo);
+ }
+ }
+ else {
+ sprintf("%0${NIBBLES}X", $v);
+ }
+
+}
+
+my ($OFF, $LENGTH, $CONTENT, $TEXT, $VALUE) ;
+
+my $FMT1 ;
+my $FMT2 ;
+
+sub setupFormat
+{
+ my $wantVerbose = shift ;
+ my $nibbles = shift;
+
+ my $width = '@' . ('>' x ($nibbles -1));
+ my $space = " " x length($width);
+
+ my $fmt ;
+
+ if ($wantVerbose) {
+
+ $FMT1 = "
+ format STDOUT =
+$width $width ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\$OFF, \$LENGTH, \$CONTENT, \$TEXT, \$VALUE
+$space $space ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+ \$CONTENT, \$TEXT, \$VALUE
+.
+";
+
+ $FMT2 = "
+ format STDOUT =
+$width $width ^<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\$OFF, \$LENGTH, \$CONTENT, \$TEXT, \$VALUE
+$space $space ^<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+ \$CONTENT, \$TEXT, \$VALUE
+. " ;
+
+ }
+ else {
+
+ $FMT1 = "
+ format STDOUT =
+$width ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\$OFF, \$TEXT, \$VALUE
+$space ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+ \$TEXT, \$VALUE
+.
+";
+
+ $FMT2 = "
+ format STDOUT =
+$width ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+\$OFF, \$TEXT, \$VALUE
+$space ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+ \$TEXT, \$VALUE
+.
+" ;
+ }
+
+ eval "$FMT1";
+
+ $| = 1;
+
+}
+
+sub mySpr
+{
+ my $format = shift ;
+
+ return "" if ! defined $format;
+ return $format unless @_ ;
+ return sprintf $format, @_ ;
+}
+
+sub out0
+{
+ my $size = shift;
+ my $text = shift;
+ my $format = shift;
+
+ $OFF = prOff($size);
+ $LENGTH = offset($size) ;
+ $CONTENT = '...';
+ $TEXT = $text;
+ $VALUE = mySpr $format, @_;
+
+ write;
+
+ skip($FH, $size);
+}
+
+sub xDump
+{
+ my $input = shift;
+
+ $input =~ tr/\0-\37\177-\377/./;
+ return $input;
+}
+
+sub hexDump
+{
+ my $input = shift;
+
+ my $out = unpack('H*', $input) ;
+ $out =~ s#(..)# $1#g ;
+ $out =~ s/^ //;
+ $out = uc $out;
+
+ return $out;
+}
+
+sub out
+{
+ my $data = shift;
+ my $text = shift;
+ my $format = shift;
+
+ my $size = length($data) ;
+
+ $OFF = prOff($size);
+ $LENGTH = offset($size) ;
+ $CONTENT = hexDump($data);
+ $TEXT = $text;
+ $VALUE = mySpr $format, @_;
+
+ write;
+}
+
+sub out1
+{
+ my $text = shift;
+ my $format = shift;
+
+ $OFF = '';
+ $LENGTH = '' ;
+ $CONTENT = '';
+ $TEXT = $text;
+ $VALUE = mySpr $format, @_;
+
+ write;
+}
+
+sub out2
+{
+ my $data = shift ;
+ my $text = shift ;
+ my $format = shift;
+
+ my $size = length($data) ;
+ $OFF = prOff($size);
+ $LENGTH = offset($size);
+ $CONTENT = hexDump($data);
+ $TEXT = $text;
+ $VALUE = mySpr $format, @_;
+
+ no warnings;
+ eval "$FMT2";
+ write ;
+ eval "$FMT1";
+}
+
+sub Value
+{
+ my $letter = shift;
+ my @value = @_;
+
+ if ($letter eq 'C')
+ { return Value_C(@value) }
+ elsif ($letter eq 'v')
+ { return Value_v(@value) }
+ elsif ($letter eq 'V')
+ { return Value_V(@value) }
+ elsif ($letter eq 'VV')
+ { return Value_VV(@value) }
+}
+
+sub outer
+{
+ my $name = shift ;
+ my $unpack = shift ;
+ my $size = shift ;
+ my $cb1 = shift ;
+ my $cb2 = shift ;
+
+
+ myRead(my $buff, $size);
+ my (@value) = unpack $unpack, $buff;
+ my $hex = Value($unpack, @value);
+
+ if (defined $cb1) {
+ my $v ;
+ if (ref $cb1 eq 'CODE') {
+ $v = $cb1->(@value) ;
+ }
+ else {
+ $v = $cb1 ;
+ }
+
+ $v = "'" . $v unless $v =~ /^'/;
+ $v .= "'" unless $v =~ /'$/;
+ $hex .= " $v" ;
+ }
+
+ out $buff, $name, $hex ;
+
+ $cb2->(@value)
+ if defined $cb2 ;
+
+ return $value[0];
+}
+
+sub out_C
+{
+ my $name = shift ;
+ my $cb1 = shift ;
+ my $cb2 = shift ;
+
+ outer($name, 'C', 1, $cb1, $cb2);
+}
+
+sub out_v
+{
+ my $name = shift ;
+ my $cb1 = shift ;
+ my $cb2 = shift ;
+
+ outer($name, 'v', 2, $cb1, $cb2);
+}
+
+sub out_V
+{
+ my $name = shift ;
+ my $cb1 = shift ;
+ my $cb2 = shift ;
+
+ outer($name, 'V', 4, $cb1, $cb2);
+}
+
+sub out_VV
+{
+ my $name = shift ;
+ my $cb1 = shift ;
+ my $cb2 = shift ;
+
+ outer($name, 'VV', 8, $cb1, $cb2);
+}
+
+sub outSomeData
+{
+ my $size = shift;
+ my $message = shift;
+
+ my $size32 = $size;
+ if (ref $size eq 'U64') {
+ $size32 = $size->getLow();
+ }
+
+ if ($size > 0) {
+ if ($size > 64) {
+ out0 $size, $message;
+ } else {
+ myRead(my $buffer, $size32 );
+ out $buffer, $message, xDump $buffer ;
+ }
+ }
+}
+
+sub unpackValue_C
+{
+ Value_v(unpack "C", $_[0]);
+}
+
+sub Value_C
+{
+ sprintf "%02X", $_[0];
+}
+
+
+sub unpackValue_v
+{
+ Value_v(unpack "v", $_[0]);
+}
+
+sub Value_v
+{
+ sprintf "%04X", $_[0];
+}
+
+sub unpackValue_V
+{
+ Value_V(unpack "V", $_[0]);
+}
+
+sub Value_V
+{
+ my $v = defined $_[0] ? $_[0] : 0;
+ sprintf "%08X", $v;
+}
+
+sub unpackValue_VV
+{
+ my ($lo, $hi) = unpack ("V V", $_[0]);
+ Value_VV($lo, $hi);
+}
+
+sub Value_U64
+{
+ my $u64 = shift ;
+ Value_VV($u64->getLow(), $u64->getHigh());
+}
+
+sub Value_VV
+{
+ my $lo = defined $_[0] ? $_[0] : 0;
+ my $hi = defined $_[1] ? $_[1] : 0;
+
+ if ($hi == 0)
+ {
+ sprintf "%016X", $lo;
+ }
+ else
+ {
+ sprintf("%08X", $hi) .
+ sprintf "%08X", $lo;
+ }
+}
+
+sub Value_VV64
+{
+ my $buffer = shift;
+
+ my ($lo, $hi) = unpack ("V V" , $buffer);
+ no warnings 'uninitialized';
+ return $hi * (0xFFFFFFFF+1) + $lo;
+}
+
+sub read_U64
+{
+ my $b ;
+ myRead($b, 8);
+ my ($lo, $hi) = unpack ("V V" , $b);
+ no warnings 'uninitialized';
+ return ($b, new U64 $hi, $lo);
+}
+
+sub read_VV
+{
+ my $b ;
+ myRead($b, 8);
+ my ($lo, $hi) = unpack ("V V" , $b);
+ no warnings 'uninitialized';
+ return ($b, $hi * (0xFFFFFFFF+1) + $lo);
+}
+
+sub read_V
+{
+ my $b ;
+ myRead($b, 4);
+ return ($b, unpack ("V", $b));
+}
+
+sub read_v
+{
+ my $b ;
+ myRead($b, 2);
+ return ($b, unpack "v", $b);
+}
+
+
+sub read_C
+{
+ my $b ;
+ myRead($b, 1);
+ return ($b, unpack "C", $b);
+}
+
+
+my $opt_verbose = 0;
+while (@ARGV && $ARGV[0] =~ /^-/)
+{
+ my $opt = shift;
+
+ if ($opt =~ /^-h/i)
+ {
+ Usage();
+ exit;
+ }
+ elsif ($opt =~ /^-v/i)
+ {
+ $opt_verbose = 1;
+ }
+ else {
+ Usage();
+ }
+}
+
+Usage() unless @ARGV == 1;
+
+my $filename = shift @ARGV;
+
+die "$filename does not exist\n"
+ unless -e $filename ;
+
+die "$filename not a standard file\n"
+ unless -f $filename ;
+
+$FH = new IO::File "<$filename"
+ or die "Cannot open $filename: $!\n";
+
+
+my $FILELEN = -s $filename ;
+$TRAILING = -s $filename ;
+$NIBBLES = U64::nibbles(-s $filename) ;
+#$NIBBLES = int ($NIBBLES / 4) + ( ($NIBBLES % 4) ? 1 : 0 );
+#$NIBBLES = 4 * $NIBBLES;
+# Minimum of 4 nibbles
+$NIBBLES = 4 if $NIBBLES < 4 ;
+
+die "$filename too short to be a zip file\n"
+ if $FILELEN < 100 ;
+
+setupFormat($opt_verbose, $NIBBLES);
+
+if(0)
+{
+ # Sanity check that this is a Zip file
+ my ($buffer, $signature) = read_V();
+
+ warn "$filename doesn't look like a zip file\n"
+ if $signature != ZIP_LOCAL_HDR_SIG ;
+ $FH->seek(0, SEEK_SET) ;
+}
+
+
+our @CentralDirectory = scanCentralDirectory($FH);
+die "No Central Directory found\n"
+ if ! @CentralDirectory ;
+
+$OFFSET->reset();
+$FH->seek(0, SEEK_SET) ;
+
+outSomeData($START, "PREFIX DATA")
+ if defined $START && $START > 0 ;
+
+while (1)
+{
+ last if $FH->eof();
+
+ if ($FH->tell() >= $TRAILING) {
+ print "\n" ;
+ outSomeData($FILELEN - $TRAILING, "TRAILING DATA");
+ last;
+
+ }
+
+ my ($buffer, $signature) = read_V();
+
+ my $handler = $Lookup{$signature};
+
+ if (!defined $handler)
+ {
+ my $offset = $FH->tell() - 4;
+ printf "\n\nUnexpecded END at offset %08X, value %s\n", $offset, Value_V($signature);
+ last;
+ }
+
+ $ZIP64 = 0 if $signature != ZIP_DATA_HDR_SIG ;
+ $handler->($signature, $buffer);
+}
+
+print "Done\n";
+
+exit ;
+
+sub compressionMethod
+{
+ my $id = shift ;
+ Value_v($id) . " '" . ($ZIP_CompressionMethods{$id} || "Unknown Method") . "'" ;
+}
+
+sub LocalHeader
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ print "\n";
+ ++ $LocalHeaderCount;
+ out $data, "LOCAL HEADER #" . sprintf("%X", $LocalHeaderCount) , Value_V($signature);
+
+ my $buffer;
+
+ my ($loc, $CDcompressedLength) = @{ shift @CentralDirectory };
+ # TODO - add test to check that the loc from central header matches
+
+ out_C "Extract Zip Spec", \&decodeZipVer;
+ out_C "Extract OS", \&decodeOS;
+
+ my ($bgp, $gpFlag) = read_v();
+ my ($bcm, $compressedMethod) = read_v();
+
+ out $bgp, "General Purpose Flag", Value_v($gpFlag) ;
+ GeneralPurposeBits($compressedMethod, $gpFlag);
+
+ out $bcm, "Compression Method", compressionMethod($compressedMethod) ;
+
+ out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) };
+
+ my $crc = out_V "CRC";
+ my $compressedLength = out_V "Compressed Length";
+ my $uncompressedLength = out_V "Uncompressed Length";
+ my $filenameLength = out_v "Filename Length";
+ my $extraLength = out_v "Extra Length";
+
+ my $filename ;
+ myRead($filename, $filenameLength);
+ out $filename, "Filename", "'". $filename . "'";
+
+ my $cl64 = new U64 $compressedLength ;
+ my %ExtraContext = ();
+ if ($extraLength)
+ {
+ my @z64 = ($uncompressedLength, $compressedLength, 1, 1);
+ $ExtraContext{Zip64} = \@z64 ;
+ $ExtraContext{InCentralDir} = 0;
+ walkExtra($extraLength, \%ExtraContext);
+ }
+
+ my $size = 0;
+ $size = printAes(\%ExtraContext)
+ if $compressedMethod == 99 ;
+
+ $size += printLzmaProperties()
+ if $compressedMethod == ZIP_CM_LZMA ;
+
+ $CDcompressedLength->subtract($size)
+ if $size ;
+
+ if ($CDcompressedLength->getHigh() || $CDcompressedLength->getLow()) {
+ outSomeData($CDcompressedLength, "PAYLOAD") ;
+ }
+
+ if ($compressedMethod == 99) {
+ my $auth ;
+ myRead($auth, 10);
+ out $auth, "AES Auth", hexDump($auth);
+ }
+}
+
+
+sub CentralHeader
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ ++ $CentralHeaderCount;
+ print "\n";
+ out $data, "CENTRAL HEADER #" . sprintf("%X", $CentralHeaderCount) . "", Value_V($signature);
+ my $buffer;
+
+ out_C "Created Zip Spec", \&decodeZipVer;
+ out_C "Created OS", \&decodeOS;
+ out_C "Extract Zip Spec", \&decodeZipVer;
+ out_C "Extract OS", \&decodeOS;
+
+ my ($bgp, $gpFlag) = read_v();
+ my ($bcm, $compressedMethod) = read_v();
+
+ out $bgp, "General Purpose Flag", Value_v($gpFlag) ;
+ GeneralPurposeBits($compressedMethod, $gpFlag);
+
+ out $bcm, "Compression Method", compressionMethod($compressedMethod) ;
+
+ out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) };
+
+ my $crc = out_V "CRC";
+ my $compressedLength = out_V "Compressed Length";
+ my $uncompressedLength = out_V "Uncompressed Length";
+ my $filenameLength = out_v "Filename Length";
+ my $extraLength = out_v "Extra Length";
+ my $comment_length = out_v "Comment Length";
+ my $disk_start = out_v "Disk Start";
+ my $int_file_attrib = out_v "Int File Attributes";
+
+ out1 "[Bit 0]", $int_file_attrib & 1 ? "1 Text Data" : "0 'Binary Data'";
+
+ my $ext_file_attrib = out_V "Ext File Attributes";
+ out1 "[Bit 0]", "Read-Only"
+ if $ext_file_attrib & 0x01 ;
+ out1 "[Bit 1]", "Hidden"
+ if $ext_file_attrib & 0x02 ;
+ out1 "[Bit 2]", "System"
+ if $ext_file_attrib & 0x04 ;
+ out1 "[Bit 3]", "Label"
+ if $ext_file_attrib & 0x08 ;
+ out1 "[Bit 4]", "Directory"
+ if $ext_file_attrib & 0x10 ;
+ out1 "[Bit 5]", "Archive"
+ if $ext_file_attrib & 0x20 ;
+
+ my $lcl_hdr_offset = out_V "Local Header Offset";
+
+ my $filename ;
+ myRead($filename, $filenameLength);
+ out $filename, "Filename", "'". $filename . "'";
+
+ my %ExtraContext = ();
+ if ($extraLength)
+ {
+ my @z64 = ($uncompressedLength, $compressedLength, $lcl_hdr_offset, $disk_start);
+ $ExtraContext{Zip64} = \@z64 ;
+ $ExtraContext{InCentralDir} = 1;
+ walkExtra($extraLength, \%ExtraContext);
+ }
+
+ if ($comment_length)
+ {
+ my $comment ;
+ myRead($comment, $comment_length);
+ out $comment, "Comment", "'". $comment . "'";
+ }
+}
+
+sub decodeZipVer
+{
+ my $ver = shift ;
+
+ my $sHi = int($ver /10) ;
+ my $sLo = $ver % 10 ;
+
+ #out1 "Zip Spec", "$sHi.$sLo";
+ "$sHi.$sLo";
+}
+
+sub decodeOS
+{
+ my $ver = shift ;
+
+ $OS_Lookup{$ver} || "Unknown" ;
+}
+
+sub Zip64EndCentralHeader
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ print "\n";
+ out $data, "ZIP64 END CENTRAL DIR RECORD", Value_V($signature);
+
+ my $buff;
+ myRead($buff, 8);
+
+ out $buff, "Size of record", unpackValue_VV($buff);
+
+ my $size = Value_VV64($buff);
+
+ out_C "Created Zip Spec", \&decodeZipVer;
+ out_C "Created OS", \&decodeOS;
+ out_C "Extract Zip Spec", \&decodeZipVer;
+ out_C "Extract OS", \&decodeOS;
+ out_V "Number of this disk";
+ out_V "Central Dir Disk no";
+ out_VV "Entries in this disk";
+ out_VV "Total Entries";
+ out_VV "Size of Central Dir";
+ out_VV "Offset to Central dir";
+
+ # TODO -
+ die "Unsupported Size ($size) in Zip64EndCentralHeader\n"
+ if $size != 44;
+}
+
+
+sub Zip64EndCentralLocator
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ print "\n";
+ out $data, "ZIP64 END CENTRAL DIR LOCATOR", Value_V($signature);
+
+ out_V "Central Dir Disk no";
+ out_VV "Offset to Central dir";
+ out_V "Total no of Disks";
+}
+
+sub EndCentralHeader
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ print "\n";
+ out $data, "END CENTRAL HEADER", Value_V($signature);
+
+ out_v "Number of this disk";
+ out_v "Central Dir Disk no";
+ out_v "Entries in this disk";
+ out_v "Total Entries";
+ out_V "Size of Central Dir";
+ out_V "Offset to Central Dir";
+ my $comment_length = out_v "Comment Length";
+
+ if ($comment_length)
+ {
+ my $comment ;
+ myRead($comment, $comment_length);
+ out $comment, "Comment", "'$comment'";
+ }
+}
+
+sub DataHeader
+{
+ my $signature = shift ;
+ my $data = shift ;
+
+ print "\n";
+ out $data, "STREAMING DATA HEADER", Value_V($signature);
+
+ out_V "CRC";
+
+ if ($ZIP64)
+ {
+ out_VV "Compressed Length" ;
+ out_VV "Uncompressed Length" ;
+ }
+ else
+ {
+ out_V "Compressed Length" ;
+ out_V "Uncompressed Length" ;
+ }
+}
+
+
+sub GeneralPurposeBits
+{
+ my $method = shift;
+ my $gp = shift;
+
+ out1 "[Bit 0]", "1 'Encryption'" if $gp & ZIP_GP_FLAG_ENCRYPTED_MASK;
+
+ my %lookup = (
+ 0 => "Normal Compression",
+ 1 => "Maximum Compression",
+ 2 => "Fast Compression",
+ 3 => "Super Fast Compression");
+
+
+ if ($method == ZIP_CM_DEFLATE)
+ {
+ my $mid = $gp & 0x03;
+
+ out1 "[Bits 1-2]", "$mid '$lookup{$mid}'";
+ }
+
+ if ($method == ZIP_CM_LZMA)
+ {
+ if ($gp & ZIP_GP_FLAG_LZMA_EOS_PRESENT) {
+ out1 "[Bit 1]", "1 'LZMA EOS Marker Present'" ;
+ }
+ else {
+ out1 "[Bit 1]", "0 'LZMA EOS Marker Not Present'" ;
+ }
+ }
+
+ if ($method == ZIP_CM_IMPLODE) # Imploding
+ {
+ out1 "[Bit 1]", ($gp & 1 ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ;
+ out1 "[Bit 2]", ($gp & 2 ? "1 '3" : "0 '2" ) . " Shannon-Fano
+ Trees'" ;
+ }
+
+ out1 "[Bit 3]", "1 'Streamed'" if $gp & ZIP_GP_FLAG_STREAMING_MASK;
+ out1 "[Bit 4]", "1 'Enhanced Deflating'" if $gp & 1 << 4;
+ out1 "[Bit 5]", "1 'Compressed Patched'" if $gp & 1 << 5 ;
+ out1 "[Bit 6]", "1 'Strong Encryption'" if $gp & ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK;
+ out1 "[Bit 11]", "1 'Language Encoding'" if $gp & ZIP_GP_FLAG_LANGUAGE_ENCODING;
+ out1 "[Bit 12]", "1 'Pkware Enhanced Compression'" if $gp & 1 <<12 ;
+ out1 "[Bit 13]", "1 'Encrypted Central Dir'" if $gp & 1 <<13 ;
+
+ return ();
+}
+
+
+
+
+sub skip
+{
+ my $fh = $_[0] ;
+ my $size = $_[1];
+
+ use Fcntl qw(SEEK_CUR);
+ if (ref $size eq 'U64') {
+ seek($fh, $size->get64bit(), SEEK_CUR);
+ }
+ else {
+ seek($fh, $size, SEEK_CUR);
+ }
+
+}
+
+
+sub myRead
+{
+ my $got = \$_[0] ;
+ my $size = $_[1];
+
+ my $wantSize = $size;
+ $$got = '';
+
+ if ($size == 0)
+ {
+ return ;
+ }
+
+ if ($size > 0)
+ {
+ my $buff ;
+ my $status = $FH->read($buff, $size);
+ return $status
+ if $status < 0;
+ $$got .= $buff ;
+ }
+
+ my $len = length $$got;
+ die "Truncated file (got $len, wanted $wantSize): $!\n"
+ if length $$got != $wantSize;
+}
+
+
+
+
+sub walkExtra
+{
+ my $XLEN = shift;
+ my $context = shift;
+
+ my $buff ;
+ my $offset = 0 ;
+
+ my $id;
+ my $subLen;
+ my $payload ;
+
+ my $count = 0 ;
+
+ while ($offset < $XLEN) {
+
+ ++ $count;
+
+ return undef
+ if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE > $XLEN ;
+
+ myRead($id, ZIP_EXTRA_SUBFIELD_ID_SIZE);
+ $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE;
+ my $lookID = unpack "v", $id ;
+ my ($who, $decoder) = @{ defined $Extras{$lookID} ? $Extras{$lookID} : ['', undef] };
+ #my ($who, $decoder) = @{ $Extras{unpack "v", $id} || ['', undef] };
+
+ $who = "$id: $who"
+ if $id =~ /\w\w/ ;
+
+ $who = "'$who'";
+ out $id, "Extra ID #" . Value_v($count), unpackValue_v($id) . " $who" ;
+
+ myRead($buff, ZIP_EXTRA_SUBFIELD_LEN_SIZE);
+ $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE;
+
+ $subLen = unpack("v", $buff);
+ out2 $buff, "Length", Value_v($subLen) ;
+
+ return undef
+ if $offset + $subLen > $XLEN ;
+
+ if (! defined $decoder)
+ {
+ myRead($payload, $subLen);
+ my $data = hexDump($payload);
+
+ out2 $payload, "Extra Payload", $data;
+ }
+ else
+ {
+ $decoder->($subLen, $context) ;
+ }
+
+ $offset += $subLen ;
+ }
+
+ return undef ;
+}
+
+
+sub full32
+{
+ return $_[0] == 0xFFFFFFFF ;
+}
+
+sub decode_Zip64
+{
+ my $len = shift;
+ my $context = shift;
+
+ my $z64Data = $context->{Zip64};
+
+ $ZIP64 = 1;
+
+ if (full32 $z64Data->[0] ) {
+ out_VV " Uncompressed Size";
+ }
+
+ if (full32 $z64Data->[1] ) {
+ out_VV " Compressed Size";
+ }
+
+ if (full32 $z64Data->[2] ) {
+ out_VV " Offset to Central Dir";
+ }
+
+ if ($z64Data->[3] == 0xFFFF ) {
+ out_V " Disk Number";
+ }
+}
+
+sub Ntfs2Unix
+{
+ my $v = shift;
+ my $u64 = shift;
+
+ # NTFS offset is 19DB1DED53E8000
+
+ my $hex = Value_U64($u64) ;
+ my $NTFS_OFFSET = new U64 0x19DB1DE, 0xD53E8000 ;
+ $u64->subtract($NTFS_OFFSET);
+ my $elapse = $u64->get64bit();
+ my $ns = ($elapse % 10000000) * 100;
+ $elapse = int ($elapse/10000000);
+ return "$hex '" . localtime($elapse) .
+ " " . sprintf("%0dns'", $ns);
+}
+
+sub decode_NTFS_Filetimes
+{
+ my $len = shift;
+ my $context = shift;
+
+ out_V " Reserved";
+ out_v " Tag1";
+ out_v " Size1" ;
+
+ my ($m, $s1) = read_U64;
+ out $m, " Mtime", Ntfs2Unix($m, $s1);
+
+ my ($c, $s2) = read_U64;
+ out $c, " Ctime", Ntfs2Unix($m, $s2);
+
+ my ($a, $s3) = read_U64;
+ out $m, " Atime", Ntfs2Unix($m, $s3);
+}
+
+sub getTime
+{
+ my $time = shift ;
+
+ return "'" . localtime($time) . "'" ;
+}
+
+sub decode_UT
+{
+ my $len = shift;
+ my $context = shift;
+
+ my ($data, $flags) = read_C();
+
+ my $f = Value_C $flags;
+ $f .= " mod" if $flags & 1;
+ $f .= " access" if $flags & 2;
+ $f .= " change" if $flags & 4;
+
+ out $data, " Flags", "'$f'";
+
+ -- $len;
+
+ if ($flags & 1)
+ {
+ my ($data, $time) = read_V();
+
+ out2 $data, "Mod Time", Value_V($time) . " " . getTime($time) ;
+
+ $len -= 4 ;
+ }
+
+
+ if ($flags & 2 && $len > 0 )
+ {
+ my ($data, $time) = read_V();
+
+ out2 $data, "Access Time", Value_V($time) . " " . getTime($time) ;
+ $len -= 4 ;
+ }
+
+ if ($flags & 4 && $len > 0)
+ {
+ my ($data, $time) = read_V();
+
+ out2 $data, "Change Time", Value_V($time) . " " . getTime($time) ;
+ }
+}
+
+
+
+sub decode_AES
+{
+ my $len = shift;
+ my $context = shift;
+
+ return if $len == 0 ;
+
+ my %lookup = ( 1 => "AE-1", 2 => "AE-2");
+ out_v " Vendor Version", sub { $lookup{$_[0]} || "Unknown" } ;
+
+ my $id ;
+ myRead($id, 2);
+ out $id, " Vendor ID", unpackValue_v($id) . " '$id'";
+
+ my %strengths = (1 => "128-bit encryption key",
+ 2 => "192-bit encryption key",
+ 3 => "256-bit encryption key",
+ );
+
+ my $strength = out_C " Encryption Strength", sub {$strengths{$_[0]} || "Unknown" } ;
+
+ my ($bmethod, $method) = read_v();
+ out $bmethod, " Compression Method", compressionMethod($method) ;
+
+ $context->{AesStrength} = $strength ;
+}
+
+sub decode_UX
+{
+ my $len = shift;
+ my $context = shift;
+ my $inCentralHdr = $context->{InCentralDir} ;
+
+ return if $len == 0 ;
+
+ my ($data, $time) = read_V();
+ out2 $data, "Access Time", Value_V($time) . " " . getTime($time) ;
+
+ ($data, $time) = read_V();
+ out2 $data, "Mod Time", Value_V($time) . " " . getTime($time) ;
+
+ if (! $inCentralHdr ) {
+ out_v " UID" ;
+ out_v " GID";
+ }
+}
+
+sub decode_Ux
+{
+ my $len = shift;
+ my $context = shift;
+
+ return if $len == 0 ;
+ out_v " UID" ;
+ out_v " GID";
+}
+
+sub decodeLitteEndian
+{
+ my $value = shift ;
+
+ if (length $value == 4)
+ {
+ return Value_V unpack ("V", $value)
+ }
+ else {
+ # TODO - fix this
+ die "unsupported\n";
+ }
+
+ my $got = 0 ;
+ my $shift = 0;
+
+ #hexDump
+ #reverse
+ #my @a =unpack "C*", $value;
+ #@a = reverse @a;
+ #hexDump(@a);
+
+ for (reverse unpack "C*", $value)
+ {
+ $got = ($got << 8) + $_ ;
+ }
+
+ return $got ;
+}
+
+sub decode_ux
+{
+ my $len = shift;
+ my $context = shift;
+
+ return if $len == 0 ;
+ out_C " Version" ;
+ my $uidSize = out_C " UID Size";
+ myRead(my $data, $uidSize);
+ out2 $data, "UID", decodeLitteEndian($data);
+
+ my $gidSize = out_C " GID Size";
+ myRead($data, $gidSize);
+ out2 $data, "GID", decodeLitteEndian($data);
+
+}
+
+sub decode_Java_exe
+{
+ my $len = shift;
+ my $context = shift;
+
+}
+
+sub decode_up
+{
+ my $len = shift;
+ my $context = shift;
+
+
+ out_C " Version";
+ out_V " NameCRC32";
+
+ myRead(my $data, $len - 5);
+
+ out $data, " UnicodeName", $data;
+}
+
+sub decode_Xceed_unicode
+{
+ my $len = shift;
+ my $context = shift;
+
+ my $data ;
+
+ # guess the fields used for this one
+ myRead($data, 4);
+ out $data, " ID", $data;
+
+ out_v " Length";
+ out_v " Null";
+
+ myRead($data, $len - 8);
+
+ out $data, " UTF16LE Name", decode("UTF16LE", $data);
+}
+
+
+sub decode_NT_security
+{
+ my $len = shift;
+ my $context = shift;
+ my $inCentralHdr = $context->{InCentralDir} ;
+
+ out_V " Uncompressed Size" ;
+
+ if (! $inCentralHdr) {
+
+ out_C " Version" ;
+
+ out_v " Type";
+
+ out_V " NameCRC32" ;
+
+ my $plen = $len - 4 - 1 - 2 - 4;
+ myRead(my $payload, $plen);
+ out $plen, " Extra Payload", hexDump($payload);
+ }
+}
+
+sub printAes
+{
+ my $context = shift ;
+
+ my %saltSize = (
+ 1 => 8,
+ 2 => 12,
+ 3 => 16,
+ );
+
+ myRead(my $salt, $saltSize{$context->{AesStrength} });
+ out $salt, "AES Salt", hexDump($salt);
+ myRead(my $pwv, 2);
+ out $pwv, "AES Pwd Ver", hexDump($pwv);
+
+ return $saltSize{$context->{AesStrength}} + 2 + 10;
+}
+
+sub printLzmaProperties
+{
+ my $len = 0;
+
+ my $b1;
+ my $b2;
+ my $buffer;
+
+ myRead($b1, 2);
+ my ($verHi, $verLow) = unpack ("CC", $b1);
+
+ out $b1, "LZMA Version", sprintf("%02X%02X", $verHi, $verLow) . " '$verHi.$verLow'";
+ my $LzmaPropertiesSize = out_v "LZMA Properties Size";
+ $len += 4;
+
+ my $LzmaInfo = out_C "LZMA Info", sub { $_[0] == 93 ? "(Default)" : ""};
+
+ my $PosStateBits = 0;
+ my $LiteralPosStateBits = 0;
+ my $LiteralContextBits = 0;
+ $PosStateBits = int($LzmaInfo / (9 * 5));
+ $LzmaInfo -= $PosStateBits * 9 * 5;
+ $LiteralPosStateBits = int($LzmaInfo / 9);
+ $LiteralContextBits = $LzmaInfo - $LiteralPosStateBits * 9;
+
+ out1 " PosStateBits", $PosStateBits;
+ out1 " LiteralPosStateBits", $LiteralPosStateBits;
+ out1 " LiteralContextBits", $LiteralContextBits;
+
+ out_V "LZMA Dictionary Size";
+
+ # TODO - assumption that this is 5
+ $len += $LzmaPropertiesSize;
+
+ skip($FH, $LzmaPropertiesSize - 5)
+ if $LzmaPropertiesSize != 5 ;
+
+ return $len;
+}
+
+sub scanCentralDirectory
+{
+ my $fh = shift;
+
+ my $here = $fh->tell();
+
+ # Use cases
+ # 1 32-bit CD
+ # 2 64-bit CD
+
+ my @CD = ();
+ my $offset = findCentralDirectoryOffset($fh);
+
+ return ()
+ if ! defined $offset;
+
+ $fh->seek($offset, SEEK_SET) ;
+
+ # Now walk the Central Directory Records
+ my $buffer ;
+ while ($fh->read($buffer, 46) == 46 &&
+ unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
+
+ my $compressedLength = unpack("V", substr($buffer, 20, 4));
+ my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
+ my $filename_length = unpack("v", substr($buffer, 28, 2));
+ my $extra_length = unpack("v", substr($buffer, 30, 2));
+ my $comment_length = unpack("v", substr($buffer, 32, 2));
+ my $locHeaderOffset = unpack("V", substr($buffer, 42, 4));
+
+ $START = $locHeaderOffset
+ if ! defined $START;
+
+ skip($fh, $filename_length ) ;
+
+ my $v64 = new U64 $compressedLength ;
+ my $loc64 = new U64 $locHeaderOffset ;
+ my $got = [$loc64, $v64] ;
+
+ if (full32 $compressedLength || full32 $locHeaderOffset) {
+ $fh->read($buffer, $extra_length) ;
+ # TODO - fix this
+ die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer)
+ if length($buffer) != $extra_length;
+ $got = get64Extra($buffer, full32($uncompressedLength),
+ $v64,
+ $loc64);
+
+ # If not Zip64 extra field, assume size is 0xFFFFFFFF
+ #$v64 = $got if defined $got;
+ }
+ else {
+ skip($fh, $extra_length) ;
+ }
+
+ skip($fh, $comment_length ) ;
+
+ push @CD, $got ;
+ }
+
+ $fh->seek($here, SEEK_SET) ;
+
+ @CD = sort { $a->[0]->cmp($b->[0]) } @CD ;
+ return @CD;
+}
+
+sub get64Extra
+{
+ my $buffer = shift;
+ my $is_uncomp = shift ;
+ my $comp = shift ;
+ my $loc = shift ;
+
+ my $extra = findID(0x0001, $buffer);
+
+ if ( defined $extra)
+ {
+ my $offset = 0;
+ $offset += 8 if $is_uncomp;
+ if ($comp->max32()) {
+ $comp = U64::newUnpack_V64(substr($extra, $offset)) ;
+ $offset += 8;
+ }
+ if ($loc->max32()) {
+ $loc = U64::newUnpack_V64(substr($extra, $offset)) ;
+ }
+ }
+
+ return [$loc, $comp] ;
+}
+
+sub offsetFromZip64
+{
+ my $fh = shift ;
+ my $here = shift;
+
+ $fh->seek($here - 20, SEEK_SET)
+ # TODO - fix this
+ or die "xx $!" ;
+
+ my $buffer;
+ my $got = 0;
+ ($got = $fh->read($buffer, 20)) == 20
+ # TODO - fix this
+ or die "xxx $here $got $!" ;
+
+ if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
+ my $cd64 = Value_VV64 substr($buffer, 8, 8);
+
+ $fh->seek($cd64, SEEK_SET) ;
+
+ $fh->read($buffer, 4) == 4
+ # TODO - fix this
+ or die "xxx" ;
+
+ if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {
+
+ $fh->read($buffer, 8) == 8
+ # TODO - fix this
+ or die "xxx" ;
+ my $size = Value_VV64($buffer);
+ $fh->read($buffer, $size) == $size
+ # TODO - fix this
+ or die "xxx" ;
+
+ my $cd64 = Value_VV64 substr($buffer, 36, 8);
+
+ return $cd64 ;
+ }
+
+ # TODO - fix this
+ die "zzz";
+ }
+
+ # TODO - fix this
+ die "zzz";
+}
+
+use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);
+
+sub findCentralDirectoryOffset
+{
+ my $fh = shift ;
+
+ # Most common use-case is where there is no comment, so
+ # know exactly where the end of central directory record
+ # should be.
+
+ $fh->seek(-22, SEEK_END) ;
+ my $here = $fh->tell();
+
+ my $buffer;
+ $fh->read($buffer, 22) == 22
+ # TODO - fix this
+ or die "xxx" ;
+
+ my $zip64 = 0;
+ my $centralDirOffset ;
+ if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
+ $centralDirOffset = unpack("V", substr($buffer, 16, 4));
+ }
+ else {
+ $fh->seek(0, SEEK_END) ;
+
+ my $fileLen = $fh->tell();
+ my $want = 0 ;
+
+ while(1) {
+ $want += 1024 * 32;
+ my $seekTo = $fileLen - $want;
+ if ($seekTo < 0 ) {
+ $seekTo = 0;
+ $want = $fileLen ;
+ }
+ $fh->seek( $seekTo, SEEK_SET)
+ # TODO - fix this
+ or die "xxx $!" ;
+ my $got;
+ ($got = $fh->read($buffer, $want)) == $want
+ # TODO - fix this
+ or die "xxx $got $!" ;
+ my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);
+
+ if ($pos >= 0 && $want - $pos > 22) {
+ $here = $seekTo + $pos ;
+ $centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4));
+ my $commentLength = unpack("V", substr($buffer, $pos + 20, 2));
+ $commentLength = 0 if ! defined $commentLength ;
+
+ my $expectedEof = $fileLen - $want + $pos + 22 + $commentLength ;
+ # check for trailing data after end of zip
+ if ($expectedEof < $fileLen ) {
+ $TRAILING = $expectedEof ;
+ }
+ last ;
+ }
+
+ return undef
+ if $want == $fileLen;
+ }
+ }
+
+ $centralDirOffset = offsetFromZip64($fh, $here)
+ if full32 $centralDirOffset ;
+
+ return $centralDirOffset ;
+}
+
+sub findID
+{
+ my $id_want = shift ;
+ my $data = shift;
+
+ my $XLEN = length $data ;
+
+ my $offset = 0 ;
+ while ($offset < $XLEN) {
+
+ return undef
+ if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE > $XLEN ;
+
+ my $id = substr($data, $offset, ZIP_EXTRA_SUBFIELD_ID_SIZE);
+ $id = unpack("v", $id);
+ $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE;
+
+ my $subLen = unpack("v", substr($data, $offset,
+ ZIP_EXTRA_SUBFIELD_LEN_SIZE));
+ $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE ;
+
+ return undef
+ if $offset + $subLen > $XLEN ;
+
+ return substr($data, $offset, $subLen)
+ if $id eq $id_want ;
+
+ $offset += $subLen ;
+ }
+
+ return undef ;
+}
+
+
+sub _dosToUnixTime
+{
+ my $dt = shift;
+
+ my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
+ my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1;
+ my $mday = ( ( $dt >> 16 ) & 0x1f );
+
+ my $hour = ( ( $dt >> 11 ) & 0x1f );
+ my $min = ( ( $dt >> 5 ) & 0x3f );
+ my $sec = ( ( $dt << 1 ) & 0x3e );
+
+
+ use POSIX 'mktime';
+
+ my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 );
+ return 0 if ! defined $time_t;
+ return $time_t;
+}
+
+
+{
+ package U64;
+
+ use constant MAX32 => 0xFFFFFFFF ;
+ use constant HI_1 => MAX32 + 1 ;
+ use constant LOW => 0 ;
+ use constant HIGH => 1;
+
+ sub new
+ {
+ my $class = shift ;
+
+ my $high = 0 ;
+ my $low = 0 ;
+
+ if (@_ == 2) {
+ $high = shift ;
+ $low = shift ;
+ }
+ elsif (@_ == 1) {
+ $low = shift ;
+ }
+
+ bless [$low, $high], $class;
+ }
+
+ sub newUnpack_V64
+ {
+ my $string = shift;
+
+ my ($low, $hi) = unpack "V V", $string ;
+ bless [ $low, $hi ], "U64";
+ }
+
+ sub newUnpack_V32
+ {
+ my $string = shift;
+
+ my $low = unpack "V", $string ;
+ bless [ $low, 0 ], "U64";
+ }
+
+ sub reset
+ {
+ my $self = shift;
+ $self->[HIGH] = $self->[LOW] = 0;
+ }
+
+ sub clone
+ {
+ my $self = shift;
+ bless [ @$self ], ref $self ;
+ }
+
+ sub getHigh
+ {
+ my $self = shift;
+ return $self->[HIGH];
+ }
+
+ sub getLow
+ {
+ my $self = shift;
+ return $self->[LOW];
+ }
+
+ sub get32bit
+ {
+ my $self = shift;
+ return $self->[LOW];
+ }
+
+ sub get64bit
+ {
+ my $self = shift;
+ # Not using << here because the result will still be
+ # a 32-bit value on systems where int size is 32-bits
+ return $self->[HIGH] * HI_1 + $self->[LOW];
+ }
+
+ sub add
+ {
+ my $self = shift;
+ my $value = shift;
+
+ if (ref $value eq 'U64') {
+ $self->[HIGH] += $value->[HIGH] ;
+ $value = $value->[LOW];
+ }
+
+ my $available = MAX32 - $self->[LOW] ;
+
+ if ($value > $available) {
+ ++ $self->[HIGH] ;
+ $self->[LOW] = $value - $available - 1;
+ }
+ else {
+ $self->[LOW] += $value ;
+ }
+
+ }
+
+ sub subtract
+ {
+ my $self = shift;
+ my $value = shift;
+
+ if (ref $value eq 'U64') {
+
+ if ($value->[HIGH]) {
+ die "unsupport subtract option"
+ if $self->[HIGH] == 0 ||
+ $value->[HIGH] > $self->[HIGH] ;
+
+ $self->[HIGH] -= $value->[HIGH] ;
+ }
+
+ $value = $value->[LOW] ;
+ }
+
+ if ($value > $self->[LOW]) {
+ -- $self->[HIGH] ;
+ $self->[LOW] = MAX32 - $value + $self->[LOW] + 1;
+ }
+ else {
+ $self->[LOW] -= $value;
+ }
+ }
+
+ sub rshift
+ {
+ my $self = shift;
+ my $count = shift;
+
+ for (1 .. $count)
+ {
+ $self->[LOW] >>= 1;
+ $self->[LOW] |= 0x80000000
+ if $self->[HIGH] & 1 ;
+ $self->[HIGH] >>= 1;
+ }
+ }
+
+ sub equal
+ {
+ my $self = shift;
+ my $other = shift;
+
+ return $self->[LOW] == $other->[LOW] &&
+ $self->[HIGH] == $other->[HIGH] ;
+ }
+
+ sub is64bit
+ {
+ my $self = shift;
+ return $self->[HIGH] > 0 ;
+ }
+
+ sub getPacked_V64
+ {
+ my $self = shift;
+
+ return pack "V V", @$self ;
+ }
+
+ sub getPacked_V32
+ {
+ my $self = shift;
+
+ return pack "V", $self->[LOW] ;
+ }
+
+ sub pack_V64
+ {
+ my $low = shift;
+
+ return pack "V V", $low, 0;
+ }
+
+ sub max32
+ {
+ my $self = shift;
+ return $self->[HIGH] == 0 && $self->[LOW] == MAX32;
+ }
+
+ sub cmp
+ {
+ my $self = shift;
+ my $other = shift ;
+
+ if ($self->[HIGH] == $other->[LOW]) {
+ return $self->[HIGH] - $other->[HIGH] ;
+ }
+ else {
+ return $self->[LOW] - $other->[LOW] ;
+ }
+ }
+
+ sub nibbles
+ {
+ my @nibbles = (
+ [ 16 => HI_1 * 0x10000000 ],
+ [ 15 => HI_1 * 0x1000000 ],
+ [ 14 => HI_1 * 0x100000 ],
+ [ 13 => HI_1 * 0x10000 ],
+ [ 12 => HI_1 * 0x1000 ],
+ [ 11 => HI_1 * 0x100 ],
+ [ 10 => HI_1 * 0x10 ],
+ [ 9 => HI_1 * 0x1 ],
+
+ [ 8 => 0x10000000 ],
+ [ 7 => 0x1000000 ],
+ [ 6 => 0x100000 ],
+ [ 5 => 0x10000 ],
+ [ 4 => 0x1000 ],
+ [ 3 => 0x100 ],
+ [ 2 => 0x10 ],
+ [ 1 => 0x1 ],
+ );
+ my $value = shift ;
+
+ for my $pair (@nibbles)
+ {
+ my ($count, $limit) = @{ $pair };
+
+ return $count
+ if $value >= $limit ;
+ }
+
+ }
+}
+
+sub Usage
+{
+ die <<EOM;
+zipdetails [OPTIONS] file
+
+Display details about the internal structure of a Zip file.
+
+This is zipdetails version $VERSION
+
+OPTIONS
+ -h display help
+ -v Verbose - output more stuff
+
+Copyright (c) 2011 Paul Marquess. All rights reserved.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+EOM
+
+
+}
+
+__END__
+
+=head1 NAME
+
+zipdetails - display the internal structure of zip files
+
+=head1 SYNOPSIS
+
+ zipdetaile [-v] zipfile.zip
+ zipdetails -h
+
+=head1 DESCRIPTION
+
+Zipdetails displays information about the internal record structure of the
+zip file. It is not concerned with displaying any details of the compressed
+data stored in the zip file.
+
+The program assumes prior understanding of the internal structure of a Zip
+file. You should have a copy of the Zip APPNOTE file at hand to help
+understand the output from this program (L<SEE ALSO> for details).
+
+=head2 OPTIONS
+
+=over 5
+
+=item -v
+
+Enable Verbose mode
+
+=item -h
+
+Display help
+
+=back
+
+
+By default zipdetails will output the details of the zip file in three
+columns.
+
+=over 5
+
+=item Column 1
+
+This contains the offset from the start of the file in hex.
+
+=item Column 2
+
+This contains a textual description of the field.
+
+=item Column 3
+
+If the field contains a numeric value it will be displayed in hex. Zip
+stored most numbers in little-endian format - the value displayed will have
+the little-endian encoding removed.
+
+Next, is an optional description of what the value means.
+
+
+=back
+
+If the C<-v> option is present, column 1 is expanded to include
+
+=over 5
+
+=item *
+
+The offset from the start of the file in hex.
+
+=item *
+
+The length of the filed in hex.
+
+=item *
+
+A hex dump of the bytes in field in the order they are stored in the zip
+file.
+
+=back
+
+
+=head1 TODO
+
+Error handling is still a work in progress. If the program encounters a
+problem reading a zip file it is likely to terminate with an unhelpful
+error message.
+
+
+=head1 SEE ALSO
+
+
+The primary reference for Zip files is the "appnote" document available at
+L<http://www.pkware.com/documents/casestudies/APPNOTE.TXT>.
+
+An alternative is the Info-Zip appnote. This is available from
+L<ftp://ftp.info-zip.org/pub/infozip/doc/>
+
+
+The C<zipinfo> program that comes with the info-zip distribution
+(L<http://www.info-zip.org/>) can also display details of the structure of
+a zip file.
+
+See also L<IO::Compress::Zip>, L<IO::Uncompress::Unzip>.
+
+
+=head1 AUTHOR
+
+Paul Marquess F<pmqs@cpan.org>.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2011 Paul Marquess. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
https://perl5.git.perl.org / perl5.git / commitdiff