Prevent path disclosure (probing for existence of filenames)

using suidperl; bug id 20010322.218.

p4raw-id: //depot/perl@9813

diff --git a/perl.c b/perl.c
index 834dc46..4a423dc 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2718,8 +2718,14 @@ sed %s -e \"/^[^#]/b\" \
        }
 #endif
 #endif
+#ifdef IAMSUID
+       errno = EPERM;
+       Perl_croak(aTHX_ "Can't open perl script: %s\n",
+                  Strerror(errno));
+#else
        Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                   CopFILE(PL_curcop), Strerror(errno));
+#endif
     }
 }
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 307f22d..98b2580 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -868,7 +868,7 @@ the command line for writing.
 redirection, and couldn't open the pipe into which to send data destined
 for stdout.
 
-=item Can't open perl script "%s": %s
+=item Can't open perl script%s: %s
 
 (F) The script you specified can't be opened for the indicated reason.