Retract the dummy test, skip the security tests (instead of failing),

explain what the warnings mean.

p4raw-id: //depot/perl@6928

diff --git a/INSTALL b/INSTALL
index 7025ce0..e78f01e 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -1748,6 +1748,50 @@ test, it does not necessarily mean you have a broken perl.  This test
 tries to exercise the regular expression subsystem quite thoroughly,
 and may well be far more demanding than your normal usage.
 
+=item Test failures from lib/ftmp-security saying "system possibly insecure"
+
+Firstly, test failures from the ftmp-security are not necessarily
+serious or indicative of a real security threat.  That being said,
+they bear investigating.
+
+The tests may fail for the following reasons.   Note that each of the
+tests is run both in the building directory and the temporary
+directory, as returned by File::Spec->tmpdir().
+
+(1) If the directory the tests are being run is owned by somebody else
+than the user running the tests, or root (uid 0).  This failure can
+happen if the Perl source code distribution is unpacked in a way that
+the user ids in the distribution package are used as-is.  Some tar
+programs do this.
+
+(2) If the directory the test are being run in is writable by group
+or by other (remember: with UNIX/POSIX semantics, write access to
+a directory means the right to add/remove files in that directory),
+and there is no sticky bit set in the directory.  'Sticky bit' is
+a feature used in some UNIXes to give extra protection to files: if
+the bit is on a directory, no one but the owner (or the root) can remove
+that file even if the permissions of the directory would allow file
+removal by others.  This failure can happen if the permissions in the
+directory simply are a bit too liberal for the tests' liking.  This
+may or may not be a real problem: it depends on the permissions policy
+used on this particular directory/project/system/site.  This failure
+can also happen if the system either doesn't support the sticky bit
+(this is the case with many non-UNIX platforms: in principle the
+File::Temp should know about these platforms and skip the tests), or
+if the system supports the sticky bit but for some reason or reasons
+it is not being used.  This is for example the case with HP-UX: as of
+HP-UX release 11.00, the sticky bit is very much supported, but HP-UX
+doesn't use it on its /tmp directory as shipped.  Also as with the
+permissions, some local policy might dictate that the stickiness is
+not used.
+
+(3) If any of the parent directories of the temporary file back to the
+root directory of the are 'unsafe', using the definitions given above
+in (1) and (2).
+
+See the documentation for the File::Temp module for more information
+about the various security aspects.
+
 =back
 
 =head1 make install

diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm
index 6548018..16efd5b 100644 (file)
--- a/lib/File/Temp.pm
+++ b/lib/File/Temp.pm
@@ -95,12 +95,12 @@ filehandle of a temporary file.  The tempdir() function can
 be used to create a temporary directory.
 
 The security aspect of temporary file creation is emphasized such that
-a filehandle and filename are returned together.  This helps guarantee that 
-a race condition can not occur where the temporary file is created by another process 
-between checking for the existence of the file and its
-opening.  Additional security levels are provided to check, for 
-example, that the sticky bit is set on world writable directories.
-See L<"safe_level"> for more information.
+a filehandle and filename are returned together.  This helps guarantee
+that a race condition can not occur where the temporary file is
+created by another process between checking for the existence of the
+file and its opening.  Additional security levels are provided to
+check, for example, that the sticky bit is set on world writable
+directories.  See L<"safe_level"> for more information.
 
 For compatibility with popular C library functions, Perl implementations of
 the mkstemp() family of functions are provided. These are, mkstemp(),

diff --git a/t/lib/ftmp-security.t b/t/lib/ftmp-security.t
index 3f563f4..18f427d 100755 (executable)
--- a/t/lib/ftmp-security.t
+++ b/t/lib/ftmp-security.t
@@ -24,8 +24,11 @@ END { foreach (@files) { ok( !(-e $_) )} }
 use File::Temp qw/ tempfile unlink0 /;
 ok(1);
 
-# The high security tests must currently be skipped on Windows
-my $skipplat = ( ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos') ? 1 : 0 );
+# The high security tests must currently be skipped on some platforms
+my $skipplat = ( (
+                 # No sticky bits.
+                 $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos'
+                 ) ? 1 : 0 );
 
 # Can not run high security tests in perls before 5.6.0
 my $skipperl  = ($] < 5.006 ? 1 : 0 );
@@ -93,28 +96,32 @@ sub test_security {
   }
 
   # Create the tempfile
-  my $template = "temptestXXXXXXXX";
+  my $template = "tmpXXXXX";
   my ($fh1, $fname1) = tempfile ( $template, 
                                  DIR => File::Spec->tmpdir,
                                  UNLINK => 1,
                                );
-  print "# Fname1 = $fname1\n";
-  ok( ( -e $fname1) );
+  if (defined $fname1) {
+      print "# fname1 = $fname1\n";
+      ok( (-e $fname1) );
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      skip("system possibly insecure, see INSTALL, section 'make test'", 1);
+  } else {
+      ok(0);
+  }
 
   # Explicitly 
-# Disabled temporarily since people seem to have funky owner/permissions setups
-# --jhi 2000-08-29
-#  my ($fh2, $fname2) = tempfile ($template,  UNLINK => 1 );
-  my($fname2) = "foobar$$";
-  my $fh2;
-  open($fh2, ">$fname2") || warn "$0: failed to create '$fname2': $!\n";
-  END { unlink($fname2) }
-  ok( (-e $fname2) );
-  close($fh2);
+  my ($fh2, $fname2) = tempfile ($template,  UNLINK => 1 );
+  if (defined $fname2) {
+      print "# fname2 = $fname2\n";
+      ok( (-e $fname2) );
+      close($fh2);
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      skip("system possibly insecure, see INSTALL, section 'make test'", 1);
+  } else {
+      ok(0);
+  }
 
   # Store filenames for the end block
   push(@files, $fname1, $fname2);
-
-
-
 }