1#!/usr/bin/perl -w 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 8use Test; 9BEGIN { plan tests => 13 } 10 11use strict; 12use File::Spec; 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 17my @files; # list of files to remove 18END { foreach (@files) { ok( !(-e $_) )} } 19 20use File::Temp qw/ tempfile unlink0 /; 21ok(1); 22 23# The high security tests must currently be skipped on some platforms 24my $skipplat = ( ( 25 # No sticky bits. 26 $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos' || $^O eq 'mpeix' || $^O eq 'MacOS' 27 ) ? 1 : 0 ); 28 29# Can not run high security tests in perls before 5.6.0 30my $skipperl = ($] < 5.006 ? 1 : 0 ); 31 32# Determine whether we need to skip things and why 33my $skip = 0; 34if ($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 41print "# We will be skipping some tests : $skip\n" if $skip; 42 43# start off with basic checking 44 45File::Temp->safe_level( File::Temp::STANDARD ); 46 47print "# Testing with STANDARD security...\n"; 48 49&test_security(0); 50 51# Try medium 52 53File::Temp->safe_level( File::Temp::MEDIUM ) 54 unless $skip; 55 56print "# Testing with MEDIUM security...\n"; 57 58# Now we need to start skipping tests 59&test_security($skip); 60 61# Try HIGH 62 63File::Temp->safe_level( File::Temp::HIGH ) 64 unless $skip; 65 66print "# Testing with HIGH security...\n"; 67 68&test_security($skip); 69 70exit; 71 72# Subroutine to open two temporary files. 73# one is opened in the current dir and the other in the temp dir 74 75sub 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) { 84 85 skip($skip,1); 86 skip($skip,1); 87 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; 90 91 return; 92 } 93 94 # Create the tempfile 95 my $template = "tmpXXXXX"; 96 my ($fh1, $fname1) = eval { tempfile ( $template, 97 DIR => File::Spec->tmpdir, 98 UNLINK => 1, 99 ); 100 }; 101 102 if (defined $fname1) { 103 print "# fname1 = $fname1\n"; 104 ok( (-e $fname1) ); 105 push(@files, $fname1); # store for end block 106 } elsif (File::Temp->safe_level() != File::Temp::STANDARD) { 107 chomp($@); 108 my $skip2 = "Skip: " . File::Spec->tmpdir() . " possibly insecure: $@. " . 109 "See INSTALL under 'make test'"; 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; 113 } else { 114 ok(0); 115 } 116 117 # Explicitly 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 } 123 my ($fh2, $fname2) = eval { tempfile ($template, UNLINK => 1 ); }; 124 if (defined $fname2) { 125 print "# fname2 = $fname2\n"; 126 ok( (-e $fname2) ); 127 push(@files, $fname2); # store for end block 128 close($fh2); 129 } elsif (File::Temp->safe_level() != File::Temp::STANDARD) { 130 chomp($@); 131 my $skip2 = "Skip: current directory possibly insecure: $@. " . 132 "See INSTALL under 'make test'"; 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; 136 } else { 137 ok(0); 138 } 139 140} 141