File::Temp patches from Andreas König,

Subject: Re: [ID 20000831.046] OK: perl v5.7.0 +DEVEL6961 on sun4-solaris 2.8  (UNINSTALLED)
Date: 01 Sep 2000 10:07:20 +0200
Message-ID: <m3lmxc1qo7.fsf@ak-71.mind.de>

Subject: Re: Almost OK: perl v5.7.0 +DEVEL6937 on PA-RISC2.0 11.00 (INSTALLED)
From: andreas.koenig@anima.de (Andreas J. Koenig)
Date: 31 Aug 2000 23:26:08 +0200
Message-ID: <m3bsy92kcv.fsf@ak-71.mind.de>

p4raw-id: //depot/perl@6964

diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm
index 16efd5b..2dec72c 100644 (file)
--- a/lib/File/Temp.pm
+++ b/lib/File/Temp.pm
@@ -608,8 +608,12 @@ sub _is_safe {
   # Check to see whether owner is neither superuser (or a system uid) nor me
   # Use the real uid from the $< variable
   # UID is in [4]
-  if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
-    carp "Directory owned neither by root nor the current user";
+  if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+    Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+               File::Temp->top_system_uid());
+
+    carp "Directory owned neither by root nor the current user.";
     return 0;
   }
 

diff --git a/t/lib/ftmp-security.t b/t/lib/ftmp-security.t
index b8ae4e5..96b2c42 100755 (executable)
--- a/t/lib/ftmp-security.t
+++ b/t/lib/ftmp-security.t
@@ -117,6 +117,11 @@ sub test_security {
   }
 
   # Explicitly 
+  if ( $< < File::Temp->top_system_uid() ){
+      skip("Skip Test inappropriate for root", 1);
+      eval q{ END { skip($skip,1); } 1; } || die;
+      return;
+  }
   my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
   if (defined $fname2) {
       print "# fname2 = $fname2\n";