--- perl-5.10.0/MANIFEST +++ perl-5.10.0/MANIFEST @@ -1506,6 +1506,7 @@ lib/FileHandle.pm Backward-compatible front end to IO extension lib/FileHandle.t See if FileHandle works lib/File/Path.pm Do things like `mkdir -p' and `rm -r' lib/File/Path.t See if File::Path works +t/CVE-2008-2827.t CVE-2008-2827 test lib/File/Spec/Cygwin.pm portable operations on Cygwin file names lib/File/Spec/Epoc.pm portable operations on EPOC file names lib/File/Spec/Functions.pm Function interface to File::Spec object methods --- perl-5.10.0/lib/File/Path.pm +++ perl-5.10.0/lib/File/Path.pm @@ -350,9 +350,9 @@ sub _rmtree { next ROOT_DIR; } - my $nperm = $perm & 07777 | 0600; - if ($nperm != $perm and not chmod $nperm, $root) { - if ($Force_Writeable) { + if ($Force_Writeable) { + my $nperm = $perm & 07777 | 0600; + if ($nperm != $perm and not chmod $nperm, $root) { _error($arg, "cannot make file writeable", $canon); } } --- /dev/null +++ perl-5.10.0/t/CVE-2008-2827.t @@ -0,0 +1,39 @@ +#!perl -w + +# Test case derived from http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319 + +my $foo = "foo-$$"; +my $bar = "bar-$$"; + +die "Not clean [$foo] [$bar]" if -e $foo || -e $bar; + +eval { + symlink($foo, $bar) || die "Can't symlink $foo --> $bar"; +}; +if ($@) { + print "1..0 # Skipped: Only systems that can do symlinks are affected\n"; + print "$@\n"; + exit; +} + +use Test; +plan tests => 5; + +umask(0027); + +# touch foo +open(my $fh, ">", $foo) || die "Can't create $foo\n"; +close($fh); + +my $m = (stat $foo)[2]; +ok(defined $m); + +require File::Path; +ok(File::Path::rmtree($bar)); +ok(!-e $bar); + +# If the mode of $foo changed as a result of removing $bar then we are vulnerable +ok($m, (stat $foo)[2]); + +unlink($foo); +ok(!-e $foo);