File::Path::rmtree(): 2017 Vulnerability Addressed

• rmtree() modified in version 2.14

            my ( $ldev, $lino, $perm ) = ( lstat $root )[ 0, 1, 2 ]
              or next ROOT_DIR;

            if ( -d _ ) {
                $root = VMS::Filespec::vmspath( VMS::Filespec::pathify($root) )
                  if _IS_VMS;

                if ( !chdir($root) ) {

                    # see if we can escalate privileges to get in
                    # (e.g. funny protection mask such as -w- instead of rwx)
        -                $perm &= oct '7777';
        -                my $nperm = $perm | oct '700';
        -                if (
        -                    !(
        -                           $data->{safe}
        -                        or $nperm == $perm
        -                        or chmod( $nperm, $root )
        -                    )
        -                  )
        -                {
        -                    _error( $data,
        -                        "cannot make child directory read-write-exec", $canon );
        -                    next ROOT_DIR;
        +                # This uses fchmod to avoid traversing outside of the proper
        +                # location (CVE-2017-6512)
        +                my $root_fh;
        +                if (open($root_fh, '<', $root)) {
        +                    my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1];
        +                    $perm &= oct '7777';
        +                    my $nperm = $perm | oct '700';
        +                    local $@;
        +                    if (
        +                        !(
        +                              $data->{safe}
        +                           or $nperm == $perm
        +                           or !-d _
        +                           or $fh_dev ne $ldev
        +                           or $fh_inode ne $lino
        +                           or eval { chmod( $nperm, $root_fh ) }
        +                        )
        +                      )
        +                    {
        +                        _error( $data,
        +                            "cannot make child directory read-write-exec", $canon );
        +                        next ROOT_DIR;
        +                    }
        +                    close $root_fh;
                    }
        -                elsif ( !chdir($root) ) {
        -                    _error( $data, "cannot chdir to child", $canon );
        +                if ( !chdir($root) ) {
        +                    _error( $data, "cannot chdir to child", $canon );
                        next ROOT_DIR;
                    }
                }

                my ( $cur_dev, $cur_inode, $perm ) = ( stat $curdir )[ 0, 1, 2 ]
                  or do {
                   _error( $data, "cannot stat current working directory", $canon );
                    next ROOT_DIR;
                  };