Hello community, here is the log from the commit of package perl-Archive-Zip for openSUSE:Factory checked in at 2018-08-27 12:55:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Archive-Zip (Old) and /work/SRC/openSUSE:Factory/.perl-Archive-Zip.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Archive-Zip" Mon Aug 27 12:55:50 2018 rev:39 rq:631288 version:1.63 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Archive-Zip/perl-Archive-Zip.changes 2018-01-09 14:34:39.659946060 +0100 +++ /work/SRC/openSUSE:Factory/.perl-Archive-Zip.new/perl-Archive-Zip.changes 2018-08-27 12:55:56.236592323 +0200 @@ -1,0 +2,17 @@ +Thu Aug 23 05:04:06 UTC 2018 - [email protected] + +- updated to 1.63 + see /usr/share/doc/packages/perl-Archive-Zip/Changes + + 1.63 Wed 21 Aug 2018 + - Restore missing META.yml deps (needed updated MB) + - Symlink traversal test fix [github/haarg] + - Added missing prereq Encode as suggested by CPANTS [github/manwar] + +------------------------------------------------------------------- +Tue Aug 21 05:04:33 UTC 2018 - [email protected] + +- updated to 1.62 + see /usr/share/doc/packages/perl-Archive-Zip/Changes + +------------------------------------------------------------------- Old: ---- Archive-Zip-1.60.tar.gz New: ---- Archive-Zip-1.63.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Archive-Zip.spec ++++++ --- /var/tmp/diff_new_pack.IjRJxu/_old 2018-08-27 12:55:57.308593498 +0200 +++ /var/tmp/diff_new_pack.IjRJxu/_new 2018-08-27 12:55:57.312593502 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-Archive-Zip # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,11 +17,11 @@ Name: perl-Archive-Zip -Version: 1.60 +Version: 1.63 Release: 0 %define cpan_name Archive-Zip Summary: Provide an interface to ZIP archive files -License: Artistic-1.0 or GPL-1.0+ +License: Artistic-1.0 OR GPL-1.0-or-later Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/Archive-Zip/ Source0: https://cpan.metacpan.org/authors/id/P/PH/PHRED/%{cpan_name}-%{version}.tar.gz ++++++ Archive-Zip-1.60.tar.gz -> Archive-Zip-1.63.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/Changes new/Archive-Zip-1.63/Changes --- old/Archive-Zip-1.60/Changes 2017-12-19 19:41:50.000000000 +0100 +++ new/Archive-Zip-1.63/Changes 2018-08-22 17:40:12.000000000 +0200 @@ -1,5 +1,17 @@ Revision history for Perl extension Archive-Zip +1.63 Wed 21 Aug 2018 + - Restore missing META.yml deps (needed updated MB) + - Symlink traversal test fix [github/haarg] + - Added missing prereq Encode as suggested by CPANTS [github/manwar] + +1.62 Sun 19 Aug 2018 + - Add link-samename.zip to MANIFEST + +1.61 Sat 18 Aug 2018 + - File::Find will not untaint [github/ThisUsedToBeAnEmail] + - Prevent from traversing symlinks and parent directories when extracting [github/ppisar] + 1.60 Tue 19 Dec 2017 - RT 123913 Wrong shell bang in examples/selfex.pl diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/MANIFEST new/Archive-Zip-1.63/MANIFEST --- old/Archive-Zip-1.60/MANIFEST 2017-12-19 19:43:30.000000000 +0100 +++ new/Archive-Zip-1.63/MANIFEST 2018-08-22 17:40:33.000000000 +0200 @@ -59,6 +59,7 @@ t/22_deflated_dir.t t/23_closed_handle.t t/24_unicode_win32.t +t/25_traversal.t t/badjpeg/expected.jpg t/badjpeg/source.zip t/common.pm @@ -68,6 +69,7 @@ t/data/crypt.zip t/data/def.zip t/data/defstr.zip +t/data/dotdot-from-unexistant-path.zip t/data/empty.zip t/data/emptydef.zip t/data/emptydefstr.zip @@ -75,6 +77,8 @@ t/data/emptystorestr.zip t/data/good_github11.zip t/data/jar.zip +t/data/link-dir.zip +t/data/link-samename.zip t/data/linux.zip t/data/mkzip.pl t/data/perl.zip diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/META.json new/Archive-Zip-1.63/META.json --- old/Archive-Zip-1.60/META.json 2017-12-19 19:43:30.000000000 +0100 +++ new/Archive-Zip-1.63/META.json 2018-08-22 17:40:33.000000000 +0200 @@ -4,7 +4,7 @@ "Ned Konz <[email protected]>" ], "dynamic_config" : 0, - "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -33,6 +33,7 @@ "runtime" : { "requires" : { "Compress::Raw::Zlib" : "2.017", + "Encode" : "0", "File::Basename" : "0", "File::Copy" : "0", "File::Find" : "0", @@ -65,6 +66,6 @@ "web" : "https://github.com/redhotpenguin/perl-Archive-Zip"; } }, - "version" : "1.60", - "x_serialization_backend" : "JSON::PP version 2.97000" + "version" : "1.63", + "x_serialization_backend" : "JSON::PP version 2.97001" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/META.yml new/Archive-Zip-1.63/META.yml --- old/Archive-Zip-1.60/META.yml 2017-12-19 19:43:30.000000000 +0100 +++ new/Archive-Zip-1.63/META.yml 2018-08-22 17:40:32.000000000 +0200 @@ -9,7 +9,7 @@ configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 -generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -21,6 +21,7 @@ - inc requires: Compress::Raw::Zlib: '2.017' + Encode: '0' File::Basename: '0' File::Copy: '0' File::Find: '0' @@ -35,5 +36,5 @@ resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Archive-Zip repository: https://github.com/redhotpenguin/perl-Archive-Zip.git -version: '1.60' +version: '1.63' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/Makefile.PL new/Archive-Zip-1.63/Makefile.PL --- old/Archive-Zip-1.60/Makefile.PL 2017-12-19 19:39:06.000000000 +0100 +++ new/Archive-Zip-1.63/Makefile.PL 2018-08-20 21:24:52.000000000 +0200 @@ -47,6 +47,7 @@ 'IO::Handle' => 0, 'IO::Seekable' => 0, 'Time::Local' => 0, + 'Encode' => 0, }, TEST_REQUIRES => { 'Test::More' => '0.88', diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/Archive.pm new/Archive-Zip-1.63/lib/Archive/Zip/Archive.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/Archive.pm 2017-12-19 19:41:58.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/Archive.pm 2018-08-22 17:33:51.000000000 +0200 @@ -14,7 +14,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw( Archive::Zip ); } @@ -26,6 +26,7 @@ ); our $UNICODE; +our $UNTAINT = qr/\A(.+)\z/; # Note that this returns undef on read errors, else new zip object. @@ -185,6 +186,8 @@ $dirName = File::Spec->catpath($volumeName, $dirName, ''); } else { $name = $member->fileName(); + if ((my $ret = _extractionNameIsSafe($name)) + != AZ_OK) { return $ret; } ($dirName = $name) =~ s{[^/]*$}{}; $dirName = Archive::Zip::_asLocalName($dirName); $name = Archive::Zip::_asLocalName($name); @@ -218,6 +221,8 @@ unless ($name) { $name = $member->fileName(); $name =~ s{.*/}{}; # strip off directories, if any + if ((my $ret = _extractionNameIsSafe($name)) + != AZ_OK) { return $ret; } $name = Archive::Zip::_asLocalName($name); } my $rc = $member->extractToFileNamed($name, @_); @@ -725,7 +730,7 @@ # you have bigger problems than this. sub _untaintDir { my $dir = shift; - $dir =~ m/\A(.+)\z/s; + $dir =~ m/$UNTAINT/s; return $1; } @@ -772,7 +777,8 @@ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $root = Win32::GetANSIPathName($root); } - File::Find::find($wanted, $root); + # File::Find will not untaint unless you explicitly pass the flag and regex pattern. + File::Find::find({ wanted => $wanted, untaint => 1, untaint_pattern => $UNTAINT }, $root); my $rootZipName = _asZipDirName($root, 1); # with trailing slash my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; @@ -827,6 +833,37 @@ return $self->addTree($root, $dest, $matcher, $compressionLevel); } +# Check if one of the components of a path to the file or the file name +# itself is an already existing symbolic link. If yes then return an +# error. Continuing and writing to a file traversing a link posseses +# a security threat, especially if the link was extracted from an +# attacker-supplied archive. This would allow writing to an arbitrary +# file. The same applies when using ".." to escape from a working +# directory. <https://bugzilla.redhat.com/show_bug.cgi?id=1591449> +sub _extractionNameIsSafe { + my $name = shift; + my ($volume, $directories) = File::Spec->splitpath($name, 1); + my @directories = File::Spec->splitdir($directories); + if (grep '..' eq $_, @directories) { + return _error( + "Could not extract $name safely: a parent directory is used"); + } + my @path; + my $path; + for my $directory (@directories) { + push @path, $directory; + $path = File::Spec->catpath($volume, File::Spec->catdir(@path), ''); + if (-l $path) { + return _error( + "Could not extract $name safely: $path is an existing symbolic link"); + } + if (!-e $path) { + last; + } + } + return AZ_OK; +} + # $zip->extractTree( $root, $dest [, $volume] ); # # $root and $dest are Unix-style. @@ -861,6 +898,8 @@ $fileName =~ s{$pattern}{$dest}; # in Unix format # convert to platform format: $fileName = Archive::Zip::_asLocalName($fileName, $volume); + if ((my $ret = _extractionNameIsSafe($fileName)) + != AZ_OK) { return $ret; } my $status = $member->extractToFileNamed($fileName); return $status if $status != AZ_OK; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/BufferedFileHandle.pm new/Archive-Zip-1.63/lib/Archive/Zip/BufferedFileHandle.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/BufferedFileHandle.pm 2017-12-19 19:41:58.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/BufferedFileHandle.pm 2018-08-22 17:33:51.000000000 +0200 @@ -13,7 +13,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; $VERSION = eval $VERSION; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/DirectoryMember.pm new/Archive-Zip-1.63/lib/Archive/Zip/DirectoryMember.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/DirectoryMember.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/DirectoryMember.pm 2018-08-22 17:33:51.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw( Archive::Zip::Member ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/FileMember.pm new/Archive-Zip-1.63/lib/Archive/Zip/FileMember.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/FileMember.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/FileMember.pm 2018-08-22 17:33:51.000000000 +0200 @@ -4,7 +4,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw ( Archive::Zip::Member ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/Member.pm new/Archive-Zip-1.63/lib/Archive/Zip/Member.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/Member.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/Member.pm 2018-08-22 17:33:51.000000000 +0200 @@ -6,7 +6,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw( Archive::Zip ); if ($^O eq 'MSWin32') { @@ -34,6 +34,10 @@ use constant DEFAULT_FILE_PERMISSIONS => 0100666; use constant DIRECTORY_ATTRIB => 040000; use constant FILE_ATTRIB => 0100000; +use constant OS_SUPPORTS_SYMLINK => do { + local $@; + !!eval { symlink("",""); 1 }; +}; # Returns self if successful, else undef # Assumes that fh is positioned at beginning of central directory file header. @@ -650,7 +654,7 @@ # Note, this is not exactly UTC 1980, it's 1980 + 12 hours and 1 # minute so that nothing timezoney can muck us up. -my $safe_epoch = 31.606060; +my $safe_epoch = 31.636060; # convert a unix time to DOS date/time # NOT AN OBJECT METHOD! @@ -1090,7 +1094,7 @@ # If symbolic link, just create one if the operating system is Linux, Unix, BSD or VMS # TODO: Add checks for other operating systems - if ($self->{'isSymbolicLink'} == 1 && $^O eq 'linux') { + if ($self->{'isSymbolicLink'} == 1 && OS_SUPPORTS_SYMLINK) { my $chunkSize = $Archive::Zip::ChunkSize; my ($outRef, $status) = $self->readChunk($chunkSize); symlink $$outRef, $self->{'newName'}; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/MemberRead.pm new/Archive-Zip-1.63/lib/Archive/Zip/MemberRead.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/MemberRead.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/MemberRead.pm 2018-08-22 17:33:51.000000000 +0200 @@ -40,7 +40,7 @@ my $nl; BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; $VERSION = eval $VERSION; # Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/MockFileHandle.pm new/Archive-Zip-1.63/lib/Archive/Zip/MockFileHandle.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/MockFileHandle.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/MockFileHandle.pm 2018-08-22 17:33:51.000000000 +0200 @@ -10,7 +10,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; $VERSION = eval $VERSION; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/NewFileMember.pm new/Archive-Zip-1.63/lib/Archive/Zip/NewFileMember.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/NewFileMember.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/NewFileMember.pm 2018-08-22 17:33:51.000000000 +0200 @@ -4,7 +4,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw ( Archive::Zip::FileMember ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/StringMember.pm new/Archive-Zip-1.63/lib/Archive/Zip/StringMember.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/StringMember.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/StringMember.pm 2018-08-22 17:33:51.000000000 +0200 @@ -4,7 +4,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw( Archive::Zip::Member ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/Tree.pm new/Archive-Zip-1.63/lib/Archive/Zip/Tree.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/Tree.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/Tree.pm 2018-08-22 17:33:51.000000000 +0200 @@ -4,7 +4,7 @@ use vars qw{$VERSION}; BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; } use Archive::Zip; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip/ZipFileMember.pm new/Archive-Zip-1.63/lib/Archive/Zip/ZipFileMember.pm --- old/Archive-Zip-1.60/lib/Archive/Zip/ZipFileMember.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip/ZipFileMember.pm 2018-08-22 17:33:51.000000000 +0200 @@ -4,7 +4,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; @ISA = qw ( Archive::Zip::FileMember ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/lib/Archive/Zip.pm new/Archive-Zip-1.63/lib/Archive/Zip.pm --- old/Archive-Zip-1.60/lib/Archive/Zip.pm 2017-12-19 19:41:59.000000000 +0100 +++ new/Archive-Zip-1.63/lib/Archive/Zip.pm 2018-08-22 17:33:51.000000000 +0200 @@ -14,7 +14,7 @@ use vars qw( $VERSION @ISA ); BEGIN { - $VERSION = '1.60'; + $VERSION = '1.63'; require Exporter; @ISA = qw( Exporter ); @@ -1145,6 +1145,9 @@ directory. If you pass C<$extractedName>, it should be in the local file system's format. +If you do not pass C<$extractedName> and the internal filename traverses +a parent directory or a symbolic link, the extraction will be aborted with +C<AC_ERROR> for security reason. All necessary directories will be created. Returns C<AZ_OK> on success. @@ -1162,6 +1165,9 @@ the internal filename of the member (minus paths) is used as the name of the extracted file or directory. Returns C<AZ_OK> on success. +If you do not pass C<$extractedName> and the internal filename is equalled +to a local symbolic link, the extraction will be aborted with C<AC_ERROR> for +security reason. =item addMember( $member ) @@ -1609,6 +1615,8 @@ a/b/c to f:\d\e\b\c and ignore ax/d/e and d/e +If the path to the extracted file traverses a parent directory or a symbolic +link, the extraction will be aborted with C<AC_ERROR> for security reason. Returns an error code or AZ_OK if everything worked OK. =back diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Archive-Zip-1.60/t/25_traversal.t new/Archive-Zip-1.63/t/25_traversal.t --- old/Archive-Zip-1.60/t/25_traversal.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Archive-Zip-1.63/t/25_traversal.t 2018-08-22 17:24:45.000000000 +0200 @@ -0,0 +1,198 @@ +use strict; +use warnings; + +use Archive::Zip qw( :ERROR_CODES ); +use File::Spec; +use File::Path; +use lib 't'; +use common; + +use Test::More tests => 41; + +# These tests check for CVE-2018-10860 vulnerabilities. +# If an archive contains a symlink and then a file that traverses that symlink, +# extracting the archive tree could write into an abitrary file selected by +# the symlink value. +# Another issue is if an archive contains a file whose path component refers +# to a parent direcotory. Then extracting that file could write into a file +# out of current working directory subtree. +# These tests check extracting of these files is refuses and that they are +# indeed not created. + +# Suppress croaking errors, the tests produce some. +Archive::Zip::setErrorHandler(sub {}); +my ($existed, $ret, $zip, $allowed_file, $forbidden_file); + +# Change working directory to a temporary directory because some tested +# functions operarates there and we need prepared symlinks there. +my @data_path = (File::Spec->splitdir(File::Spec->rel2abs('.')), 't', 'data'); +ok(chdir TESTDIR, "Working directory changed"); + +# Symlink tests make sense only if a file system supports them. +my $symlinks_not_supported; +{ + my $link = 'trylink'; + $symlinks_not_supported = !eval { symlink('.', $link) }; + unlink $link; +} + +# Case 1: +# link-dir -> /tmp +# link-dir/gotcha-linkdir +# writes into /tmp/gotcha-linkdir file. +SKIP: { + skip 'Symbolic links are not supported', 12 if $symlinks_not_supported; + + # Extracting an archive tree must fail + $zip = Archive::Zip->new(); + isa_ok($zip, 'Archive::Zip'); + is($zip->read(File::Spec->catfile(@data_path, 'link-dir.zip')), AZ_OK, + 'Archive read'); + $existed = -e File::Spec->catfile('', 'tmp', 'gotcha-linkdir'); + $ret = eval { $zip->extractTree() }; + is($ret, AZ_ERROR, 'Tree extraction aborted'); + SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e File::Spec->catfile('link-dir', 'gotcha-linkdir'), + 'A file was not created in a symlinked directory'); + } + ok(unlink(File::Spec->catfile('link-dir')), 'link-dir removed'); + + # The same applies to extracting an archive member without an explicit + # local file name. It must abort. + my $link = 'link-dir'; + ok(symlink('.', $link), 'A symlink to a directory created'); + $forbidden_file = File::Spec->catfile($link, 'gotcha-linkdir'); + $existed = -e $forbidden_file; + $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir') }; + is($ret, AZ_ERROR, 'Member extraction without a local name aborted'); + SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e $forbidden_file, + 'A file was not created in a symlinked directory'); + } + + # But allow extracting an archive member into a supplied file name + $allowed_file = File::Spec->catfile($link, 'file'); + $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir', $allowed_file) }; + is($ret, AZ_OK, 'Member extraction passed'); + ok(-e $allowed_file, 'File created'); + ok(unlink($allowed_file), 'File removed'); + ok(unlink($link), 'A symlink to a directory removed'); +} + +# Case 2: +# unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath +# writes into ../../../../tmp/gotcha-dotdot-unexistingpath, that is +# /tmp/gotcha-dotdot-unexistingpath file if CWD is not deeper than +# 4 directories. +$zip = Archive::Zip->new(); +isa_ok($zip, 'Archive::Zip'); +is($zip->read(File::Spec->catfile(@data_path, + 'dotdot-from-unexistant-path.zip')), AZ_OK, 'Archive read'); +$forbidden_file = File::Spec->catfile('..', '..', '..', '..', 'tmp', + 'gotcha-dotdot-unexistingpath'); +$existed = -e $forbidden_file; +$ret = eval { $zip->extractTree() }; +is($ret, AZ_ERROR, 'Tree extraction aborted'); +SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e $forbidden_file, 'A file was not created in a parent directory'); +} + +# The same applies to extracting an archive member without an explicit local +# file name. It must abort. +$existed = -e $forbidden_file; +$ret = eval { $zip->extractMember( + 'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath', + ) }; +is($ret, AZ_ERROR, 'Member extraction without a local name aborted'); +SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e $forbidden_file, 'A file was not created in a parent directory'); +} + +# But allow extracting an archive member into a supplied file name +ok(mkdir('directory'), 'Directory created'); +$allowed_file = File::Spec->catfile('directory', '..', 'file'); +$ret = eval { $zip->extractMember( + 'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath', + $allowed_file + ) }; +is($ret, AZ_OK, 'Member extraction passed'); +ok(-e $allowed_file, 'File created'); +ok(unlink($allowed_file), 'File removed'); + +# Case 3: +# link-file -> /tmp/gotcha-samename +# link-file +# writes into /tmp/gotcha-samename. It must abort. (Or replace the symlink in +# more relaxed mode in the future.) +SKIP: { + skip 'Symbolic links are not supported', 18 if $symlinks_not_supported; + + $zip = Archive::Zip->new(); + isa_ok($zip, 'Archive::Zip'); + is($zip->read(File::Spec->catfile(@data_path, 'link-samename.zip')), AZ_OK, + 'Archive read'); + $existed = -e File::Spec->catfile('', 'tmp', 'gotcha-samename'); + $ret = eval { $zip->extractTree() }; + is($ret, AZ_ERROR, 'Tree extraction aborted'); + SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e File::Spec->catfile('', 'tmp', 'gotcha-samename'), + 'A file was not created through a symlinked file'); + } + ok(unlink(File::Spec->catfile('link-file')), 'link-file removed'); + + # The same applies to extracting an archive member using extractMember() + # without an explicit local file name. It must abort. + my $link = 'link-file'; + my $target = 'target'; + ok(symlink($target, $link), 'A symlink to a file created'); + $forbidden_file = File::Spec->catfile($target); + $existed = -e $forbidden_file; + # Select a member by order due to same file names. + my $member = ${[$zip->members]}[1]; + ok($member, 'A member to extract selected'); + $ret = eval { $zip->extractMember($member) }; + is($ret, AZ_ERROR, + 'Member extraction using extractMember() without a local name aborted'); + SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e $forbidden_file, + 'A symlinked target file was not created'); + } + + # But allow extracting an archive member using extractMember() into + # a supplied file name. + $allowed_file = $target; + $ret = eval { $zip->extractMember($member, $allowed_file) }; + is($ret, AZ_OK, 'Member extraction using extractMember() passed'); + ok(-e $allowed_file, 'File created'); + ok(unlink($allowed_file), 'File removed'); + + # The same applies to extracting an archive member using + # extractMemberWithoutPaths() without an explicit local file name. + # It must abort. + $existed = -e $forbidden_file; + # Select a member by order due to same file names. + $ret = eval { $zip->extractMemberWithoutPaths($member) }; + is($ret, AZ_ERROR, + 'Member extraction using extractMemberWithoutPaths() without a local name aborted'); + SKIP: { + skip 'A canary file existed before the test', 1 if $existed; + ok(! -e $forbidden_file, + 'A symlinked target file was not created'); + } + + # But allow extracting an archive member using extractMemberWithoutPaths() + # into a supplied file name. + $allowed_file = $target; + $ret = eval { $zip->extractMemberWithoutPaths($member, $allowed_file) }; + is($ret, AZ_OK, + 'Member extraction using extractMemberWithoutPaths() passed'); + ok(-e $allowed_file, 'File created'); + ok(unlink($allowed_file), 'File removed'); + ok(unlink($link), 'A symlink to a file removed'); +} Binary files old/Archive-Zip-1.60/t/data/dotdot-from-unexistant-path.zip and new/Archive-Zip-1.63/t/data/dotdot-from-unexistant-path.zip differ Binary files old/Archive-Zip-1.60/t/data/link-dir.zip and new/Archive-Zip-1.63/t/data/link-dir.zip differ Binary files old/Archive-Zip-1.60/t/data/link-samename.zip and new/Archive-Zip-1.63/t/data/link-samename.zip differ
