1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#!/usr/bin/perl -w
# Test for File::Temp - Security levels
# Some of the security checking will not work on all platforms
# Test a simple open in the cwd and tmpdir foreach of the
# security levels
use Test;
BEGIN { plan tests => 13 }
use strict;
use File::Spec;
# Set up END block - this needs to happen before we load
# File::Temp since this END block must be evaluated after the
# END block configured by File::Temp
my @files; # list of files to remove
END { foreach (@files) { ok( !(-e $_) )} }
use File::Temp qw/ tempfile unlink0 /;
ok(1);
# The high security tests must currently be skipped on some platforms
my $skipplat = ( (
# No sticky bits.
$^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos' || $^O eq 'mpeix' || $^O eq 'MacOS'
) ? 1 : 0 );
# Can not run high security tests in perls before 5.6.0
my $skipperl = ($] < 5.006 ? 1 : 0 );
# Determine whether we need to skip things and why
my $skip = 0;
if ($skipplat) {
$skip = "Skip Not supported on this platform";
} elsif ($skipperl) {
$skip = "Skip Perl version must be v5.6.0 for these tests";
}
print "# We will be skipping some tests : $skip\n" if $skip;
# start off with basic checking
File::Temp->safe_level( File::Temp::STANDARD );
print "# Testing with STANDARD security...\n";
&test_security(0);
# Try medium
File::Temp->safe_level( File::Temp::MEDIUM )
unless $skip;
print "# Testing with MEDIUM security...\n";
# Now we need to start skipping tests
&test_security($skip);
# Try HIGH
File::Temp->safe_level( File::Temp::HIGH )
unless $skip;
print "# Testing with HIGH security...\n";
&test_security($skip);
exit;
# Subroutine to open two temporary files.
# one is opened in the current dir and the other in the temp dir
sub test_security {
# Read in the skip flag
my $skip = shift;
# If we are skipping we need to simply fake the correct number
# of tests -- we dont use skip since the tempfile() commands will
# fail with MEDIUM/HIGH security before the skip() command would be run
if ($skip) {
skip($skip,1);
skip($skip,1);
# plus we need an end block so the tests come out in the right order
eval q{ END { skip($skip,1); skip($skip,1) } 1; } || die;
return;
}
# Create the tempfile
my $template = "tmpXXXXX";
my ($fh1, $fname1) = eval { tempfile ( $template,
DIR => File::Spec->tmpdir,
UNLINK => 1,
);
};
if (defined $fname1) {
print "# fname1 = $fname1\n";
ok( (-e $fname1) );
push(@files, $fname1); # store for end block
} elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
chomp($@);
my $skip2 = "Skip: " . File::Spec->tmpdir() . " possibly insecure: $@. " .
"See INSTALL under 'make test'";
skip($skip2, 1);
# plus we need an end block so the tests come out in the right order
eval q{ END { skip($skip2,1); } 1; } || die;
} else {
ok(0);
}
# Explicitly
if ( $< < File::Temp->top_system_uid() ){
skip("Skip Test inappropriate for root", 1);
eval q{ END { skip($skip,1); } 1; } || die;
return;
}
my ($fh2, $fname2) = eval { tempfile ($template, UNLINK => 1 ); };
if (defined $fname2) {
print "# fname2 = $fname2\n";
ok( (-e $fname2) );
push(@files, $fname2); # store for end block
close($fh2);
} elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
chomp($@);
my $skip2 = "Skip: current directory possibly insecure: $@. " .
"See INSTALL under 'make test'";
skip($skip2, 1);
# plus we need an end block so the tests come out in the right order
eval q{ END { skip($skip2,1); } 1; } || die;
} else {
ok(0);
}
}
|
