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