#!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;
#!/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)',
         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.06" ;

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,  @_;
       
    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 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 ;
    
    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 ) ;

        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 $s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 