ext/Compress/Zlib/lib/IO/Uncompress/Unzip.pm

   1 package IO::Uncompress::Unzip;
   2
   3 require 5.004 ;
   4
   5 # for RFC1952
   6
   7 use strict ;
   8 use warnings;
   9
  10 use IO::Uncompress::RawInflate ;
  11 use Compress::Zlib::Common qw(createSelfTiedObject);
  12 use UncompressPlugin::Identity;
  13
  14 require Exporter ;
  15
  16 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError);
  17
  18 $VERSION = '2.000_05';
  19 $UnzipError = '';
  20
  21 @ISA    = qw(Exporter IO::Uncompress::RawInflate);
  22 @EXPORT_OK = qw( $UnzipError unzip );
  23 %EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
  24 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  25 Exporter::export_ok_tags('all');
  26
  27
  28 sub new
  29 {
  30     my $class = shift ;
  31     my $obj = createSelfTiedObject($class, \$UnzipError);
  32     $obj->_create(undef, 0, @_);
  33 }
  34
  35 sub unzip
  36 {
  37     my $obj = createSelfTiedObject(undef, \$UnzipError);
  38     return $obj->_inf(@_) ;
  39 }
  40
  41 sub getExtraParams
  42 {
  43     use Compress::Zlib::ParseParameters;
  44
  45
  46     return (
  47 #            # Zip header fields
  48             'Name'      => [1, 1, Parse_any,       undef],
  49
  50 #            'Streaming' => [1, 1, Parse_boolean,   1],
  51         );
  52 }
  53
  54 sub ckParams
  55 {
  56     my $self = shift ;
  57     my $got = shift ;
  58
  59     # unzip always needs crc32
  60     $got->value('CRC32' => 1);
  61
  62     *$self->{UnzipData}{Name} = $got->value('Name');
  63
  64     return 1;
  65 }
  66
  67
  68 sub ckMagic
  69 {
  70     my $self = shift;
  71
  72     my $magic ;
  73     $self->smartReadExact(\$magic, 4);
  74
  75     *$self->{HeaderPending} = $magic ;
  76
  77     return $self->HeaderError("Minimum header size is " .
  78                               4 . " bytes")
  79         if length $magic != 4 ;
  80
  81     return $self->HeaderError("Bad Magic")
  82         if ! _isZipMagic($magic) ;
  83
  84     *$self->{Type} = 'zip';
  85
  86     return $magic ;
  87 }
  88
  89
  90
  91 sub readHeader
  92 {
  93     my $self = shift;
  94     my $magic = shift ;
  95
  96     my $name =  *$self->{UnzipData}{Name} ;
  97     my $status = $self->_readZipHeader($magic) ;
  98
  99     while (defined $status)
 100     {
 101         if (! defined $name || $status->{Name} eq $name)
 102         {
 103             return $status ;
 104         }
 105
 106         # skip the data
 107         my $c = $status->{CompressedLength};
 108         my $buffer;
 109         $self->smartReadExact(\$buffer, $c)
 110             or return $self->saveErrorString(undef, "Truncated file");
 111
 112         # skip the trailer
 113         $c = $status->{TrailerLength};
 114         $self->smartReadExact(\$buffer, $c)
 115             or return $self->saveErrorString(undef, "Truncated file");
 116
 117         $self->chkTrailer($buffer)
 118             or return $self->saveErrorString(undef, "Truncated file");
 119
 120         $status = $self->_readFullZipHeader();
 121
 122         return $self->saveErrorString(undef, "Cannot find '$name'")
 123             if $self->smartEof();
 124     }
 125
 126     return undef;
 127 }
 128
 129 sub chkTrailer
 130 {
 131     my $self = shift;
 132     my $trailer = shift;
 133
 134     my ($sig, $CRC32, $cSize, $uSize) ;
 135     if (*$self->{ZipData}{Streaming}) {
 136         ($sig, $CRC32, $cSize, $uSize) = unpack("V V V V", $trailer) ;
 137         return $self->TrailerError("Data Descriptor signature")
 138             if $sig != 0x08074b50;
 139     }
 140     else {
 141         ($CRC32, $cSize, $uSize) =
 142             (*$self->{ZipData}{Crc32},
 143              *$self->{ZipData}{CompressedLen},
 144              *$self->{ZipData}{UnCompressedLen});
 145     }
 146
 147     if (*$self->{Strict}) {
 148         #return $self->TrailerError("CRC mismatch")
 149         #    if $CRC32  != *$self->{Uncomp}->crc32() ;
 150
 151         my $exp_isize = *$self->{Uncomp}->compressedBytes();
 152         return $self->TrailerError("CSIZE mismatch. Got $cSize"
 153                                   . ", expected $exp_isize")
 154             if $cSize != $exp_isize ;
 155
 156         $exp_isize = *$self->{Uncomp}->uncompressedBytes();
 157         return $self->TrailerError("USIZE mismatch. Got $uSize"
 158                                   . ", expected $exp_isize")
 159             if $uSize != $exp_isize ;
 160     }
 161
 162     # check for central directory or end of central directory
 163     while (1)
 164     {
 165         my $magic ;
 166         $self->smartReadExact(\$magic, 4);
 167         my $sig = unpack("V", $magic) ;
 168
 169         if ($sig == 0x02014b50)
 170         {
 171             $self->skipCentralDirectory($magic);
 172         }
 173         elsif ($sig == 0x06054b50)
 174         {
 175             $self->skipEndCentralDirectory($magic);
 176             last;
 177         }
 178         else
 179         {
 180             # put the data back
 181             $self->pushBack($magic)  ;
 182             last;
 183         }
 184     }
 185
 186     return 1 ;
 187 }
 188
 189 sub skipCentralDirectory
 190 {
 191     my $self = shift;
 192     my $magic = shift ;
 193
 194     my $buffer;
 195     $self->smartReadExact(\$buffer, 46 - 4)
 196         or return $self->HeaderError("Minimum header size is " .
 197                                      46 . " bytes") ;
 198
 199     my $keep = $magic . $buffer ;
 200     *$self->{HeaderPending} = $keep ;
 201
 202    #my $versionMadeBy      = unpack ("v", substr($buffer, 4-4,  2));
 203    #my $extractVersion     = unpack ("v", substr($buffer, 6-4,  2));
 204    #my $gpFlag             = unpack ("v", substr($buffer, 8-4,  2));
 205    #my $compressedMethod   = unpack ("v", substr($buffer, 10-4, 2));
 206    #my $lastModTime        = unpack ("V", substr($buffer, 12-4, 4));
 207    #my $crc32              = unpack ("V", substr($buffer, 16-4, 4));
 208    #my $compressedLength   = unpack ("V", substr($buffer, 20-4, 4));
 209    #my $uncompressedLength = unpack ("V", substr($buffer, 24-4, 4));
 210     my $filename_length    = unpack ("v", substr($buffer, 28-4, 2));
 211     my $extra_length       = unpack ("v", substr($buffer, 30-4, 2));
 212     my $comment_length     = unpack ("v", substr($buffer, 32-4, 2));
 213    #my $disk_start         = unpack ("v", substr($buffer, 34-4, 2));
 214    #my $int_file_attrib    = unpack ("v", substr($buffer, 36-4, 2));
 215    #my $ext_file_attrib    = unpack ("V", substr($buffer, 38-4, 2));
 216    #my $lcl_hdr_offset     = unpack ("V", substr($buffer, 42-4, 2));
 217
 218
 219     my $filename;
 220     my $extraField;
 221     my $comment ;
 222     if ($filename_length)
 223     {
 224         $self->smartReadExact(\$filename, $filename_length)
 225             or return $self->HeaderError("xxx");
 226         $keep .= $filename ;
 227     }
 228
 229     if ($extra_length)
 230     {
 231         $self->smartReadExact(\$extraField, $extra_length)
 232             or return $self->HeaderError("xxx");
 233         $keep .= $extraField ;
 234     }
 235
 236     if ($comment_length)
 237     {
 238         $self->smartReadExact(\$comment, $comment_length)
 239             or return $self->HeaderError("xxx");
 240         $keep .= $comment ;
 241     }
 242
 243     return 1 ;
 244 }
 245
 246 sub skipEndCentralDirectory
 247 {
 248     my $self = shift;
 249     my $magic = shift ;
 250
 251     my $buffer;
 252     $self->smartReadExact(\$buffer, 22 - 4)
 253         or return $self->HeaderError("Minimum header size is " .
 254                                      22 . " bytes") ;
 255
 256     my $keep = $magic . $buffer ;
 257     *$self->{HeaderPending} = $keep ;
 258
 259    #my $diskNumber         = unpack ("v", substr($buffer, 4-4,  2));
 260    #my $cntrlDirDiskNo     = unpack ("v", substr($buffer, 6-4,  2));
 261    #my $entriesInThisCD    = unpack ("v", substr($buffer, 8-4,  2));
 262    #my $entriesInCD        = unpack ("v", substr($buffer, 10-4, 2));
 263    #my $sizeOfCD           = unpack ("V", substr($buffer, 12-4, 2));
 264    #my $offsetToCD         = unpack ("V", substr($buffer, 16-4, 2));
 265     my $comment_length     = unpack ("v", substr($buffer, 20-4, 2));
 266
 267
 268     my $comment ;
 269     if ($comment_length)
 270     {
 271         $self->smartReadExact(\$comment, $comment_length)
 272             or return $self->HeaderError("xxx");
 273         $keep .= $comment ;
 274     }
 275
 276     return 1 ;
 277 }
 278
 279
 280
 281
 282 sub _isZipMagic
 283 {
 284     my $buffer = shift ;
 285     return 0 if length $buffer < 4 ;
 286     my $sig = unpack("V", $buffer) ;
 287     return $sig == 0x04034b50 ;
 288 }
 289
 290
 291 sub _readFullZipHeader($)
 292 {
 293     my ($self) = @_ ;
 294     my $magic = '' ;
 295
 296     $self->smartReadExact(\$magic, 4);
 297
 298     *$self->{HeaderPending} = $magic ;
 299
 300     return $self->HeaderError("Minimum header size is " .
 301                               30 . " bytes")
 302         if length $magic != 4 ;
 303
 304
 305     return $self->HeaderError("Bad Magic")
 306         if ! _isZipMagic($magic) ;
 307
 308     my $status = $self->_readZipHeader($magic);
 309     delete *$self->{Transparent} if ! defined $status ;
 310     return $status ;
 311 }
 312
 313 sub _readZipHeader($)
 314 {
 315     my ($self, $magic) = @_ ;
 316     my ($HeaderCRC) ;
 317     my ($buffer) = '' ;
 318
 319     $self->smartReadExact(\$buffer, 30 - 4)
 320         or return $self->HeaderError("Minimum header size is " .
 321                                      30 . " bytes") ;
 322
 323     my $keep = $magic . $buffer ;
 324     *$self->{HeaderPending} = $keep ;
 325
 326     my $extractVersion     = unpack ("v", substr($buffer, 4-4,  2));
 327     my $gpFlag             = unpack ("v", substr($buffer, 6-4,  2));
 328     my $compressedMethod   = unpack ("v", substr($buffer, 8-4,  2));
 329     my $lastModTime        = unpack ("V", substr($buffer, 10-4, 4));
 330     my $crc32              = unpack ("V", substr($buffer, 14-4, 4));
 331     my $compressedLength   = unpack ("V", substr($buffer, 18-4, 4));
 332     my $uncompressedLength = unpack ("V", substr($buffer, 22-4, 4));
 333     my $filename_length    = unpack ("v", substr($buffer, 26-4, 2));
 334     my $extra_length       = unpack ("v", substr($buffer, 28-4, 2));
 335
 336     my $filename;
 337     my $extraField;
 338     my $streamingMode = ($gpFlag & 0x08) ? 1 : 0 ;
 339
 340     return $self->HeaderError("Streamed Stored content not supported")
 341         if $streamingMode && $compressedMethod == 0 ;
 342
 343     *$self->{ZipData}{Streaming} = $streamingMode;
 344
 345     if (! $streamingMode) {
 346         *$self->{ZipData}{Streaming} = 0;
 347         *$self->{ZipData}{Crc32} = $crc32;
 348         *$self->{ZipData}{CompressedLen} = $compressedLength;
 349         *$self->{ZipData}{UnCompressedLen} = $uncompressedLength;
 350     }
 351
 352     if ($filename_length)
 353     {
 354         $self->smartReadExact(\$filename, $filename_length)
 355             or return $self->HeaderError("xxx");
 356         $keep .= $filename ;
 357     }
 358
 359     if ($extra_length)
 360     {
 361         $self->smartReadExact(\$extraField, $extra_length)
 362             or return $self->HeaderError("xxx");
 363         $keep .= $extraField ;
 364     }
 365
 366     *$self->{CompressedInputLengthRemaining} =
 367         *$self->{CompressedInputLength} = $compressedLength;
 368
 369     if ($compressedMethod == 8)
 370     {
 371         *$self->{Type} = 'zip';
 372     }
 373     elsif ($compressedMethod == 0)
 374     {
 375         # TODO -- add support for reading uncompressed
 376
 377         *$self->{Type} = 'zipStored';
 378
 379         my $obj = UncompressPlugin::Identity::mkUncompObject(# $got->value('CRC32'),
 380                                                              # $got->value('ADLER32'),
 381                                                               );
 382
 383         *$self->{Uncomp} = $obj;
 384
 385     }
 386     else
 387     {
 388         return $self->HeaderError("Unsupported Compression format $compressedMethod");
 389     }
 390
 391     return {
 392         'Type'               => 'zip',
 393         'FingerprintLength'  => 2,
 394         #'HeaderLength'       => $compressedMethod == 8 ? length $keep : 0,
 395         'HeaderLength'       => length $keep,
 396         'TrailerLength'      => $streamingMode ? 16  : 0,
 397         'Header'             => $keep,
 398         'CompressedLength'   => $compressedLength ,
 399         'UncompressedLength' => $uncompressedLength ,
 400         'CRC32'              => $crc32 ,
 401         'Name'               => $filename,
 402         'Time'               => _dosToUnixTime($lastModTime),
 403         'Stream'             => $streamingMode,
 404
 405         'MethodID'           => $compressedMethod,
 406         'MethodName'         => $compressedMethod == 8
 407                                  ? "Deflated"
 408                                  : $compressedMethod == 0
 409                                      ? "Stored"
 410                                      : "Unknown" ,
 411
 412 #        'TextFlag'      => $flag & GZIP_FLG_FTEXT ? 1 : 0,
 413 #        'HeaderCRCFlag' => $flag & GZIP_FLG_FHCRC ? 1 : 0,
 414 #        'NameFlag'      => $flag & GZIP_FLG_FNAME ? 1 : 0,
 415 #        'CommentFlag'   => $flag & GZIP_FLG_FCOMMENT ? 1 : 0,
 416 #        'ExtraFlag'     => $flag & GZIP_FLG_FEXTRA ? 1 : 0,
 417 #        'Comment'       => $comment,
 418 #        'OsID'          => $os,
 419 #        'OsName'        => defined $GZIP_OS_Names{$os}
 420 #                                 ? $GZIP_OS_Names{$os} : "Unknown",
 421 #        'HeaderCRC'     => $HeaderCRC,
 422 #        'Flags'         => $flag,
 423 #        'ExtraFlags'    => $xfl,
 424 #        'ExtraFieldRaw' => $EXTRA,
 425 #        'ExtraField'    => [ @EXTRA ],
 426
 427
 428       }
 429 }
 430
 431 # from Archive::Zip
 432 sub _dosToUnixTime
 433 {
 434     #use Time::Local 'timelocal_nocheck';
 435     use Time::Local 'timelocal';
 436
 437         my $dt = shift;
 438
 439         my $year = ( ( $dt >> 25 ) & 0x7f ) + 80;
 440         my $mon  = ( ( $dt >> 21 ) & 0x0f ) - 1;
 441         my $mday = ( ( $dt >> 16 ) & 0x1f );
 442
 443         my $hour = ( ( $dt >> 11 ) & 0x1f );
 444         my $min  = ( ( $dt >> 5 ) & 0x3f );
 445         my $sec  = ( ( $dt << 1 ) & 0x3e );
 446
 447         # catch errors
 448         my $time_t =
 449           eval { timelocal( $sec, $min, $hour, $mday, $mon, $year ); };
 450         return 0
 451         if $@;
 452         return $time_t;
 453 }
 454
 455
 456 1;
 457
 458 __END__
 459