Re: [vendor-sec] CAN-2004-0452 File::Path::rmtree() vulnerability

[Brendan O'Dea]

On Fri, Feb 04, 2005 at 03:32:05PM +0100, Thierry Carrez wrote:
>Brendan O'Dea wrote:
>
>> Seems a pretty clean fix, I've applied this to Debian's 5.8.4-5 package. 
>
>Paul Szabo brought to our attention that the fix for CAN-2004-0452 does
>not handle all race conditions cases and that rmtree is still vulnerable :
>
>=============================================
>Just changing the chmod to 0700 and 0600 instead of 0777 and 0666
>does NOT solve the issue. The chmod change was for another, but related,
>problem. See bugs.debian.org/286905 and 286922.
>=============================================
>
>Apparently discussion still rages on how this would best be fixed.
>Any clue ?

Well actually, discussion doesn't rage at all as to how this should be
fixed.

Basically it's been acknowledged as a problem, but one that requires
more than a trivial patch to rmtree to correct, so as such is currently
languishing until such time as rmtree is rewritten to remove the race
condition.

I was kind of hoping that someone else would tackle that task since I
don't really regard myself as a security expert and did't want to make
the problem worse by introducing new, different security issues with a
recursive implementation.

However in the absence of any alternate suggestion, I've appended a
first-cut rmtree replacement.

For the moment I've ignored the third argument entirely; tempted to do
so permanently.

I've also ignored $Is_VMS and $Is_MacOS; will need some input from
perl5-porters as to what changes are required to support those
platforms.

--bod

use strict;
use warnings;
use Carp;
use Cwd 'getcwd';

sub _rmtree;
sub _rmtree
{
    my ($path, $prefix, $up, $up_dev, $up_ino, $verbose) = @_;

    my ($dev, $ino) = lstat $path or return 0;
    unless (-d _)
    {
        unlink $path or return 0;
        print "unlink $prefix$path\n" if $verbose;
        return 1;
    }

    chdir $path or return 0;

    # avoid a race condition where a directory may be replaced by a
    # symlink between the lstat and the chdir
    my ($new_dev, $new_ino) = stat '.';
    unless ("$new_dev:$new_ino" eq "$dev:$ino")
    {
        croak "Directory $prefix$path changed before chdir, aborting\n";
    }

    my $count = 0;
    if (opendir my $dir, '.')
    {
        my $entry;
        while (defined ($entry = readdir $dir))
        {
            next if $entry =~ /^\.\.?$/;
            $count += _rmtree $entry, "$prefix$path/", '..', $dev, $ino,
                $verbose;
        }

        closedir $dir;
    }

    # don't leave the caller in an unexpected directory
    unless (chdir $up)
    {
        croak "Can't return to $up from $prefix$path ($!)\n";
    }

    # ensure that a chdir ..  didn't take us somewhere other than
    # where we expected (see CVE-2002-0435)
    unless (($new_dev, $new_ino) = stat '.'
        and "$new_dev:$new_ino" eq "$up_dev:$up_ino")
    {
        croak "Previous directory $up changed since entering $prefix$path\n";
    }

    if (rmdir $path)
    {
        print "rmdir $prefix$path\n" if $verbose;
        $count++;
    };

    return $count;
}

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

    my $oldpwd = getcwd or do {
        carp "Can't fetch initial working directory\n";
        return;
    };

    my ($dev, $ino) = stat '.' or do {
        carp "Can't stat initial working directory\n";
        return;
    };

    my $count = 0;
    for my $path (@paths)
    {
        $count += _rmtree $path, '', $oldpwd, $dev, $ino, $verbose;
    }

    $count;
}