Package: perl Version: 5.10.0-18 Severity: important Tags: security As reported by Anna Bernathova in
http://rt.cpan.org/Public/Bug/Display.html?id=30380#txn-436899 > rm -rf dir && mkdir dir && ln -s > .//..//..//..//..//..//..//..//..//..//..//etc dir/subdir && tar -cf > dir.tar --numeric-owner --owner=0 --group=0 dir/subdir dir/subdir/passwd > > and then > > use Archive::Tar; > my $tar = Archive::Tar->new($ARGV[0]); > $tar->extract(); > > on your archive, you will get attempt to rewrite /etc/passwd: This was fixed upstream in 1.39_01. Ubuntu backported the fix recently for 5.10.0-11.1ubuntu2.2; I'm attaching their patch. -- Niko Tyni nt...@debian.org
--- perl-5.10.0.orig/debian/patches/90_archive_tar_fix_symlink_unpack +++ perl-5.10.0/debian/patches/90_archive_tar_fix_symlink_unpack @@ -0,0 +1,195 @@ +http://rt.cpan.org/Public/Bug/Display.html?id=30380#txn-436899 +second half of unpack issue CVE-2007-4829, from 1.39_01 of Archive::Tar + +diff -uNrp perl-5.10.0~/lib/Archive/Tar/t/90_symlink.t perl-5.10.0/lib/Archive/Tar/t/90_symlink.t +--- perl-5.10.0~/lib/Archive/Tar/t/90_symlink.t 1969-12-31 16:00:00.000000000 -0800 ++++ perl-5.10.0/lib/Archive/Tar/t/90_symlink.t 2008-12-03 12:56:19.000000000 -0800 +@@ -0,0 +1,62 @@ ++BEGIN { ++ if( $ENV{PERL_CORE} ) { ++ chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar'; ++ } ++ use lib '../../..'; ++} ++ ++BEGIN { chdir 't' if -d 't' } ++ ++use lib '../lib'; ++ ++use strict; ++use File::Spec; ++use File::Path; ++use Test::More; ++ ++### developer tests mostly, so enable them with an extra argument ++plan skip_all => "Skipping tests on this platform" unless @ARGV; ++plan 'no_plan'; ++ ++my $Class = 'Archive::Tar'; ++my $Dir = File::Spec->catdir( qw[src linktest] ); ++my %Map = ( ++ File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [ ++ [ 0, qr/SECURE EXTRACT MODE/ ], ++ [ 1, qr/^$/ ] ++ ], ++ File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [ ++ [ 0, qr/SECURE EXTRACT MODE/ ], ++ [ 0, qr/File exists/ ], ++ ], ++); ++ ++use_ok( $Class ); ++ ++{ while( my($file, $aref) = each %Map ) { ++ ++ for my $mode ( 0, 1 ) { ++ my $expect = $aref->[$mode]->[0]; ++ my $regex = $aref->[$mode]->[1]; ++ ++ my $tar = $Class->new( $file ); ++ ok( $tar, "Object created from $file" ); ++ ++ ### damn warnings ++ local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode; ++ local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode; ++ ++ ok( 1, " Extracting with insecure mode: $mode" ); ++ ++ my $warning; ++ local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; }; ++ ++ my $rv = eval { $tar->extract } || 0; ++ ok( !$@, " No fatal error" ); ++ is( !!$rv, !!$expect, " RV as expected" ); ++ like( $warning, $regex, " Error matches $regex" ); ++ ++ rmtree( 'linktest' ); ++ } ++ } ++} +diff -uNrp perl-5.10.0~/lib/Archive/Tar.pm perl-5.10.0/lib/Archive/Tar.pm +--- perl-5.10.0~/lib/Archive/Tar.pm 2007-12-18 02:47:07.000000000 -0800 ++++ perl-5.10.0/lib/Archive/Tar.pm 2008-12-03 12:56:19.000000000 -0800 +@@ -561,26 +561,61 @@ sub _extract_file { + + ### it's a relative path ### + } else { +- my $cwd = (defined $self->{cwd} ? $self->{cwd} : cwd()); ++ my $cwd = (ref $self and 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; +- } ++ not $INSECURE_EXTRACT_MODE ++ ) { ++ ++ ### 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( grep { $_ eq '..' } @dirs ) { ++ ++ $self->_error( ++ q[Entry ']. $entry->full_path .q[' is attempting to leave ]. ++ q[the current working directory. Not extracting under ]. ++ q[SECURE EXTRACT MODE] ++ ); ++ return; ++ } ++ ++ ### the archive may be asking us to extract into a symlink. This ++ ### is not sane and a possible security issue, as outlined here: ++ ### https://rt.cpan.org/Ticket/Display.html?id=30380 ++ ### https://bugzilla.redhat.com/show_bug.cgi?id=295021 ++ ### https://issues.rpath.com/browse/RPL-1716 ++ my $full_path = $cwd; ++ for my $d ( @dirs ) { ++ $full_path = File::Spec->catdir( $full_path, $d ); ++ ++ ### we've already checked this one, and it's safe. Move on. ++ next if ref $self and $self->{_link_cache}->{$full_path}; ++ ++ if( -l $full_path ) { ++ my $to = readlink $full_path; ++ my $diag = "symlinked directory ($full_path => $to)"; ++ ++ $self->_error( ++ q[Entry ']. $entry->full_path .q[' is attempting to ]. ++ qq[extract to a $diag. This is considered a security ]. ++ q[vulnerability and not allowed under SECURE EXTRACT ]. ++ q[MODE] ++ ); ++ return; ++ } ++ ++ ### XXX keep a cache if possible, so the stats become cheaper: ++ $self->{_link_cache}->{$full_path} = 1 if ref $self; ++ } ++ } ++ + + ### '.' is the directory delimiter, of which the first one has to + ### be escaped/changed. +@@ -622,7 +657,8 @@ sub _extract_file { + unless ( -d _ ) { + eval { File::Path::mkpath( $dir, 0, 0777 ) }; + if( $@ ) { +- $self->_error( qq[Could not create directory '$dir': $...@] ); ++ my $fp = $entry->full_path; ++ $self->_error(qq[Could not create directory '$dir' for '$fp': $...@]); + return; + } + +@@ -672,8 +708,13 @@ sub _extract_file { + $self->_make_special_file( $entry, $full ) or return; + } + +- utime time, $entry->mtime - TIME_OFFSET, $full or +- $self->_error( qq[Could not update timestamp] ); ++ ### only update the timestamp if it's not a symlink; that will change the ++ ### timestamp of the original. This addresses bug #33669: Could not update ++ ### timestamp warning on symlinks ++ if( not -l $full ) { ++ utime time, $entry->mtime - TIME_OFFSET, $full or ++ $self->_error( qq[Could not update timestamp] ); ++ } + + if( $CHOWN && CAN_CHOWN ) { + chown $entry->uid, $entry->gid, $full or +@@ -707,8 +748,8 @@ sub _make_special_file { + or $fail++; + } + +- $err = qq[Making symbolink link from '] . $entry->linkname . +- qq[' to '$file' failed] if $fail; ++ $err = qq[Making symbolic link '$file' to '] . ++ $entry->linkname .q[' failed] if $fail; + + } elsif ( $entry->is_hardlink ) { + my $fail; +diff -uNrp perl-5.10.0~/MANIFEST perl-5.10.0/MANIFEST +--- perl-5.10.0~/MANIFEST 2007-12-18 02:47:07.000000000 -0800 ++++ perl-5.10.0/MANIFEST 2008-12-03 12:57:37.000000000 -0800 +@@ -1413,6 +1413,7 @@ lib/Archive/Tar/t/01_use.t Archive::Tar + lib/Archive/Tar/t/02_methods.t Archive::Tar tests + lib/Archive/Tar/t/03_file.t Archive::Tar tests + lib/Archive/Tar/t/04_resolved_issues.t Archive::Tar tests ++lib/Archive/Tar/t/90_symlink.t Archive::Tar tests + lib/Archive/Tar/t/src/long/b Archive::Tar tests + lib/Archive/Tar/t/src/long/bar.tar.packed Archive::Tar tests + lib/Archive/Tar/t/src/long/foo.tgz.packed Archive::Tar tests
