Comment 6 for bug 11407

On Thu, Dec 23, 2004 at 09:10:31AM +1100, Paul Szabo wrote:
>Package: perl-modules
>Version: 5.6.1-8.7
>Severity: critical
>File: /usr/share/perl/5.6.1/File/Path.pm
>Tags: security
>Justification: root security hole

>Example of attack: suppose we know that root uses rmtree to clean up
>/tmp directories. Attacker prepares things:
>
> mkdir -p /tmp/psz/sh
> perl -e 'open F, ">/tmp/psz/sh/$_" foreach (1..1000)'
> chmod 4777 /tmp/psz/sh
>
>While root is busy working on /tmp/psz/sh (and this can be made as slow
>as we like), attacker does:
>
> mv /tmp/psz/sh /tmp/psz/dummy
> ln -s /bin/sh /tmp/psz/sh
>
>Root would have recorded the permissions of /tmp/psz/sh, but would
>"restore" it to /bin/sh.

>Following on from the "File::Path::rmtree makes setuid" issue, I notice
>that rmtree may be tricked into removing arbitrary files.
>
>Example of attack: suppose we know that root uses rmtree to clean up
>/tmp directories. Attacker prepares things:
>
> mkdir /tmp/psz
> perl -e 'open F, ">/tmp/psz/$_" foreach (1..1000)'
> touch /tmp/psz/passwd
>
>While root is busy working on /tmp/psz (and this can be made as slow as
>we like), attacker does:
>
> mv /tmp/psz /tmp/dummy
> ln -s /etc /tmp/psz
>
>Root will then remove /etc/passwd.

Thanks Paul,

both of these issues obviously stem from the same root cause--a race
between generating a list of files, then manipulating that list.

I don't really see that this is fixable outside of rewriting rmtree to
recursively chdir+readdir+unlink.

Given that there are possible pitfalls even with this approach (cf.
CVE-2002-0435) I'm considering punting the problem to fileutils,
replacing rmtree entirely with the attached subroutine.

[p5p:] If anyone had a cleaner (and cross-platform) fix, I'd love to
hear of it.

--bod

sub rmtree
{
    my ($p, $verbose) = @_;
    $p = [] unless defined $p and length $p;
    $p = [ $p ] unless ref $p;
    my @paths = grep defined && length, @$p;

    unless (@paths)
    {
 carp "No root path(s) specified\n";
 return 0;
    }

    local *RM;
    my $pid = open RM, '-|';

    unless (defined $pid)
    {
 carp "Can't fork ($!)\n";
 return 0;
    }

    unless ($pid)
    {
 # need to parse output, ensure it's not localised
 delete $ENV{$_} for grep /^(LC_|LANG(UAGE)?$)/, keys %ENV;

 exec '/bin/rm', '-rvf', @paths
     or croak "Can't exec /bin/rm ($!)\n";
    }

    my $count = 0;
    while (<RM>)
    {
 if ($verbose)
 {
     chomp;
     s/'$//;

     if (s/^removed directory: `//)
     {
  print "rmdir $_\n";
     }
     elsif (s/^removed `//)
     {
  print "unlink $_\n";
     }

     $count++;
 }
    }

    close RM;

    $count;
}