view release on metacpan or  search on metacpan

ext/File-Find/t/taint.t  view on Meta::CPAN

use strict;
use lib qw( ./t/lib );

BEGIN {
    require File::Spec;
    if ($ENV{PERL_CORE}) {
        # May be doing dynamic loading while @INC is all relative
        @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC;
    }
    if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') {
        # This is a hack - at present File::Find does not produce native names
        # on Win32 or VMS, so force File::Spec to use Unix names.
        # must be set *before* importing File::Find
        require File::Spec::Unix;
        @File::Spec::ISA = 'File::Spec::Unix';
    }
}

use Test::More;
use File::Find;
use File::Spec;
use Cwd;
use Testing qw(
    create_file_ok
    mkdir_ok
    symlink_ok
    dir_path
    file_path
    _cleanup_start
);
use Errno ();
use Config;
use File::Temp qw(tempdir);

BEGIN {
    plan(
        ${^TAINT}
        ? (tests => 48)
        : (skip_all => "A perl without taint support")
    );
}

my %Expect_File = (); # what we expect for $_
my %Expect_Name = (); # what we expect for $File::Find::name/fullname
my %Expect_Dir  = (); # what we expect for $File::Find::dir
my ($cwd, $cwd_untainted);

BEGIN {
    if ($^O ne 'VMS') {
        for (keys %ENV) { # untaint ENV
            ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
        }
    }

    # Remove insecure directories from PATH
    my @path;
    my $sep = $Config{path_sep};
    foreach my $dir (split(/\Q$sep/,$ENV{'PATH'}))
    {
        ##
        ## Match the directory taint tests in mg.c::Perl_magic_setenv()
        ##
        push(@path,$dir) unless (length($dir) >= 256
                                 or
                                 substr($dir,0,1) ne "/"
                                 or
                                 (stat $dir)[2] & 002);
    }
    $ENV{'PATH'} = join($sep,@path);
}

my $symlink_exists = eval { symlink("",""); 1 };

my $test_root_dir; # where we are when this test starts
my $test_root_dir_tainted = cwd();
if ($test_root_dir_tainted =~ /^(.*)$/) {
    $test_root_dir = $1;
} else {
    die "Failed to untaint root dir of test";
}
ok($test_root_dir,"test_root_dir is set up as expected");
my $test_temp_dir = tempdir("FF_taint_t_XXXXXX",CLEANUP=>1);
ok($test_temp_dir,"test_temp_dir is set up as expected");

my $found;
find({wanted => sub { ++$found if $_ eq 'taint.t' },
                untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);

is($found, 1, 'taint.t found once');
$found = 0;

finddepth({wanted => sub { ++$found if $_ eq 'taint.t'; },
           untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);

is($found, 1, 'taint.t found once again');

my $case = 2;
my $FastFileTests_OK = 0;

my $chdir_error = "";
chdir($test_temp_dir)
    or $chdir_error = "Failed to chdir to '$test_temp_dir': $!";
is($chdir_error,"","chdir to temp dir '$test_temp_dir' successful")
    or die $chdir_error;

sub cleanup {
    # the following chdirs into $test_root_dir/$test_temp_dir but
    # handles various possible edge case errors cleanly. If it returns
    # false then we bail out of the cleanup.
    _cleanup_start($test_root_dir, $test_temp_dir)
        or return;

    my $need_updir = 0;
    if (-d dir_path('for_find_taint')) {
        $need_updir = 1 if chdir(dir_path('for_find_taint'));
    }
    if (-d dir_path('fa_taint')) {
        unlink file_path('fa_taint', 'fa_ord'),
               file_path('fa_taint', 'fsl'),
               file_path('fa_taint', 'faa', 'faa_ord'),
               file_path('fa_taint', 'fab', 'fab_ord'),