r11633 - in /trunk/libarchive-tar-perl: CHANGES META.yml bin/ptar debian/changelog lib/Archive/Tar.pm t/04_resolved_issues.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Tue Dec 25 23:10:46 UTC 2007
Author: gregoa-guest
Date: Tue Dec 25 23:10:46 2007
New Revision: 11633
URL: http://svn.debian.org/wsvn/?sc=1&rev=11633
Log:
New upstream release.
Modified:
trunk/libarchive-tar-perl/CHANGES
trunk/libarchive-tar-perl/META.yml
trunk/libarchive-tar-perl/bin/ptar
trunk/libarchive-tar-perl/debian/changelog
trunk/libarchive-tar-perl/lib/Archive/Tar.pm
trunk/libarchive-tar-perl/t/04_resolved_issues.t
Modified: trunk/libarchive-tar-perl/CHANGES
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/CHANGES?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/CHANGES (original)
+++ trunk/libarchive-tar-perl/CHANGES Tue Dec 25 23:10:46 2007
@@ -1,3 +1,13 @@
+* important changes in vesrion 1.38 14/12/2007:
+- Promote 1.37_01 to stable.
+
+* important changes in version 1.37_01 11/11/2007:
+_ Address #30380: directory traversal vulnerability in Archive-Tar
+ - Add $INSECURE_EXTRACT_MODE which defaults to 0, disallowing
+ archives to extract files outside of cwd(). This is a backwards
+ incompatible change from 1.36 and before.
+ - Add a -I option to ptar to enable insecure extraction if needed
+
* important changes in version 1.36 16/9/2007:
- Portability fixes for VMS, as offered by Craig Berry.
Modified: trunk/libarchive-tar-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/META.yml?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/META.yml (original)
+++ trunk/libarchive-tar-perl/META.yml Tue Dec 25 23:10:46 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Archive-Tar
-version: 1.36
+version: 1.38
version_from: lib/Archive/Tar.pm
installdirs: site
requires:
Modified: trunk/libarchive-tar-perl/bin/ptar
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/bin/ptar?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/bin/ptar (original)
+++ trunk/libarchive-tar-perl/bin/ptar Tue Dec 25 23:10:46 2007
@@ -6,13 +6,16 @@
use File::Find;
my $opts = {};
-getopts('dcvzthxf:', $opts) or die usage();
+getopts('dcvzthxf:I', $opts) or die usage();
### show the help message ###
die usage() if $opts->{h};
### enable debugging (undocumented feature)
-local $Archive::Tar::DEBUG = 1 if $opts->{d};
+local $Archive::Tar::DEBUG = 1 if $opts->{d};
+
+### enable insecure extracting.
+local $Archive::Tar::INSECURE_EXTRACT_MODE = 1 if $opts->{I};
### sanity checks ###
unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
@@ -23,6 +26,7 @@
my $verbose = $opts->{v} ? 1 : 0;
my $file = $opts->{f} ? $opts->{f} : 'default.tar';
my $tar = Archive::Tar->new();
+
if( $opts->{c} ) {
my @files;
@@ -64,6 +68,8 @@
z Read/Write zlib compressed ARCHIVE_FILE (not always available)
v Print filenames as they are added or extraced from ARCHIVE_FILE
h Prints this help message
+ I Enable 'Insecure Extract Mode', which allows archives to extract
+ files outside the current working directory. (Not advised).
See Also:
tar(1)
Modified: trunk/libarchive-tar-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/debian/changelog?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/debian/changelog (original)
+++ trunk/libarchive-tar-perl/debian/changelog Tue Dec 25 23:10:46 2007
@@ -1,5 +1,6 @@
-libarchive-tar-perl (1.36-2) UNRELEASED; urgency=low
+libarchive-tar-perl (1.38-1) UNRELEASED; urgency=low
+ * New upstream release.
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
field (source stanza); Homepage field (source stanza). Removed:
Homepage pseudo-field (Description); XS-Vcs-Svn fields.
Modified: trunk/libarchive-tar-perl/lib/Archive/Tar.pm
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/lib/Archive/Tar.pm?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/lib/Archive/Tar.pm (original)
+++ trunk/libarchive-tar-perl/lib/Archive/Tar.pm Tue Dec 25 23:10:46 2007
@@ -9,15 +9,18 @@
use strict;
use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
- $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING];
-
-$DEBUG = 0;
-$WARN = 1;
-$FOLLOW_SYMLINK = 0;
-$VERSION = "1.36";
-$CHOWN = 1;
-$CHMOD = 1;
-$DO_NOT_USE_PREFIX = 0;
+ $DO_NOT_USE_PREFIX $HAS_PERLIO $HAS_IO_STRING
+ $INSECURE_EXTRACT_MODE
+ ];
+
+$DEBUG = 0;
+$WARN = 1;
+$FOLLOW_SYMLINK = 0;
+$VERSION = "1.38";
+$CHOWN = 1;
+$CHMOD = 1;
+$DO_NOT_USE_PREFIX = 0;
+$INSECURE_EXTRACT_MODE = 0;
BEGIN {
use Config;
@@ -542,18 +545,42 @@
my $dir;
### is $name an absolute path? ###
if( File::Spec->file_name_is_absolute( $dirs ) ) {
+
+ ### absolute names are not allowed to be in tarballs under
+ ### strict mode, so only allow it if a user tells us to do it
+ if( not defined $alt and not $INSECURE_EXTRACT_MODE ) {
+ $self->_error(
+ q[Entry ']. $entry->full_path .q[' is an absolute path. ].
+ q[Not extracting absolute paths under SECURE EXTRACT MODE]
+ );
+ return;
+ }
+
+ ### user asked us to, it's fine.
$dir = $dirs;
### it's a relative path ###
} else {
my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd());
-
-
my @dirs = defined $alt
? File::Spec->splitdir( $dirs ) # It's a local-OS path
: File::Spec::Unix->splitdir( $dirs ); # it's UNIX-style, likely
# straight from the tarball
+
+ ### paths that leave the current directory are not allowed under
+ ### strict mode, so only allow it if a user tells us to do this.
+ if( not defined $alt and
+ not $INSECURE_EXTRACT_MODE and
+ grep { $_ eq '..' } @dirs
+ ) {
+ $self->_error(
+ q[Entry ']. $entry->full_path .q[' is attempting to leave the ].
+ q[current working directory. Not extracting under SECURE ].
+ q[EXTRACT MODE]
+ );
+ return;
+ }
### '.' is the directory delimiter, of which the first one has to
### be escaped/changed.
@@ -1555,6 +1582,23 @@
warn $tar->error unless $tar->extract;
+=head2 $Archive::Tar::INSECURE_EXTRACT_MODE
+
+This variable indicates whether C<Archive::Tar> should allow
+files to be extracted outside their current working directory.
+
+Allowing this could have security implications, as a malicious
+tar archive could alter or replace any file the extracting user
+has permissions to. Therefor, the default is to not allow
+insecure extractions.
+
+If you trust the archive, or have other reasons to allow the
+archive to write files outside your current working directory,
+set this variable to C<true>.
+
+Note that this is a backwards incompatible change from version
+C<1.36> and before.
+
=head2 $Archive::Tar::HAS_PERLIO
This variable holds a boolean indicating if we currently have
Modified: trunk/libarchive-tar-perl/t/04_resolved_issues.t
URL: http://svn.debian.org/wsvn/trunk/libarchive-tar-perl/t/04_resolved_issues.t?rev=11633&op=diff
==============================================================================
--- trunk/libarchive-tar-perl/t/04_resolved_issues.t (original)
+++ trunk/libarchive-tar-perl/t/04_resolved_issues.t Tue Dec 25 23:10:46 2007
@@ -7,20 +7,25 @@
BEGIN { chdir 't' if -d 't' }
-use Test::More 'no_plan';
+use Test::More 'no_plan';
+use File::Basename 'basename';
use strict;
use lib '../lib';
my $NO_UNLINK = @ARGV ? 1 : 0;
my $Class = 'Archive::Tar';
+my $FileClass = $Class . '::File';
use_ok( $Class );
+use_ok( $FileClass );
### bug #13636
### tests for @longlink behaviour on files that have a / at the end
### of their shortened path, making them appear to be directories
-{ ### dont use the prefix, otherwise A::T will not use @longlink
+{ ok( 1, "Testing bug 13636" );
+
+ ### dont use the prefix, otherwise A::T will not use @longlink
### encoding style
local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
@@ -33,25 +38,25 @@
### first create the file
{ my $tar = $Class->new;
- isa_ok( $tar, $Class );
+ isa_ok( $tar, $Class, " Object" );
ok( $tar->add_data( $dir.$file => $$ ),
- " Added long file" );
+ " Added long file" );
- ok( $tar->write($out), " File written to $out" );
+ ok( $tar->write($out), " File written to $out" );
}
### then read it back in
{ my $tar = $Class->new;
- isa_ok( $tar, $Class );
- ok( $tar->read( $out ), " Read in $out again" );
+ isa_ok( $tar, $Class, " Object" );
+ ok( $tar->read( $out ), " Read in $out again" );
my @files = $tar->get_files;
- is( scalar(@files), 1, " Only 1 entry found" );
+ is( scalar(@files), 1, " Only 1 entry found" );
my $entry = shift @files;
- ok( $entry->is_file, " Entry is a file" );
+ ok( $entry->is_file, " Entry is a file" );
is( $entry->name, $dir.$file,
- " With the proper name" );
+ " With the proper name" );
}
### remove the file
@@ -62,38 +67,88 @@
### There's a bug in Archive::Tar that causes a file like: foo/foo.txt
### to be stored in the tar file as: foo/.txt
### XXX could not be reproduced in 1.26 -- leave test to be sure
-{ my $dir = $$ . '/';
+{ ok( 1, "Testing bug 14922" );
+
+ my $dir = $$ . '/';
my $file = $$ . '.txt';
my $out = $$ . '.tar';
### first create the file
{ my $tar = $Class->new;
- isa_ok( $tar, $Class );
+ isa_ok( $tar, $Class, " Object" );
ok( $tar->add_data( $dir.$file => $$ ),
- " Added long file" );
+ " Added long file" );
- ok( $tar->write($out), " File written to $out" );
+ ok( $tar->write($out), " File written to $out" );
}
### then read it back in
{ my $tar = $Class->new;
- isa_ok( $tar, $Class );
- ok( $tar->read( $out ), " Read in $out again" );
+ isa_ok( $tar, $Class, " Object" );
+ ok( $tar->read( $out ), " Read in $out again" );
my @files = $tar->get_files;
- is( scalar(@files), 1, " Only 1 entry found" );
+ is( scalar(@files), 1, " Only 1 entry found" );
my $entry = shift @files;
- ok( $entry->is_file, " Entry is a file" );
+ ok( $entry->is_file, " Entry is a file" );
is( $entry->full_path, $dir.$file,
- " With the proper name" );
+ " With the proper name" );
}
### remove the file
unless( $NO_UNLINK ) { 1 while unlink $out }
}
+### bug #30380: directory traversal vulnerability in Archive-Tar
+### Archive::Tar allowed files to be extracted to a dir outside
+### it's cwd(), effectively allowing you to overwrite any files
+### on the system, given the right permissions.
+{ ok( 1, "Testing bug 30880" );
+
+ my $tar = $Class->new;
+ isa_ok( $tar, $Class, " Object" );
+ ### absolute paths are already taken care of. Only relative paths
+ ### matter
+ my $in_file = basename($0);
+ my $out_file = '../' . $in_file . ".$$";
+ ok( $tar->add_files( $in_file ),
+ " Added '$in_file'" );
+ ok( $tar->rename( $in_file, $out_file ),
+ " Renamed to '$out_file'" );
+ ### first, test with strict extract permissions on
+ { local $Archive::Tar::INSECURE_EXTRACT_MODE = 0;
+
+ ### we quell the error on STDERR
+ local $Archive::Tar::WARN = 0;
+ local $Archive::Tar::WARN = 0;
+
+ ok( 1, " Extracting in secure mode" );
+
+ ok( ! $tar->extract_file( $out_file ),
+ " File not extracted" );
+ ok( ! -e $out_file, " File '$out_file' does not exist" );
+
+ ok( $tar->error, " Error message stored" );
+ like( $tar->error, qr/attempting to leave/,
+ " Proper violation detected" );
+ }
+
+ ### now disable those
+ { local $Archive::Tar::INSECURE_EXTRACT_MODE = 1;
+ ok( 1, " Extracting in insecure mode" );
+
+ ok( $tar->extract_file( $out_file ),
+ " File extracted" );
+ ok( -e $out_file, " File '$out_file' exists" );
+
+ ### and clean up
+ unless( $NO_UNLINK ) { 1 while unlink $out_file };
+ }
+
+
+}
More information about the Pkg-perl-cvs-commits
mailing list