diff options
| author | Andreas König <a.koenig@mind.de> | 2000-09-01 12:07:20 +0200 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-09-01 13:35:35 +0000 |
| commit | 73f754d1c5ef8e254501d6479aad894713a41ea0 (patch) | |
| tree | a0f89b84943b1b8d9d87b2414390f16d6770633b | |
| parent | e35355fc86a8d4cbceeb314ff2c3d1b0d61b07d0 (diff) | |
| download | perl-73f754d1c5ef8e254501d6479aad894713a41ea0.tar.gz | |
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
| -rw-r--r-- | lib/File/Temp.pm | 8 | ||||
| -rwxr-xr-x | t/lib/ftmp-security.t | 5 |
2 files changed, 11 insertions, 2 deletions
diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm index 16efd5b36a..2dec72c17b 100644 --- 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 b8ae4e5ae9..96b2c4283c 100755 --- 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"; |