[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.

doio.c

@@ -216,6 +216,9 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
 		goto say_false;
 	    }
 #endif /* USE_STDIO */
+	    if (!IS_SAFE_PATHNAME(*svp, "open"))
+                goto say_false;
+
 	    name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
 			savesvpv (*svp) : savepvs ("");
 	    SAVEFREEPV(name);
@@ -1660,8 +1663,10 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
 		else {
 		    const char *name = SvPV_nomg_const_nolen(*mark);
 		    APPLY_TAINT_PROPER();
-		    if (PerlLIO_chmod(name, val))
-			tot--;
+                    if (!IS_SAFE_PATHNAME(*mark, "chmod") ||
+                        PerlLIO_chmod(name, val)) {
+                        tot--;
+                    }
 		}
 	    }
 	}
@@ -1694,8 +1699,10 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
 		else {
 		    const char *name = SvPV_nomg_const_nolen(*mark);
 		    APPLY_TAINT_PROPER();
-		    if (PerlLIO_chown(name, val, val2))
+                    if (!IS_SAFE_PATHNAME(*mark, "chown") ||
+                        PerlLIO_chown(name, val, val2)) {
 			tot--;
+                    }
 		}
 	    }
 	}
@@ -1795,7 +1802,10 @@ nothing in the core.
 	while (++mark <= sp) {
 	    s = SvPV_nolen_const(*mark);
 	    APPLY_TAINT_PROPER();
-	    if (PerlProc_geteuid() || PL_unsafe) {
+	    if (!IS_SAFE_PATHNAME(*mark, "unlink")) {
+                tot--;
+            }
+	    else if (PerlProc_geteuid() || PL_unsafe) {
 		if (UNLINK(s))
 		    tot--;
 	    }
@@ -1873,6 +1883,10 @@ nothing in the core.
 		else {
 		    const char * const name = SvPV_nomg_const_nolen(*mark);
 		    APPLY_TAINT_PROPER();
+		    if (!IS_SAFE_PATHNAME(*mark, "utime")) {
+                        tot--;
+                    }
+                    else
 #ifdef HAS_FUTIMES
 		    if (utimes(name, (struct timeval *)utbufp))
 #else
@@ -2365,6 +2379,9 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 
     PERL_ARGS_ASSERT_START_GLOB;
 
+    if (!IS_SAFE_SYSCALL(tmpglob, "pattern", "glob"))
+        return NULL;
+
     ENTER;
     SAVEFREESV(tmpcmd);
 #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */

embed.fnc

@@ -1601,6 +1601,8 @@ Am	|I32	|whichsig	|NN const char* sig
 Ap     |I32    |whichsig_sv    |NN SV* sigsv
 Ap     |I32    |whichsig_pv    |NN const char* sig
 Ap     |I32    |whichsig_pvn   |NN const char* sig|STRLEN len
+: used to check for NULs in pathnames and other names
+AiR	|bool	|is_safe_syscall|NN SV *pv|NN const char *what|NN const char *op_name
 : Used in pp_ctl.c
 p	|void	|write_to_stderr|NN SV* msv
 : Used in op.c
@@ -2280,7 +2282,7 @@ s	|void	|printbuf	|NN const char *const fmt|NN const char *const s
 EXMp	|bool	|validate_proto	|NN SV *name|NULLOK SV *proto|bool warn
 
 #if defined(PERL_IN_UNIVERSAL_C)
-s	|bool|isa_lookup	|NN HV *stash|NN const char * const name \
+s	|bool	|isa_lookup	|NN HV *stash|NN const char * const name \
                                         |STRLEN len|U32 flags
 #endif
 
@@ -2292,7 +2294,7 @@ s	|bool	|is_cur_LC_category_utf8|int category
 #if defined(PERL_IN_UTIL_C)
 s	|const COP*|closest_cop	|NN const COP *cop|NULLOK const OP *o
 s	|SV*	|mess_alloc
-s	|SV *|with_queued_errors|NN SV *ex
+s	|SV *	|with_queued_errors|NN SV *ex
 s	|bool	|invoke_exception_hook|NULLOK SV *ex|bool warn
 #if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL)
 sn	|void	|mem_log_common	|enum mem_log_type mlt|const UV n|const UV typesize \

embed.h

@@ -230,6 +230,7 @@
 #define instr			Perl_instr
 #define is_ascii_string		Perl_is_ascii_string
 #define is_lvalue_sub()		Perl_is_lvalue_sub(aTHX)
+#define is_safe_syscall(a,b,c)	S_is_safe_syscall(aTHX_ a,b,c)
 #define is_uni_alnum(a)		Perl_is_uni_alnum(aTHX_ a)
 #define is_uni_alnum_lc(a)	Perl_is_uni_alnum_lc(aTHX_ a)
 #define is_uni_alnumc(a)	Perl_is_uni_alnumc(aTHX_ a)

ext/File-Glob/Glob.pm

@@ -37,7 +37,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob"
 
 @EXPORT_OK   = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
 
-$VERSION = '1.20';
+$VERSION = '1.21';
 
 sub import {
     require Exporter;

ext/File-Glob/Glob.xs

@@ -227,7 +227,9 @@ csh_glob(pTHX_ AV *entries, SV *patsv)
 
 	assert(SvTYPE(entries) != SVt_PVAV);
 	sv_upgrade((SV *)entries, SVt_PVAV);
-
+        if (!IS_SAFE_SYSCALL(patsv, "pattern", "glob"))
+            return FALSE;
+
 	if (patav) {
 	    I32 items = AvFILLp(patav) + 1;
 	    SV **svp = AvARRAY(patav);

inline.h

@@ -221,3 +221,53 @@ S_isALNUM_lazy(pTHX_ const char* p)
 
     return isALNUM_lazy_if(p,1);
 }
+
+/* ------------------------------- perl.h ----------------------------- */
+
+/*
+=for apidoc AiR|bool|is_safe_syscall|SV *pv|const char *what|const char *op_name
+
+Test that the given C<pv> doesn't contain any internal NUL characters.
+If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
+
+Return TRUE if the name is safe.
+
+Used by the IS_SAFE_SYSCALL() macro.
+
+=cut
+*/
+
+PERL_STATIC_INLINE bool
+S_is_safe_syscall(pTHX_ SV *pv, const char *what, const char *op_name) {
+    /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
+     * perl itself uses xce*() functions which accept 8-bit strings.
+     */
+
+    PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
+
+    if (SvPOK(pv) && SvCUR(pv) >= 1) {
+        char *p = SvPVX(pv);
+        char *null_at;
+        if (UNLIKELY((null_at = (char *)memchr(p, 0, SvCUR(pv)-1)) != NULL)) {
+                SETERRNO(ENOENT, LIB_INVARG);
+                if (ckWARN(WARN_SYSCALLS)) {
+                    Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
+                                   "Invalid \\0 character in %s for %s: %s\\0%s",
+                                   what, op_name, p, null_at+1);
+                }
+                return FALSE;
+        }
+    }
+
+    return TRUE;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 et:
+ */