From c8028aa68dedb3c7683abb0bcf0fdba782a1190e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 26 Aug 2013 11:26:19 +1000
Subject: [perl #117265] safesyscalls: check embedded nul in syscall args

Check for the nul char in pathnames and string arguments to
syscalls, return undef and set errno to ENOENT.
Added to the io warnings category syscalls.

Strings with embedded \0 chars were prev. ignored in the syscall but
kept in perl. The hidden payloads in these invalid string args may cause
unnoticed security problems, as they are hard to detect, ignored by
the syscalls but kept around in perl PVs.
Allow an ending \0 though, as several modules add a \0 to
such strings without adjusting the length.

This is based on a change originally by Reini Urban, but pretty much
all of the code has been replaced.
---
 pp_ctl.c | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

(limited to 'pp_ctl.c')

diff --git a/pp_ctl.c b/pp_ctl.c
index b71648c498..262c930026 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3586,10 +3586,21 @@ S_check_type_and_open(pTHX_ SV *name)
 {
     Stat_t st;
     const char *p = SvPV_nolen_const(name);
-    const int st_rc = PerlLIO_stat(p, &st);
+    int st_rc;
 
     PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN;
 
+    /* checking here captures a reasonable error message when
+     * PERL_DISABLE_PMC is true, but when PMC checks are enabled, the
+     * user gets a confusing message about looking for the .pmc file
+     * rather than for the .pm file.
+     * This check prevents a \0 in @INC causing problems.
+     */
+    if (!IS_SAFE_PATHNAME(name, "require"))
+        return NULL;
+
+    st_rc = PerlLIO_stat(p, &st);
+
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
 	return NULL;
     }
@@ -3610,6 +3621,13 @@ S_doopen_pm(pTHX_ SV *name)
 
     PERL_ARGS_ASSERT_DOOPEN_PM;
 
+    /* check the name before trying for the .pmc name to avoid the
+     * warning referring to the .pmc which the user probably doesn't
+     * know or care about
+     */
+    if (!IS_SAFE_PATHNAME(name, "require"))
+        return NULL;
+
     if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) {
 	SV *const pmcsv = sv_newmortal();
 	Stat_t pmcstat;
@@ -3742,6 +3760,12 @@ PP(pp_require)
     name = SvPV_const(sv, len);
     if (!(name && len > 0 && *name))
 	DIE(aTHX_ "Null filename used");
+    if (!IS_SAFE_PATHNAME(sv, "require")) {
+        DIE(aTHX_ "Can't locate %s:   %s",
+            pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
+                      SvCUR(sv)*2,NULL, SvUTF8(sv)?PERL_PV_ESCAPE_UNI:0),
+            Strerror(ENOENT));
+    }
     TAINT_PROPER("require");
 
     path_searchable = path_is_searchable(name);
-- 
cgit v1.2.1