t/lib/ftmp-security.t

   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
   8 BEGIN {
   9         chdir 't' if -d 't';
  10         @INC = '../lib';
  11         require Test; import Test;
  12         plan(tests => 13);
  13 }
  14
  15 use strict;
  16 use File::Spec;
  17
  18 # Set up END block - this needs to happen before we load
  19 # File::Temp since this END block must be evaluated after the
  20 # END block configured by File::Temp
  21 my @files; # list of files to remove
  22 END { foreach (@files) { ok( !(-e $_) )} }
  23
  24 use File::Temp qw/ tempfile unlink0 /;
  25 ok(1);
  26
  27 # The high security tests must currently be skipped on Windows
  28 my $skipplat = ( ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos') ? 1 : 0 );
  29
  30 # Can not run high security tests in perls before 5.6.0
  31 my $skipperl  = ($] < 5.006 ? 1 : 0 );
  32
  33 # Determine whether we need to skip things and why
  34 my $skip = 0;
  35 if ($skipplat) {
  36   $skip = "Skip Not supported on this platform";
  37 } elsif ($skipperl) {
  38   $skip = "Skip Perl version must be v5.6.0 for these tests";
  39
  40 }
  41
  42 print "# We will be skipping some tests : $skip\n" if $skip;
  43
  44 # start off with basic checking
  45
  46 File::Temp->safe_level( File::Temp::STANDARD );
  47
  48 print "# Testing with STANDARD security...\n";
  49
  50 &test_security(0);
  51
  52 # Try medium
  53
  54 File::Temp->safe_level( File::Temp::MEDIUM )
  55   unless $skip;
  56
  57 print "# Testing with MEDIUM security...\n";
  58
  59 # Now we need to start skipping tests
  60 &test_security($skip);
  61
  62 # Try HIGH
  63
  64 File::Temp->safe_level( File::Temp::HIGH )
  65   unless $skip;
  66
  67 print "# Testing with HIGH security...\n";
  68
  69 &test_security($skip);
  70
  71 exit;
  72
  73 # Subroutine to open two temporary files.
  74 # one is opened in the current dir and the other in the temp dir
  75
  76 sub test_security {
  77
  78   # Read in the skip flag
  79   my $skip = shift;
  80
  81   # If we are skipping we need to simply fake the correct number
  82   # of tests -- we dont use skip since the tempfile() commands will
  83   # fail with MEDIUM/HIGH security before the skip() command would be run
  84   if ($skip) {
  85
  86     skip($skip,1);
  87     skip($skip,1);
  88
  89     # plus we need an end block so the tests come out in the right order
  90     eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
  91
  92     return;
  93   }
  94
  95   # Create the tempfile
  96   my $template = "temptestXXXXXXXX";
  97   my ($fh1, $fname1) = tempfile ( $template,
  98                                   DIR => File::Spec->tmpdir,
  99                                   UNLINK => 1,
 100                                 );
 101   print "# Fname1 = $fname1\n";
 102   ok( ( -e $fname1) );
 103
 104   # Explicitly
 105   my ($fh2, $fname2) = tempfile ($template,  UNLINK => 1 );
 106   ok( (-e $fname2) );
 107   close($fh2);
 108
 109   # Store filenames for the end block
 110   push(@files, $fname1, $fname2);
 111
 112
 113
 114 }