1package Archive::Zip::Archive; 2 3# Represents a generic ZIP archive 4 5use strict; 6use File::Path; 7use File::Find (); 8use File::Spec (); 9use File::Copy (); 10use File::Basename; 11use Cwd; 12use Encode qw(encode_utf8 decode_utf8); 13 14use vars qw( $VERSION @ISA ); 15 16BEGIN { 17 $VERSION = '1.68'; 18 @ISA = qw( Archive::Zip ); 19} 20 21use Archive::Zip qw( 22 :CONSTANTS 23 :ERROR_CODES 24 :PKZIP_CONSTANTS 25 :UTILITY_METHODS 26); 27 28our $UNICODE; 29our $UNTAINT = qr/\A(.+)\z/; 30 31# Note that this returns undef on read errors, else new zip object. 32 33sub new { 34 my $class = shift; 35 # Info-Zip 3.0 (I guess) seems to use the following values 36 # for the version fields in the zip64 EOCD record: 37 # 38 # version made by: 39 # 30 (plus upper byte indicating host system) 40 # 41 # version needed to extract: 42 # 45 43 my $self = bless( 44 { 45 'zip64' => 0, 46 'desiredZip64Mode' => ZIP64_AS_NEEDED, 47 'versionMadeBy' => 0, 48 'versionNeededToExtract' => 0, 49 'diskNumber' => 0, 50 'diskNumberWithStartOfCentralDirectory' => 51 0, 52 'numberOfCentralDirectoriesOnThisDisk' => 53 0, # should be # of members 54 'numberOfCentralDirectories' => 0, # should be # of members 55 'centralDirectorySize' => 0, # must re-compute on write 56 'centralDirectoryOffsetWRTStartingDiskNumber' => 57 0, # must re-compute 58 'writeEOCDOffset' => 0, 59 'writeCentralDirectoryOffset' => 0, 60 'zipfileComment' => '', 61 'eocdOffset' => 0, 62 'fileName' => '' 63 }, 64 $class 65 ); 66 $self->{'members'} = []; 67 my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; 68 if ($fileName) { 69 my $status = $self->read($fileName); 70 return $status == AZ_OK ? $self : undef; 71 } 72 return $self; 73} 74 75sub storeSymbolicLink { 76 my $self = shift; 77 $self->{'storeSymbolicLink'} = shift; 78} 79 80sub members { 81 @{shift->{'members'}}; 82} 83 84sub numberOfMembers { 85 scalar(shift->members()); 86} 87 88sub memberNames { 89 my $self = shift; 90 return map { $_->fileName() } $self->members(); 91} 92 93# return ref to member with given name or undef 94sub memberNamed { 95 my $self = shift; 96 my $fileName = (ref($_[0]) eq 'HASH') ? shift->{zipName} : shift; 97 foreach my $member ($self->members()) { 98 return $member if $member->fileName() eq $fileName; 99 } 100 return undef; 101} 102 103sub membersMatching { 104 my $self = shift; 105 my $pattern = (ref($_[0]) eq 'HASH') ? shift->{regex} : shift; 106 return grep { $_->fileName() =~ /$pattern/ } $self->members(); 107} 108 109sub zip64 { 110 shift->{'zip64'}; 111} 112 113sub desiredZip64Mode { 114 my $self = shift; 115 my $desiredZip64Mode = $self->{'desiredZip64Mode'}; 116 if (@_) { 117 $self->{'desiredZip64Mode'} = 118 ref($_[0]) eq 'HASH' ? shift->{desiredZip64Mode} : shift; 119 } 120 return $desiredZip64Mode; 121} 122 123sub versionMadeBy { 124 shift->{'versionMadeBy'}; 125} 126 127sub versionNeededToExtract { 128 shift->{'versionNeededToExtract'}; 129} 130 131sub diskNumber { 132 shift->{'diskNumber'}; 133} 134 135sub diskNumberWithStartOfCentralDirectory { 136 shift->{'diskNumberWithStartOfCentralDirectory'}; 137} 138 139sub numberOfCentralDirectoriesOnThisDisk { 140 shift->{'numberOfCentralDirectoriesOnThisDisk'}; 141} 142 143sub numberOfCentralDirectories { 144 shift->{'numberOfCentralDirectories'}; 145} 146 147sub centralDirectorySize { 148 shift->{'centralDirectorySize'}; 149} 150 151sub centralDirectoryOffsetWRTStartingDiskNumber { 152 shift->{'centralDirectoryOffsetWRTStartingDiskNumber'}; 153} 154 155sub zipfileComment { 156 my $self = shift; 157 my $comment = $self->{'zipfileComment'}; 158 if (@_) { 159 my $new_comment = (ref($_[0]) eq 'HASH') ? shift->{comment} : shift; 160 $self->{'zipfileComment'} = pack('C0a*', $new_comment); # avoid Unicode 161 } 162 return $comment; 163} 164 165sub eocdOffset { 166 shift->{'eocdOffset'}; 167} 168 169# Return the name of the file last read. 170sub fileName { 171 shift->{'fileName'}; 172} 173 174sub removeMember { 175 my $self = shift; 176 my $member = (ref($_[0]) eq 'HASH') ? shift->{memberOrZipName} : shift; 177 $member = $self->memberNamed($member) unless ref($member); 178 return undef unless $member; 179 my @newMembers = grep { $_ != $member } $self->members(); 180 $self->{'members'} = \@newMembers; 181 return $member; 182} 183 184sub replaceMember { 185 my $self = shift; 186 187 my ($oldMember, $newMember); 188 if (ref($_[0]) eq 'HASH') { 189 $oldMember = $_[0]->{memberOrZipName}; 190 $newMember = $_[0]->{newMember}; 191 } else { 192 ($oldMember, $newMember) = @_; 193 } 194 195 $oldMember = $self->memberNamed($oldMember) unless ref($oldMember); 196 return undef unless $oldMember; 197 return undef unless $newMember; 198 my @newMembers = 199 map { ($_ == $oldMember) ? $newMember : $_ } $self->members(); 200 $self->{'members'} = \@newMembers; 201 return $oldMember; 202} 203 204sub extractMember { 205 my $self = shift; 206 207 my ($member, $name); 208 if (ref($_[0]) eq 'HASH') { 209 $member = $_[0]->{memberOrZipName}; 210 $name = $_[0]->{name}; 211 } else { 212 ($member, $name) = @_; 213 } 214 215 $member = $self->memberNamed($member) unless ref($member); 216 return _error('member not found') unless $member; 217 my $originalSize = $member->compressedSize(); 218 my ($volumeName, $dirName, $fileName); 219 if (defined($name)) { 220 ($volumeName, $dirName, $fileName) = File::Spec->splitpath($name); 221 $dirName = File::Spec->catpath($volumeName, $dirName, ''); 222 } else { 223 $name = $member->fileName(); 224 if ((my $ret = _extractionNameIsSafe($name)) 225 != AZ_OK) { return $ret; } 226 ($dirName = $name) =~ s{[^/]*$}{}; 227 $dirName = Archive::Zip::_asLocalName($dirName); 228 $name = Archive::Zip::_asLocalName($name); 229 } 230 if ($dirName && !-d $dirName) { 231 mkpath($dirName); 232 return _ioError("can't create dir $dirName") if (!-d $dirName); 233 } 234 my $rc = $member->extractToFileNamed($name, @_); 235 236 # TODO refactor this fix into extractToFileNamed() 237 $member->{'compressedSize'} = $originalSize; 238 return $rc; 239} 240 241sub extractMemberWithoutPaths { 242 my $self = shift; 243 244 my ($member, $name); 245 if (ref($_[0]) eq 'HASH') { 246 $member = $_[0]->{memberOrZipName}; 247 $name = $_[0]->{name}; 248 } else { 249 ($member, $name) = @_; 250 } 251 252 $member = $self->memberNamed($member) unless ref($member); 253 return _error('member not found') unless $member; 254 my $originalSize = $member->compressedSize(); 255 return AZ_OK if $member->isDirectory(); 256 unless ($name) { 257 $name = $member->fileName(); 258 $name =~ s{.*/}{}; # strip off directories, if any 259 if ((my $ret = _extractionNameIsSafe($name)) 260 != AZ_OK) { return $ret; } 261 $name = Archive::Zip::_asLocalName($name); 262 } 263 my $rc = $member->extractToFileNamed($name, @_); 264 $member->{'compressedSize'} = $originalSize; 265 return $rc; 266} 267 268sub addMember { 269 my $self = shift; 270 my $newMember = (ref($_[0]) eq 'HASH') ? shift->{member} : shift; 271 push(@{$self->{'members'}}, $newMember) if $newMember; 272 if($newMember && ($newMember->{bitFlag} & 0x800) 273 && !utf8::is_utf8($newMember->{fileName})){ 274 $newMember->{fileName} = Encode::decode_utf8($newMember->{fileName}); 275 } 276 return $newMember; 277} 278 279sub addFile { 280 my $self = shift; 281 282 my ($fileName, $newName, $compressionLevel); 283 if (ref($_[0]) eq 'HASH') { 284 $fileName = $_[0]->{filename}; 285 $newName = $_[0]->{zipName}; 286 $compressionLevel = $_[0]->{compressionLevel}; 287 } else { 288 ($fileName, $newName, $compressionLevel) = @_; 289 } 290 291 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 292 $fileName = Win32::GetANSIPathName($fileName); 293 } 294 295 my $newMember = Archive::Zip::Member->newFromFile($fileName, $newName); 296 $newMember->desiredCompressionLevel($compressionLevel); 297 if ($self->{'storeSymbolicLink'} && -l $fileName) { 298 my $newMember = 299 Archive::Zip::Member->newFromString(readlink $fileName, $newName); 300 301 # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP 302 $newMember->{'externalFileAttributes'} = 0xA1FF0000; 303 $self->addMember($newMember); 304 } else { 305 $self->addMember($newMember); 306 } 307 308 return $newMember; 309} 310 311sub addString { 312 my $self = shift; 313 314 my ($stringOrStringRef, $name, $compressionLevel); 315 if (ref($_[0]) eq 'HASH') { 316 $stringOrStringRef = $_[0]->{string}; 317 $name = $_[0]->{zipName}; 318 $compressionLevel = $_[0]->{compressionLevel}; 319 } else { 320 ($stringOrStringRef, $name, $compressionLevel) = @_; 321 } 322 323 my $newMember = 324 Archive::Zip::Member->newFromString($stringOrStringRef, $name); 325 $newMember->desiredCompressionLevel($compressionLevel); 326 return $self->addMember($newMember); 327} 328 329sub addDirectory { 330 my $self = shift; 331 332 my ($name, $newName); 333 if (ref($_[0]) eq 'HASH') { 334 $name = $_[0]->{directoryName}; 335 $newName = $_[0]->{zipName}; 336 } else { 337 ($name, $newName) = @_; 338 } 339 340 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 341 $name = Win32::GetANSIPathName($name); 342 } 343 344 my $newMember = Archive::Zip::Member->newDirectoryNamed($name, $newName); 345 if ($self->{'storeSymbolicLink'} && -l $name) { 346 my $link = readlink $name; 347 ($newName =~ s{/$}{}) if $newName; # Strip trailing / 348 my $newMember = Archive::Zip::Member->newFromString($link, $newName); 349 350 # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP 351 $newMember->{'externalFileAttributes'} = 0xA1FF0000; 352 $self->addMember($newMember); 353 } else { 354 $self->addMember($newMember); 355 } 356 357 return $newMember; 358} 359 360# add either a file or a directory. 361 362sub addFileOrDirectory { 363 my $self = shift; 364 365 my ($name, $newName, $compressionLevel); 366 if (ref($_[0]) eq 'HASH') { 367 $name = $_[0]->{name}; 368 $newName = $_[0]->{zipName}; 369 $compressionLevel = $_[0]->{compressionLevel}; 370 } else { 371 ($name, $newName, $compressionLevel) = @_; 372 } 373 374 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 375 $name = Win32::GetANSIPathName($name); 376 } 377 378 $name =~ s{/$}{}; 379 if ($newName) { 380 $newName =~ s{/$}{}; 381 } else { 382 $newName = $name; 383 } 384 if (-f $name) { 385 return $self->addFile($name, $newName, $compressionLevel); 386 } elsif (-d $name) { 387 return $self->addDirectory($name, $newName); 388 } else { 389 return _error("$name is neither a file nor a directory"); 390 } 391} 392 393sub contents { 394 my $self = shift; 395 396 my ($member, $newContents); 397 if (ref($_[0]) eq 'HASH') { 398 $member = $_[0]->{memberOrZipName}; 399 $newContents = $_[0]->{contents}; 400 } else { 401 ($member, $newContents) = @_; 402 } 403 404 my ($contents, $status) = (undef, AZ_OK); 405 if ($status == AZ_OK) { 406 $status = _error('No member name given') unless defined($member); 407 } 408 if ($status == AZ_OK && ! ref($member)) { 409 my $memberName = $member; 410 $member = $self->memberNamed($memberName); 411 $status = _error('No member named $memberName') unless defined($member); 412 } 413 if ($status == AZ_OK) { 414 ($contents, $status) = $member->contents($newContents); 415 } 416 417 return 418 wantarray 419 ? ($contents, $status) 420 : $contents; 421} 422 423sub writeToFileNamed { 424 my $self = shift; 425 my $fileName = 426 (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; # local FS format 427 foreach my $member ($self->members()) { 428 if ($member->_usesFileNamed($fileName)) { 429 return _error("$fileName is needed by member " 430 . $member->fileName() 431 . "; consider using overwrite() or overwriteAs() instead."); 432 } 433 } 434 my ($status, $fh) = _newFileHandle($fileName, 'w'); 435 return _ioError("Can't open $fileName for write") unless $status; 436 $status = $self->writeToFileHandle($fh, 1); 437 $fh->close(); 438 $fh = undef; 439 440 return $status; 441} 442 443# It is possible to write data to the FH before calling this, 444# perhaps to make a self-extracting archive. 445sub writeToFileHandle { 446 my $self = shift; 447 448 my ($fh, $fhIsSeekable); 449 if (ref($_[0]) eq 'HASH') { 450 $fh = $_[0]->{fileHandle}; 451 $fhIsSeekable = 452 exists($_[0]->{seek}) ? $_[0]->{seek} : _isSeekable($fh); 453 } else { 454 $fh = shift; 455 $fhIsSeekable = @_ ? shift : _isSeekable($fh); 456 } 457 458 return _error('No filehandle given') unless $fh; 459 return _ioError('filehandle not open') unless $fh->opened(); 460 _binmode($fh); 461 462 # Find out where the current position is. 463 my $offset = $fhIsSeekable ? $fh->tell() : 0; 464 $offset = 0 if $offset < 0; 465 466 # (Re-)set the "was-successfully-written" flag so that the 467 # contract advertised in the documentation ("that member and 468 # *all following it* will return false from wasWritten()") 469 # also holds for members written more than once. 470 # 471 # Not sure whether that mechanism works, anyway. If method 472 # $member->_writeToFileHandle fails with an error below and 473 # user continues with calling $zip->writeCentralDirectory 474 # manually, we should end up with the following picture 475 # unless the user seeks back to writeCentralDirectoryOffset: 476 # 477 # ... 478 # [last successfully written member] 479 # <- writeCentralDirectoryOffset points here 480 # [half-written member junk with unknown size] 481 # [central directory entry 0] 482 # ... 483 foreach my $member ($self->members()) { 484 $member->{'wasWritten'} = 0; 485 } 486 487 foreach my $member ($self->members()) { 488 489 # (Re-)set object member zip64 flag. Here is what 490 # happens next to that flag: 491 # 492 # $member->_writeToFileHandle 493 # Determines a local flag value depending on 494 # necessity and user desire and ors it to 495 # the object member 496 # $member->_writeLocalFileHeader 497 # Queries the object member to write appropriate 498 # local header 499 # $member->_writeDataDescriptor 500 # Queries the object member to write appropriate 501 # data descriptor 502 # $member->_writeCentralDirectoryFileHeader 503 # Determines a local flag value depending on 504 # necessity and user desire. Writes a central 505 # directory header appropriate to the local flag. 506 # Ors the local flag to the object member. 507 $member->{'zip64'} = 0; 508 509 my ($status, $memberSize) = 510 $member->_writeToFileHandle($fh, $fhIsSeekable, $offset, 511 $self->desiredZip64Mode()); 512 $member->endRead(); 513 return $status if $status != AZ_OK; 514 515 $offset += $memberSize; 516 517 # Change this so it reflects write status and last 518 # successful position 519 $member->{'wasWritten'} = 1; 520 $self->{'writeCentralDirectoryOffset'} = $offset; 521 } 522 523 return $self->writeCentralDirectory($fh); 524} 525 526# Write zip back to the original file, 527# as safely as possible. 528# Returns AZ_OK if successful. 529sub overwrite { 530 my $self = shift; 531 return $self->overwriteAs($self->{'fileName'}); 532} 533 534# Write zip to the specified file, 535# as safely as possible. 536# Returns AZ_OK if successful. 537sub overwriteAs { 538 my $self = shift; 539 my $zipName = (ref($_[0]) eq 'HASH') ? $_[0]->{filename} : shift; 540 return _error("no filename in overwriteAs()") unless defined($zipName); 541 542 my ($fh, $tempName) = Archive::Zip::tempFile(); 543 return _error("Can't open temp file", $!) unless $fh; 544 545 (my $backupName = $zipName) =~ s{(\.[^.]*)?$}{.zbk}; 546 547 my $status = $self->writeToFileHandle($fh); 548 $fh->close(); 549 $fh = undef; 550 551 if ($status != AZ_OK) { 552 unlink($tempName); 553 _printError("Can't write to $tempName"); 554 return $status; 555 } 556 557 my $err; 558 559 # rename the zip 560 if (-f $zipName && !rename($zipName, $backupName)) { 561 $err = $!; 562 unlink($tempName); 563 return _error("Can't rename $zipName as $backupName", $err); 564 } 565 566 # move the temp to the original name (possibly copying) 567 unless (File::Copy::move($tempName, $zipName) 568 || File::Copy::copy($tempName, $zipName)) { 569 $err = $!; 570 rename($backupName, $zipName); 571 unlink($tempName); 572 return _error("Can't move $tempName to $zipName", $err); 573 } 574 575 # unlink the backup 576 if (-f $backupName && !unlink($backupName)) { 577 $err = $!; 578 return _error("Can't unlink $backupName", $err); 579 } 580 581 return AZ_OK; 582} 583 584# Used only during writing 585sub _writeCentralDirectoryOffset { 586 shift->{'writeCentralDirectoryOffset'}; 587} 588 589sub _writeEOCDOffset { 590 shift->{'writeEOCDOffset'}; 591} 592 593# Expects to have _writeEOCDOffset() set 594sub _writeEndOfCentralDirectory { 595 my ($self, $fh, $membersZip64) = @_; 596 597 my $zip64 = 0; 598 my $versionMadeBy = $self->versionMadeBy(); 599 my $versionNeededToExtract = $self->versionNeededToExtract(); 600 my $diskNumber = 0; 601 my $diskNumberWithStartOfCentralDirectory = 0; 602 my $numberOfCentralDirectoriesOnThisDisk = $self->numberOfMembers(); 603 my $numberOfCentralDirectories = $self->numberOfMembers(); 604 my $centralDirectorySize = 605 $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(); 606 my $centralDirectoryOffsetWRTStartingDiskNumber = 607 $self->_writeCentralDirectoryOffset(); 608 my $zipfileCommentLength = length($self->zipfileComment()); 609 610 my $eocdDataZip64 = 0; 611 $eocdDataZip64 ||= $numberOfCentralDirectoriesOnThisDisk > 0xffff; 612 $eocdDataZip64 ||= $numberOfCentralDirectories > 0xffff; 613 $eocdDataZip64 ||= $centralDirectorySize > 0xffffffff; 614 $eocdDataZip64 ||= $centralDirectoryOffsetWRTStartingDiskNumber > 0xffffffff; 615 616 if ( $membersZip64 617 || $eocdDataZip64 618 || $self->desiredZip64Mode() == ZIP64_EOCD) { 619 return _zip64NotSupported() unless ZIP64_SUPPORTED; 620 621 $zip64 = 1; 622 $versionMadeBy = 45 if ($versionMadeBy == 0); 623 $versionNeededToExtract = 45 if ($versionNeededToExtract < 45); 624 625 $self->_print($fh, ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE_STRING) 626 or return _ioError('writing zip64 EOCD record signature'); 627 628 my $record = pack( 629 ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_FORMAT, 630 ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH + 631 SIGNATURE_LENGTH - 12, 632 $versionMadeBy, 633 $versionNeededToExtract, 634 $diskNumber, 635 $diskNumberWithStartOfCentralDirectory, 636 $numberOfCentralDirectoriesOnThisDisk, 637 $numberOfCentralDirectories, 638 $centralDirectorySize, 639 $centralDirectoryOffsetWRTStartingDiskNumber 640 ); 641 $self->_print($fh, $record) 642 or return _ioError('writing zip64 EOCD record'); 643 644 $self->_print($fh, ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_SIGNATURE_STRING) 645 or return _ioError('writing zip64 EOCD locator signature'); 646 647 my $locator = pack( 648 ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_FORMAT, 649 0, 650 $self->_writeEOCDOffset(), 651 1 652 ); 653 $self->_print($fh, $locator) 654 or return _ioError('writing zip64 EOCD locator'); 655 } 656 657 $self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING) 658 or return _ioError('writing EOCD Signature'); 659 660 my $header = pack( 661 END_OF_CENTRAL_DIRECTORY_FORMAT, 662 $diskNumber, 663 $diskNumberWithStartOfCentralDirectory, 664 $numberOfCentralDirectoriesOnThisDisk > 0xffff 665 ? 0xffff : $numberOfCentralDirectoriesOnThisDisk, 666 $numberOfCentralDirectories > 0xffff 667 ? 0xffff : $numberOfCentralDirectories, 668 $centralDirectorySize > 0xffffffff 669 ? 0xffffffff : $centralDirectorySize, 670 $centralDirectoryOffsetWRTStartingDiskNumber > 0xffffffff 671 ? 0xffffffff : $centralDirectoryOffsetWRTStartingDiskNumber, 672 $zipfileCommentLength 673 ); 674 $self->_print($fh, $header) 675 or return _ioError('writing EOCD header'); 676 if ($zipfileCommentLength) { 677 $self->_print($fh, $self->zipfileComment()) 678 or return _ioError('writing zipfile comment'); 679 } 680 681 # Adjust object members related to zip64 format 682 $self->{'zip64'} = $zip64; 683 $self->{'versionMadeBy'} = $versionMadeBy; 684 $self->{'versionNeededToExtract'} = $versionNeededToExtract; 685 686 return AZ_OK; 687} 688 689# $offset can be specified to truncate a zip file. 690sub writeCentralDirectory { 691 my $self = shift; 692 693 my ($fh, $offset); 694 if (ref($_[0]) eq 'HASH') { 695 $fh = $_[0]->{fileHandle}; 696 $offset = $_[0]->{offset}; 697 } else { 698 ($fh, $offset) = @_; 699 } 700 701 if (defined($offset)) { 702 $self->{'writeCentralDirectoryOffset'} = $offset; 703 $fh->seek($offset, IO::Seekable::SEEK_SET) 704 or return _ioError('seeking to write central directory'); 705 } else { 706 $offset = $self->_writeCentralDirectoryOffset(); 707 } 708 709 my $membersZip64 = 0; 710 foreach my $member ($self->members()) { 711 my ($status, $headerSize) = 712 $member->_writeCentralDirectoryFileHeader($fh, $self->desiredZip64Mode()); 713 return $status if $status != AZ_OK; 714 $membersZip64 ||= $member->zip64(); 715 $offset += $headerSize; 716 $self->{'writeEOCDOffset'} = $offset; 717 } 718 719 return $self->_writeEndOfCentralDirectory($fh, $membersZip64); 720} 721 722sub read { 723 my $self = shift; 724 my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; 725 return _error('No filename given') unless $fileName; 726 my ($status, $fh) = _newFileHandle($fileName, 'r'); 727 return _ioError("opening $fileName for read") unless $status; 728 729 $status = $self->readFromFileHandle($fh, $fileName); 730 return $status if $status != AZ_OK; 731 732 $fh->close(); 733 $self->{'fileName'} = $fileName; 734 return AZ_OK; 735} 736 737sub readFromFileHandle { 738 my $self = shift; 739 740 my ($fh, $fileName); 741 if (ref($_[0]) eq 'HASH') { 742 $fh = $_[0]->{fileHandle}; 743 $fileName = $_[0]->{filename}; 744 } else { 745 ($fh, $fileName) = @_; 746 } 747 748 $fileName = $fh unless defined($fileName); 749 return _error('No filehandle given') unless $fh; 750 return _ioError('filehandle not open') unless $fh->opened(); 751 752 _binmode($fh); 753 $self->{'fileName'} = "$fh"; 754 755 # TODO: how to support non-seekable zips? 756 return _error('file not seekable') 757 unless _isSeekable($fh); 758 759 $fh->seek(0, 0); # rewind the file 760 761 my $status = $self->_findEndOfCentralDirectory($fh); 762 return $status if $status != AZ_OK; 763 764 my $eocdPosition; 765 ($status, $eocdPosition) = $self->_readEndOfCentralDirectory($fh, $fileName); 766 return $status if $status != AZ_OK; 767 768 my $zip64 = $self->zip64(); 769 770 $fh->seek($eocdPosition - $self->centralDirectorySize(), 771 IO::Seekable::SEEK_SET) 772 or return _ioError("Can't seek $fileName"); 773 774 # Try to detect garbage at beginning of archives 775 # This should be 0 776 $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here 777 - $self->centralDirectoryOffsetWRTStartingDiskNumber(); 778 779 for (; ;) { 780 my $newMember = 781 Archive::Zip::Member->_newFromZipFile($fh, $fileName, $zip64, 782 $self->eocdOffset()); 783 my $signature; 784 ($status, $signature) = _readSignature($fh, $fileName); 785 return $status if $status != AZ_OK; 786 if (! $zip64) { 787 last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE; 788 } 789 else { 790 last if $signature == ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE; 791 } 792 $status = $newMember->_readCentralDirectoryFileHeader(); 793 return $status if $status != AZ_OK; 794 $status = $newMember->endRead(); 795 return $status if $status != AZ_OK; 796 797 if ($newMember->isDirectory()) { 798 $newMember->_become('Archive::Zip::DirectoryMember'); 799 # Ensure above call suceeded to avoid future trouble 800 $newMember->_ISA('Archive::Zip::DirectoryMember') or 801 return $self->_error('becoming Archive::Zip::DirectoryMember'); 802 } 803 804 if(($newMember->{bitFlag} & 0x800) && !utf8::is_utf8($newMember->{fileName})){ 805 $newMember->{fileName} = Encode::decode_utf8($newMember->{fileName}); 806 } 807 808 push(@{$self->{'members'}}, $newMember); 809 } 810 811 return AZ_OK; 812} 813 814# Read EOCD, starting from position before signature. 815# Checks for a zip64 EOCD record and uses that if present. 816# 817# Return AZ_OK (in scalar context) or a pair (AZ_OK, 818# $eocdPosition) (in list context) on success: 819# ( $status, $eocdPosition ) = $zip->_readEndOfCentralDirectory( $fh, $fileName ); 820# where the returned EOCD position either points to the beginning 821# of the EOCD or to the beginning of the zip64 EOCD record. 822# 823# APPNOTE.TXT as of version 6.3.6 is a bit vague on the 824# "ZIP64(tm) format". It has a lot of conditions like "if an 825# archive is in ZIP64 format", but never explicitly mentions 826# *when* an archive is in that format. (Or at least I haven't 827# found it.) 828# 829# So I decided that an archive is in ZIP64 format if zip64 EOCD 830# locator and zip64 EOCD record are present before the EOCD with 831# the format given in the specification. 832sub _readEndOfCentralDirectory { 833 my $self = shift; 834 my $fh = shift; 835 my $fileName = shift; 836 837 # Remember current position, which is just before the EOCD 838 # signature 839 my $eocdPosition = $fh->tell(); 840 841 # Reset the zip64 format flag 842 $self->{'zip64'} = 0; 843 my $zip64EOCDPosition; 844 845 # Check for zip64 EOCD locator and zip64 EOCD record. Be 846 # extra careful here to not interpret any random data as 847 # zip64 data structures. If in doubt, silently continue 848 # reading the regular EOCD. 849 NOZIP64: 850 { 851 # Do not even start looking for any zip64 structures if 852 # that would not be supported. 853 if (! ZIP64_SUPPORTED) { 854 last NOZIP64; 855 } 856 857 if ($eocdPosition < ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH + SIGNATURE_LENGTH) { 858 last NOZIP64; 859 } 860 861 # Skip to before potential zip64 EOCD locator 862 $fh->seek(-(ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH) - SIGNATURE_LENGTH, 863 IO::Seekable::SEEK_CUR) 864 or return _ioError("seeking to before zip 64 EOCD locator"); 865 my $zip64EOCDLocatorPosition = 866 $eocdPosition - ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH - SIGNATURE_LENGTH; 867 868 my $status; 869 my $bytesRead; 870 871 # Read potential zip64 EOCD locator signature 872 $status = 873 _readSignature($fh, $fileName, 874 ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_SIGNATURE, 1); 875 return $status if $status == AZ_IO_ERROR; 876 if ($status == AZ_FORMAT_ERROR) { 877 $fh->seek($eocdPosition, IO::Seekable::SEEK_SET) 878 or return _ioError("seeking to EOCD"); 879 last NOZIP64; 880 } 881 882 # Read potential zip64 EOCD locator and verify it 883 my $locator = ''; 884 $bytesRead = $fh->read($locator, ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH); 885 if ($bytesRead != ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH) { 886 return _ioError("reading zip64 EOCD locator"); 887 } 888 (undef, $zip64EOCDPosition, undef) = 889 unpack(ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_FORMAT, $locator); 890 if ($zip64EOCDPosition > 891 ($zip64EOCDLocatorPosition - ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH - SIGNATURE_LENGTH)) { 892 # No need to seek to EOCD since we're already there 893 last NOZIP64; 894 } 895 896 # Skip to potential zip64 EOCD record 897 $fh->seek($zip64EOCDPosition, IO::Seekable::SEEK_SET) 898 or return _ioError("seeking to zip64 EOCD record"); 899 900 # Read potential zip64 EOCD record signature 901 $status = 902 _readSignature($fh, $fileName, 903 ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE, 1); 904 return $status if $status == AZ_IO_ERROR; 905 if ($status == AZ_FORMAT_ERROR) { 906 $fh->seek($eocdPosition, IO::Seekable::SEEK_SET) 907 or return _ioError("seeking to EOCD"); 908 last NOZIP64; 909 } 910 911 # Read potential zip64 EOCD record. Ignore the zip64 912 # extensible data sector. 913 my $record = ''; 914 $bytesRead = $fh->read($record, ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH); 915 if ($bytesRead != ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH) { 916 return _ioError("reading zip64 EOCD record"); 917 } 918 919 # Perform one final check, hoping that all implementors 920 # follow the recommendation of the specification 921 # regarding the size of the zip64 EOCD record 922 my ($zip64EODCRecordSize) = unpack("Q<", $record); 923 if ($zip64EOCDPosition + 12 + $zip64EODCRecordSize != $zip64EOCDLocatorPosition) { 924 $fh->seek($eocdPosition, IO::Seekable::SEEK_SET) 925 or return _ioError("seeking to EOCD"); 926 last NOZIP64; 927 } 928 929 $self->{'zip64'} = 1; 930 ( 931 undef, 932 $self->{'versionMadeBy'}, 933 $self->{'versionNeededToExtract'}, 934 $self->{'diskNumber'}, 935 $self->{'diskNumberWithStartOfCentralDirectory'}, 936 $self->{'numberOfCentralDirectoriesOnThisDisk'}, 937 $self->{'numberOfCentralDirectories'}, 938 $self->{'centralDirectorySize'}, 939 $self->{'centralDirectoryOffsetWRTStartingDiskNumber'} 940 ) = unpack(ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_FORMAT, $record); 941 942 # Don't just happily bail out, we still need to read the 943 # zip file comment! 944 $fh->seek($eocdPosition, IO::Seekable::SEEK_SET) 945 or return _ioError("seeking to EOCD"); 946 } 947 948 # Skip past signature 949 $fh->seek(SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR) 950 or return _ioError("seeking past EOCD signature"); 951 952 my $header = ''; 953 my $bytesRead = $fh->read($header, END_OF_CENTRAL_DIRECTORY_LENGTH); 954 if ($bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH) { 955 return _ioError("reading end of central directory"); 956 } 957 958 my $zipfileCommentLength; 959 if (! $self->{'zip64'}) { 960 ( 961 $self->{'diskNumber'}, 962 $self->{'diskNumberWithStartOfCentralDirectory'}, 963 $self->{'numberOfCentralDirectoriesOnThisDisk'}, 964 $self->{'numberOfCentralDirectories'}, 965 $self->{'centralDirectorySize'}, 966 $self->{'centralDirectoryOffsetWRTStartingDiskNumber'}, 967 $zipfileCommentLength 968 ) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header); 969 970 if ( $self->{'diskNumber'} == 0xffff 971 || $self->{'diskNumberWithStartOfCentralDirectory'} == 0xffff 972 || $self->{'numberOfCentralDirectoriesOnThisDisk'} == 0xffff 973 || $self->{'numberOfCentralDirectories'} == 0xffff 974 || $self->{'centralDirectorySize'} == 0xffffffff 975 || $self->{'centralDirectoryOffsetWRTStartingDiskNumber'} == 0xffffffff) { 976 if (ZIP64_SUPPORTED) { 977 return _formatError("unexpected zip64 marker values in EOCD"); 978 } 979 else { 980 return _zip64NotSupported(); 981 } 982 } 983 } 984 else { 985 ( 986 undef, 987 undef, 988 undef, 989 undef, 990 undef, 991 undef, 992 $zipfileCommentLength 993 ) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header); 994 } 995 996 if ($zipfileCommentLength) { 997 my $zipfileComment = ''; 998 $bytesRead = $fh->read($zipfileComment, $zipfileCommentLength); 999 if ($bytesRead != $zipfileCommentLength) { 1000 return _ioError("reading zipfile comment"); 1001 } 1002 $self->{'zipfileComment'} = $zipfileComment; 1003 } 1004 1005 if (! $self->{'zip64'}) { 1006 return 1007 wantarray 1008 ? (AZ_OK, $eocdPosition) 1009 : AZ_OK; 1010 } 1011 else { 1012 return 1013 wantarray 1014 ? (AZ_OK, $zip64EOCDPosition) 1015 : AZ_OK; 1016 } 1017} 1018 1019# Seek in my file to the end, then read backwards until we find the 1020# signature of the central directory record. Leave the file positioned right 1021# before the signature. Returns AZ_OK if success. 1022sub _findEndOfCentralDirectory { 1023 my $self = shift; 1024 my $fh = shift; 1025 my $data = ''; 1026 $fh->seek(0, IO::Seekable::SEEK_END) 1027 or return _ioError("seeking to end"); 1028 1029 my $fileLength = $fh->tell(); 1030 if ($fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4) { 1031 return _formatError("file is too short"); 1032 } 1033 1034 my $seekOffset = 0; 1035 my $pos = -1; 1036 for (; ;) { 1037 $seekOffset += 512; 1038 $seekOffset = $fileLength if ($seekOffset > $fileLength); 1039 $fh->seek(-$seekOffset, IO::Seekable::SEEK_END) 1040 or return _ioError("seek failed"); 1041 my $bytesRead = $fh->read($data, $seekOffset); 1042 if ($bytesRead != $seekOffset) { 1043 return _ioError("read failed"); 1044 } 1045 $pos = rindex($data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING); 1046 last 1047 if ( $pos >= 0 1048 or $seekOffset == $fileLength 1049 or $seekOffset >= $Archive::Zip::ChunkSize); 1050 } 1051 1052 if ($pos >= 0) { 1053 $fh->seek($pos - $seekOffset, IO::Seekable::SEEK_CUR) 1054 or return _ioError("seeking to EOCD"); 1055 return AZ_OK; 1056 } else { 1057 return _formatError("can't find EOCD signature"); 1058 } 1059} 1060 1061# Used to avoid taint problems when chdir'ing. 1062# Not intended to increase security in any way; just intended to shut up the -T 1063# complaints. If your Cwd module is giving you unreliable returns from cwd() 1064# you have bigger problems than this. 1065sub _untaintDir { 1066 my $dir = shift; 1067 $dir =~ m/$UNTAINT/s; 1068 return $1; 1069} 1070 1071sub addTree { 1072 my $self = shift; 1073 1074 my ($root, $dest, $pred, $compressionLevel); 1075 if (ref($_[0]) eq 'HASH') { 1076 $root = $_[0]->{root}; 1077 $dest = $_[0]->{zipName}; 1078 $pred = $_[0]->{select}; 1079 $compressionLevel = $_[0]->{compressionLevel}; 1080 } else { 1081 ($root, $dest, $pred, $compressionLevel) = @_; 1082 } 1083 1084 return _error("root arg missing in call to addTree()") 1085 unless defined($root); 1086 $dest = '' unless defined($dest); 1087 $pred = sub { -r } 1088 unless defined($pred); 1089 1090 my @files; 1091 my $startDir = _untaintDir(cwd()); 1092 1093 return _error('undef returned by _untaintDir on cwd ', cwd()) 1094 unless $startDir; 1095 1096 # This avoids chdir'ing in Find, in a way compatible with older 1097 # versions of File::Find. 1098 my $wanted = sub { 1099 local $main::_ = $File::Find::name; 1100 my $dir = _untaintDir($File::Find::dir); 1101 chdir($startDir); 1102 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 1103 push(@files, Win32::GetANSIPathName($File::Find::name)) if (&$pred); 1104 $dir = Win32::GetANSIPathName($dir); 1105 } else { 1106 push(@files, $File::Find::name) if (&$pred); 1107 } 1108 chdir($dir); 1109 }; 1110 1111 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 1112 $root = Win32::GetANSIPathName($root); 1113 } 1114 # File::Find will not untaint unless you explicitly pass the flag and regex pattern. 1115 File::Find::find({ wanted => $wanted, untaint => 1, untaint_pattern => $UNTAINT }, $root); 1116 1117 my $rootZipName = _asZipDirName($root, 1); # with trailing slash 1118 my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; 1119 1120 $dest = _asZipDirName($dest, 1); # with trailing slash 1121 1122 foreach my $fileName (@files) { 1123 my $isDir; 1124 if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { 1125 $isDir = -d Win32::GetANSIPathName($fileName); 1126 } else { 1127 $isDir = -d $fileName; 1128 } 1129 1130 # normalize, remove leading ./ 1131 my $archiveName = _asZipDirName($fileName, $isDir); 1132 if ($archiveName eq $rootZipName) { $archiveName = $dest } 1133 else { $archiveName =~ s{$pattern}{$dest} } 1134 next if $archiveName =~ m{^\.?/?$}; # skip current dir 1135 my $member = 1136 $isDir 1137 ? $self->addDirectory($fileName, $archiveName) 1138 : $self->addFile($fileName, $archiveName); 1139 $member->desiredCompressionLevel($compressionLevel); 1140 1141 return _error("add $fileName failed in addTree()") if !$member; 1142 } 1143 return AZ_OK; 1144} 1145 1146sub addTreeMatching { 1147 my $self = shift; 1148 1149 my ($root, $dest, $pattern, $pred, $compressionLevel); 1150 if (ref($_[0]) eq 'HASH') { 1151 $root = $_[0]->{root}; 1152 $dest = $_[0]->{zipName}; 1153 $pattern = $_[0]->{pattern}; 1154 $pred = $_[0]->{select}; 1155 $compressionLevel = $_[0]->{compressionLevel}; 1156 } else { 1157 ($root, $dest, $pattern, $pred, $compressionLevel) = @_; 1158 } 1159 1160 return _error("root arg missing in call to addTreeMatching()") 1161 unless defined($root); 1162 $dest = '' unless defined($dest); 1163 return _error("pattern missing in call to addTreeMatching()") 1164 unless defined($pattern); 1165 my $matcher = 1166 $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r }; 1167 return $self->addTree($root, $dest, $matcher, $compressionLevel); 1168} 1169 1170# Check if one of the components of a path to the file or the file name 1171# itself is an already existing symbolic link. If yes then return an 1172# error. Continuing and writing to a file traversing a link posseses 1173# a security threat, especially if the link was extracted from an 1174# attacker-supplied archive. This would allow writing to an arbitrary 1175# file. The same applies when using ".." to escape from a working 1176# directory. <https://bugzilla.redhat.com/show_bug.cgi?id=1591449> 1177sub _extractionNameIsSafe { 1178 my $name = shift; 1179 my ($volume, $directories) = File::Spec->splitpath($name, 1); 1180 my @directories = File::Spec->splitdir($directories); 1181 if (grep '..' eq $_, @directories) { 1182 return _error( 1183 "Could not extract $name safely: a parent directory is used"); 1184 } 1185 my @path; 1186 my $path; 1187 for my $directory (@directories) { 1188 push @path, $directory; 1189 $path = File::Spec->catpath($volume, File::Spec->catdir(@path), ''); 1190 if (-l $path) { 1191 return _error( 1192 "Could not extract $name safely: $path is an existing symbolic link"); 1193 } 1194 if (!-e $path) { 1195 last; 1196 } 1197 } 1198 return AZ_OK; 1199} 1200 1201# $zip->extractTree( $root, $dest [, $volume] ); 1202# 1203# $root and $dest are Unix-style. 1204# $volume is in local FS format. 1205# 1206sub extractTree { 1207 my $self = shift; 1208 1209 my ($root, $dest, $volume); 1210 if (ref($_[0]) eq 'HASH') { 1211 $root = $_[0]->{root}; 1212 $dest = $_[0]->{zipName}; 1213 $volume = $_[0]->{volume}; 1214 } else { 1215 ($root, $dest, $volume) = @_; 1216 } 1217 1218 $root = '' unless defined($root); 1219 if (defined $dest) { 1220 if ($dest !~ m{/$}) { 1221 $dest .= '/'; 1222 } 1223 } else { 1224 $dest = './'; 1225 } 1226 1227 my $pattern = "^\Q$root"; 1228 my @members = $self->membersMatching($pattern); 1229 1230 foreach my $member (@members) { 1231 my $fileName = $member->fileName(); # in Unix format 1232 $fileName =~ s{$pattern}{$dest}; # in Unix format 1233 # convert to platform format: 1234 $fileName = Archive::Zip::_asLocalName($fileName, $volume); 1235 if ((my $ret = _extractionNameIsSafe($fileName)) 1236 != AZ_OK) { return $ret; } 1237 my $status = $member->extractToFileNamed($fileName); 1238 return $status if $status != AZ_OK; 1239 } 1240 return AZ_OK; 1241} 1242 1243# $zip->updateMember( $memberOrName, $fileName ); 1244# Returns (possibly updated) member, if any; undef on errors. 1245 1246sub updateMember { 1247 my $self = shift; 1248 1249 my ($oldMember, $fileName); 1250 if (ref($_[0]) eq 'HASH') { 1251 $oldMember = $_[0]->{memberOrZipName}; 1252 $fileName = $_[0]->{name}; 1253 } else { 1254 ($oldMember, $fileName) = @_; 1255 } 1256 1257 if (!defined($fileName)) { 1258 _error("updateMember(): missing fileName argument"); 1259 return undef; 1260 } 1261 1262 my @newStat = stat($fileName); 1263 if (!@newStat) { 1264 _ioError("Can't stat $fileName"); 1265 return undef; 1266 } 1267 1268 my $isDir = -d _; 1269 1270 my $memberName; 1271 1272 if (ref($oldMember)) { 1273 $memberName = $oldMember->fileName(); 1274 } else { 1275 $oldMember = $self->memberNamed($memberName = $oldMember) 1276 || $self->memberNamed($memberName = 1277 _asZipDirName($oldMember, $isDir)); 1278 } 1279 1280 unless (defined($oldMember) 1281 && $oldMember->lastModTime() == $newStat[9] 1282 && $oldMember->isDirectory() == $isDir 1283 && ($isDir || ($oldMember->uncompressedSize() == $newStat[7]))) { 1284 1285 # create the new member 1286 my $newMember = 1287 $isDir 1288 ? Archive::Zip::Member->newDirectoryNamed($fileName, $memberName) 1289 : Archive::Zip::Member->newFromFile($fileName, $memberName); 1290 1291 unless (defined($newMember)) { 1292 _error("creation of member $fileName failed in updateMember()"); 1293 return undef; 1294 } 1295 1296 # replace old member or append new one 1297 if (defined($oldMember)) { 1298 $self->replaceMember($oldMember, $newMember); 1299 } else { 1300 $self->addMember($newMember); 1301 } 1302 1303 return $newMember; 1304 } 1305 1306 return $oldMember; 1307} 1308 1309# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] ); 1310# 1311# This takes the same arguments as addTree, but first checks to see 1312# whether the file or directory already exists in the zip file. 1313# 1314# If the fourth argument $mirror is true, then delete all my members 1315# if corresponding files were not found. 1316 1317sub updateTree { 1318 my $self = shift; 1319 1320 my ($root, $dest, $pred, $mirror, $compressionLevel); 1321 if (ref($_[0]) eq 'HASH') { 1322 $root = $_[0]->{root}; 1323 $dest = $_[0]->{zipName}; 1324 $pred = $_[0]->{select}; 1325 $mirror = $_[0]->{mirror}; 1326 $compressionLevel = $_[0]->{compressionLevel}; 1327 } else { 1328 ($root, $dest, $pred, $mirror, $compressionLevel) = @_; 1329 } 1330 1331 return _error("root arg missing in call to updateTree()") 1332 unless defined($root); 1333 $dest = '' unless defined($dest); 1334 $pred = sub { -r } 1335 unless defined($pred); 1336 1337 $dest = _asZipDirName($dest, 1); 1338 my $rootZipName = _asZipDirName($root, 1); # with trailing slash 1339 my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; 1340 1341 my @files; 1342 my $startDir = _untaintDir(cwd()); 1343 1344 return _error('undef returned by _untaintDir on cwd ', cwd()) 1345 unless $startDir; 1346 1347 # This avoids chdir'ing in Find, in a way compatible with older 1348 # versions of File::Find. 1349 my $wanted = sub { 1350 local $main::_ = $File::Find::name; 1351 my $dir = _untaintDir($File::Find::dir); 1352 chdir($startDir); 1353 push(@files, $File::Find::name) if (&$pred); 1354 chdir($dir); 1355 }; 1356 1357 File::Find::find($wanted, $root); 1358 1359 # Now @files has all the files that I could potentially be adding to 1360 # the zip. Only add the ones that are necessary. 1361 # For each file (updated or not), add its member name to @done. 1362 my %done; 1363 foreach my $fileName (@files) { 1364 my @newStat = stat($fileName); 1365 my $isDir = -d _; 1366 1367 # normalize, remove leading ./ 1368 my $memberName = _asZipDirName($fileName, $isDir); 1369 if ($memberName eq $rootZipName) { $memberName = $dest } 1370 else { $memberName =~ s{$pattern}{$dest} } 1371 next if $memberName =~ m{^\.?/?$}; # skip current dir 1372 1373 $done{$memberName} = 1; 1374 my $changedMember = $self->updateMember($memberName, $fileName); 1375 $changedMember->desiredCompressionLevel($compressionLevel); 1376 return _error("updateTree failed to update $fileName") 1377 unless ref($changedMember); 1378 } 1379 1380 # @done now has the archive names corresponding to all the found files. 1381 # If we're mirroring, delete all those members that aren't in @done. 1382 if ($mirror) { 1383 foreach my $member ($self->members()) { 1384 $self->removeMember($member) 1385 unless $done{$member->fileName()}; 1386 } 1387 } 1388 1389 return AZ_OK; 1390} 1391 13921; 1393