lib/File/Temp/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 some platforms
  28 my $skipplat = ( (
  29                   # No sticky bits.
  30                   $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos'
  31                   ) ? 1 : 0 );
  32
  33 # Can not run high security tests in perls before 5.6.0
  34 my $skipperl  = ($] < 5.006 ? 1 : 0 );
  35
  36 # Determine whether we need to skip things and why
  37 my $skip = 0;
  38 if ($skipplat) {
  39   $skip = "Skip Not supported on this platform";
  40 } elsif ($skipperl) {
  41   $skip = "Skip Perl version must be v5.6.0 for these tests";
  42
  43 }
  44
  45 print "# We will be skipping some tests : $skip\n" if $skip;
  46
  47 # start off with basic checking
  48
  49 File::Temp->safe_level( File::Temp::STANDARD );
  50
  51 print "# Testing with STANDARD security...\n";
  52
  53 &test_security(0);
  54
  55 # Try medium
  56
  57 File::Temp->safe_level( File::Temp::MEDIUM )
  58   unless $skip;
  59
  60 print "# Testing with MEDIUM security...\n";
  61
  62 # Now we need to start skipping tests
  63 &test_security($skip);
  64
  65 # Try HIGH
  66
  67 File::Temp->safe_level( File::Temp::HIGH )
  68   unless $skip;
  69
  70 print "# Testing with HIGH security...\n";
  71
  72 &test_security($skip);
  73
  74 exit;
  75
  76 # Subroutine to open two temporary files.
  77 # one is opened in the current dir and the other in the temp dir
  78
  79 sub test_security {
  80
  81   # Read in the skip flag
  82   my $skip = shift;
  83
  84   # If we are skipping we need to simply fake the correct number
  85   # of tests -- we dont use skip since the tempfile() commands will
  86   # fail with MEDIUM/HIGH security before the skip() command would be run
  87   if ($skip) {
  88
  89     skip($skip,1);
  90     skip($skip,1);
  91
  92     # plus we need an end block so the tests come out in the right order
  93     eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
  94
  95     return;
  96   }
  97
  98   # Create the tempfile
  99   my $template = "tmpXXXXX";
 100   my ($fh1, $fname1) = eval { tempfile ( $template,
 101                                   DIR => File::Spec->tmpdir,
 102                                   UNLINK => 1,
 103                                 );
 104                             };
 105
 106   if (defined $fname1) {
 107       print "# fname1 = $fname1\n";
 108       ok( (-e $fname1) );
 109       push(@files, $fname1); # store for end block
 110   } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
 111       my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
 112       skip($skip2, 1);
 113       # plus we need an end block so the tests come out in the right order
 114       eval q{ END { skip($skip2,1); } 1; } || die;
 115   } else {
 116       ok(0);
 117   }
 118
 119   # Explicitly
 120   if ( $< < File::Temp->top_system_uid() ){
 121       skip("Skip Test inappropriate for root", 1);
 122       eval q{ END { skip($skip,1); } 1; } || die;
 123       return;
 124   }
 125   my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
 126   if (defined $fname2) {
 127       print "# fname2 = $fname2\n";
 128       ok( (-e $fname2) );
 129       push(@files, $fname2); # store for end block
 130       close($fh2);
 131   } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
 132       my $skip2 = "Skip system possibly insecure, see INSTALL, section '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 }