| #!/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.05" ; |
| |
| my $FH; |
| |
| my $ZIP64 = 0 ; |
| my $NIBBLES = 8; |
| my $LocalHeaderCount = 0; |
| my $CentralHeaderCount = 0; |
| |
| my $START; |
| my $OFFSET = new U64 0; |
| my $TRAILING = 0 ; |
| my $PAYLOADLIMIT = new U64 256; |
| my $ZERO = new U64 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 $size64 = U64::mkU64($size); |
| |
| if ($size64->gt($ZERO)) { |
| my $size32 = $size64->getLow(); |
| if ($size64->gt($PAYLOADLIMIT) ) { |
| out0 $size32, $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 mkU64 |
| { |
| my $value = shift; |
| |
| return $value |
| if ref $value eq 'U64'; |
| |
| bless [ $value, 0 ], "U64" ; |
| } |
| |
| 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 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 stringify |
| { |
| my $self = shift; |
| |
| return "High [$self->[HIGH]], Low [$self->[LOW]]"; |
| } |
| |
| sub equal |
| { |
| my $self = shift; |
| my $other = shift; |
| |
| return $self->[LOW] == $other->[LOW] && |
| $self->[HIGH] == $other->[HIGH] ; |
| } |
| |
| sub gt |
| { |
| my $self = shift; |
| my $other = shift; |
| |
| return $self->cmp($other) > 0 ; |
| } |
| |
| sub cmp |
| { |
| my $self = shift; |
| my $other = shift ; |
| |
| if ($self->[LOW] == $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-2012 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. |
| |