Domain: pinupdatabase.com
privdayz.com / bin /
Current File : //bin/zipdetails
#!/usr/bin/perl
# zipdetails
#
# Display info on the contents of a Zip file
#
BEGIN { pop @INC if $INC[-1] eq '.' }
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)',
95 => 'XZ',
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, ['Open Packaging Growth Hint', undef ],
0xCAFE, ['Java Executable', \&decode_Java_exe],
0xfb4a, ['SMS/QDOS', undef],
);
my $VERSION = "1.08" ;
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 = 256; #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, @_;
no warnings;
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 outSomeData
{
my $size = shift;
my $message = shift;
if ($size > 0) {
if ($size > $PAYLOADLIMIT) {
my $before = $FH->tell();
out0 $size, $message;
# printf "outSomeData %X %X $size %X\n", $before, $FH->tell(), $size;
} else {
myRead(my $buffer, $size );
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;
# This needs perl 5.10
# return unpack "Q<", $buffer;
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 < 22 ;
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 ($CdExists, @CentralDirectory) = scanCentralDirectory($FH);
die "No Central Directory records found\n"
if ! $CdExists ;
$OFFSET->reset();
$FH->seek(0, SEEK_SET) ;
outSomeData($START, "PREFIX DATA")
if defined $START && $START > 0 ;
while (1)
{
last if $FH->eof();
my $here = $FH->tell();
if ($here >= $TRAILING) {
print "\n" ;
outSomeData($FILELEN - $TRAILING, "TRAILING DATA");
last;
}
my ($buffer, $signature) = read_V();
my $handler = $Lookup{$signature};
if (!defined $handler)
{
if (@CentralDirectory) {
# Should be at offset that central directory says
my $locOffset = $CentralDirectory[0][0];
my $delta = $locOffset - $here ;
if ($here < $locOffset ) {
for (0 .. 3) {
$FH->ungetc(ord(substr($buffer, $_, 1)))
}
outSomeData($delta, "UNEXPECTED PADDING");
next;
}
}
printf "\n\nUnexpecded END at offset %08X, value %s\n", $here, 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 };
# print "LocalHeader loc $loc CDL $CDcompressedLength\n";
# 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 ;
$CDcompressedLength -= $size;
# if ($CDcompressedLength->getHigh() || $CDcompressedLength->getLow()) {
if ($CDcompressedLength) {
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 seekSet
{
my $fh = $_[0] ;
my $size = $_[1];
use Fcntl qw(SEEK_SET);
if (ref $size eq 'U64') {
seek($fh, $size->get64bit(), SEEK_SET);
}
else {
seek($fh, $size, SEEK_SET);
}
}
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 ;
if ($XLEN < ZIP_EXTRA_SUBFIELD_ID_SIZE + ZIP_EXTRA_SUBFIELD_LEN_SIZE)
{
# Android zipalign is prime candidate for this non-standard extra field.
myRead($payload, $XLEN);
my $data = hexDump($payload);
out $payload, "Malformed Extra Data", $data;
return undef;
}
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 ) ;
if ($extra_length)
{
$fh->read(my $extraField, $extra_length) ;
# $self->smartReadExact(\$extraField, $extra_length);
# Check for Zip64
# my $zip64Extended = findID("\x01\x00", $extraField);
my $zip64Extended = findID(0x0001, $extraField);
if ($zip64Extended)
{
if ($uncompressedLength == 0xFFFFFFFF)
{
$uncompressedLength = Value_VV64 substr($zip64Extended, 0, 8, "");
# $uncompressedLength = unpack "Q<", substr($zip64Extended, 0, 8, "");
}
if ($compressedLength == 0xFFFFFFFF)
{
$compressedLength = Value_VV64 substr($zip64Extended, 0, 8, "");
# $compressedLength = unpack "Q<", substr($zip64Extended, 0, 8, "");
}
if ($locHeaderOffset == 0xFFFFFFFF)
{
$locHeaderOffset = Value_VV64 substr($zip64Extended, 0, 8, "");
# $locHeaderOffset = unpack "Q<", substr($zip64Extended, 0, 8, "");
}
}
}
my $got = [$locHeaderOffset, $compressedLength] ;
# 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 ;
@CD = sort { $a->[0] <=> $b->[0] } @CD ;
return (1, @CD);
}
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-2018 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
zipdetails [-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 reference 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<Archive::Zip::SimpleZip>, L<IO::Compress::Zip>,
L<IO::Uncompress::Unzip>.
=head1 AUTHOR
Paul Marquess F<pmqs@cpan.org>.
=head1 COPYRIGHT
Copyright (c) 2011-2018 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.
Pin Up Database - The Pinup Database
Sort By: Pin Up Name Pin Up Group Name City Zip Province Date posted Date last modified
Short Bio PinUp Girl Retro Glam
Full Bio I am a small town Minnesota single mom of two great kids who are my life. I began modeling 3 years ago for a photographer ho saw something in me I never did. Ice told me I should do one shoot with him and let that be the guide. I reluctantly agreed, and scheduled our date. I was sacred to death when he told me we would be doing a remake of the publicity stills of the 1956 movie Bus Stop, staring Marilyn Monroe. How in the world could I halfway resemble or pull off an icon the likes of Marylin Monroe in my first step in front of camera? Well, 2 hours later we had a nice set of images and I've been hooked ever since. We've done some really cool things and are looking hard at the future ahead to expand and get me out there a little more.
Published in the Following Publications Pho-Mo Magazine
Short Bio My pinup journey started at the age of 13 when I started collecting vintage decor and clothing- it has since spiraled into doing pinup shoots, meeting and developing friendships with other gorgeous pinups and being published in a pinup blog and magazine. Looking forward to the future and to see where other opportunities will take me!
Full Bio I started getting into collecting vintage when I was a young kid, my mom would always take me into antique stores and this seemed to be what fueled it all. Eventually I started dressing and collecting vintage clothing and home decor. My apartment is now a great mix of MCM. I’ve done several pinup photoshoots and am looking to doing more in the future. I have been featured in a online pinup blog as well as being published in an state content creators magazine. Looking forward to the future and all the adventures it brings going forward.
Published in the Following Publications Pinup and Pearl Newsletter and Voyage MN Magazine
Short Bio Meet Belle Starr, your favorite tattooed 💉, curvy 💃 nurse turning heads and stealing hearts 💘 across Northwest Florida. A professional nurse 👩⚕️ during the week and a sultry pinup queen 👑 on the weekends, she’s the ultimate blend of classy ✨ and sassy 🔥—a vintage vixen with a modern twist.
Full Bio Meet Belle Starr, your favorite tattooed 💉, curvy 💃 nurse turning heads and stealing hearts 💘 across Northwest Florida. A professional nurse 👩⚕️ during the week and a sultry pinup queen 👑 on the weekends, she’s the ultimate blend of classy ✨ and sassy 🔥—a vintage vixen with a modern twist.
She serves as the secretary for Pinups and Pumps Florida Chapter 💄 and is the official correspondent for PinupDatabase.com 🖋️. Belle Starr is dedicated to empowering women 👠, spotlighting the pinup community, and keeping the spirit of pinup history alive 📸. When she’s not hostessing 🎤 or interviewing at events 🌟, she’s a fierce advocate for the Ostel Place Foundation 🐴🐶🌿, a charity that helps people heal through horses, puppies, and the beauty of nature.
Whether she’s inspiring women 💋, enticing men 🕶️, or stealing the show as an event hostess 🎉, Belle Starr proves that beauty 💎, brains 🧠, and curves 🔥 never go out of style. Follow her journey for a dose of entertainment 🎭, empowerment 💪, and unforgettable vibes 🌟.
Pin Up Group Membership Pinups and Pumps
Published in the Following Publications Retrolovely, Drive In, The Social Pin, Smitten Kitten, Crowns and Chrome, Chrome Plated Dolls.
Pin Up Group Name The Luscious Ladies
Full Bio President of the New England Chapter of The Luscious Ladies and Professional Hair and Makeup Artist.
Pin Up Group Membership The Luscious Ladies
Published in the Following Publications Retro Lovely, Pinup Kulture, Rocket, Delicious Dolls, Pinups and Hotrods
Photography Studio Name Lassiter
Short Bio I'm a Pin Up model, classic car lover and Patriot. Been in Pin Up since 2014.
Full Bio BoomBoom Bettie has been in the pinup world since 2014. She has participated in pageants in person and online since 2019. She loves the title of Favorite Pearl that she received. She is the founder of a Pin Up club called Black Sheep Pin Up Social Club in Arizona. She loves being a part of the pin up world and the sisterhood it creates. She loves to attend local car shows and Pin Up events.
Pin Up Group Membership Black Sheep Pin Up Club
Short Bio 𝑷𝒊𝒏-𝒖𝒑 𝒕𝒖𝒓𝒏𝒆𝒅 𝑬𝒏𝒕𝒓𝒆𝒑𝒓𝒆𝒏𝒆𝒖𝒓
Full Bio 𝑷𝒊𝒏-𝒖𝒑, 𝒃𝒂𝒓 𝒄𝒐𝒏𝒔𝒖𝒍𝒕𝒂𝒏𝒕, 𝒄𝒉𝒆𝒇 𝒇𝒐𝒓 𝒇𝒖𝒏, 𝒂𝒓𝒕𝒊𝒔𝒕, 𝒋𝒆𝒘𝒆𝒍𝒓𝒚 𝒅𝒆𝒔𝒊𝒈𝒏𝒆𝒓, 𝒕-𝒔𝒉𝒊𝒓𝒕 𝒑𝒉𝒊𝒍𝒂𝒏𝒕𝒉𝒓𝒐𝒑𝒊𝒔𝒕, 𝒎𝒖𝒕𝒕 𝒎𝒐𝒎𝒂𝒈𝒆𝒓, 𝒕𝒓𝒂𝒔𝒉 𝒇𝒍𝒊𝒑𝒑𝒆𝒓, 𝒍𝒊𝒇𝒆-𝒉𝒂𝒄𝒌 𝒄𝒐𝒂𝒄𝒉, 𝒎𝒊𝒄𝒓𝒐 𝒊𝒏𝒇𝒍𝒖𝒆𝒏𝒄𝒆𝒓...
𝑰 𝒑𝒐𝒔𝒕 my own pics, 𝒂𝒍𝒍 𝒄𝒍𝒂𝒔𝒔𝒚, 𝒖𝒔𝒖𝒂𝒍𝒍𝒚 𝒘𝒊𝒕𝒉 𝒇𝒖𝒏 𝒕𝒉𝒆𝒎𝒆𝒔. 𝑪𝒖𝒔𝒕𝒐𝒎 𝒘𝒐𝒓𝒌 𝒊𝒔 𝒂𝒗𝒂𝒊𝒍𝒂𝒃𝒍𝒆.
Jill of All, Owner of 5.
Full Bio My awesome journey began in California, followed by 25 wonderful years in Colorado. In 2019 I made the best choice of my life—moving to Florida, where I’ve truly found my home. The pin up community has been amazing, as I have always been drawn to the vibrant world of rockabilly style, classic cars, and music. Known for being kind, generous, and full of adventure, I cherish my experiences and connecting with new people. As a proud member of "Pinups and Pumps," I deeply appreciate the camaraderie with my sisters. Together, we give back through charity events, creating lasting bonds and memories.
Pin Up Group Membership Pinups and Pumps Florida
Published in the Following Publications Dream Beauty, Dream Pinup, Wonderland, Social Pin, Smitten Kitten, Dollface Digest, Crowns & Chrome, Drive In and many more
Pin Up Group Name Pinups and Pumps Florida
Full Bio Clarice entered the pinup scene officially in 2019. Her first photoshoot was a tribute to the queen herself, Bettie Page. Dawning the same iconic bangs and hair darker than the devil's soul, she was a tattooed dead ringer. That photoshoot was featured in Retro Lovely's Bettie Page issue in 2019.
6 years later Clarice is a style of her own, finding herself more and more every day. She's a mental health advocate, constantly trying to educate about mental illness to help end the stigma. In March of this year she'll be celebrating 3 years free from alcohol. Supporting sobriety amongst her community is also a passion. Clarice is also Autistic, and tries to educate on hidden disabilities. Not only is she a pinup, she's a mommy first. Having 3 biological children, 3 "step"children, and her youngest being adopted, who's also autistic.
She enjoys creating art through painting, drawing, photography, and floral hair pieces.
Find her at the car shows, especially if there are rat rods and lowriders involved. Lowriders have been a part of her heart since high school. From being in a friend's hopper getting Taco Bell past her curfew, or cruising the beach with the systems bumping.
The name Clarice Von Darling is a tribute to The Silence of the Lambs. In her sister's memory.
Pin Up Group Membership Pinups and Pumps
Published in the Following Publications Retro Lovely
Full Bio Full of sass * Aspiring pinup * Mom * Fulltime career * Shenanigan lover * Fast car junkie * Beach bum
Pin Up Group Name Pinups and Pumps
Photography Studio Name Glitter Glam Studios
Short Bio Pinup Girl from Vero Beach Florida
Full Bio 62 year old trans woman who is now retired and living life to the fullest. Many past careers including dairy farmer firefighter/emt truck driver school bus driver church sexton cemetery sexton Public works director juice company truck driver and over the road truck driver. Two grown adult children ages 36 and 33 Two grand children ages 14 and 4 Local church member
Published in the Following Publications Modern Day Pinup Magazine
