#!/home/perldoc/perldoc-browser/perls/5.18.4/bin/perl eval 'exec /home/perldoc/perldoc-browser/perls/5.18.4/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; #!/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 < 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. An alternative is the Info-Zip appnote. This is available from L The C program that comes with the info-zip distribution (L) can also display details of the structure of a zip file. See also L, L. =head1 AUTHOR Paul Marquess F. =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.