[perl #117265] safesyscalls: check embedded nul in syscall args
authorTony Cook <tony@develop-help.com>
Mon, 26 Aug 2013 01:26:19 +0000 (11:26 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 26 Aug 2013 04:06:16 +0000 (14:06 +1000)
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.

20 files changed:
doio.c
embed.fnc
embed.h
ext/File-Glob/Glob.pm
ext/File-Glob/Glob.xs
inline.h
lib/warnings.pm
perl.h
perlio.c
pod/perldiag.pod
pod/perllexwarn.pod
pp_ctl.c
proto.h
regen/warnings.pl
t/io/open.t
t/lib/warnings/doio
t/op/caller.t
t/op/require_errors.t
t/porting/diag.t
warnings.h

diff --git a/doio.c b/doio.c
index b24a5b4..d79bf44 100644 (file)
--- a/doio.c
+++ b/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, */
index d223f0d..559be3e 100644 (file)
--- a/embed.fnc
+++ b/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 \
diff --git a/embed.h b/embed.h
index 49700ca..8874b68 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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)
index 379d7f0..3001679 100644 (file)
@@ -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;
index df5530a..43904df 100644 (file)
@@ -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);
index b33cd3f..86deaf5 100644 (file)
--- a/inline.h
+++ b/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:
+ */
index 7d988cb..3a08b67 100644 (file)
@@ -5,7 +5,7 @@
 
 package warnings;
 
-our $VERSION = '1.18';
+our $VERSION = '1.19';
 
 # Verify that we're called correctly so that warnings will work.
 # see also strict.pm.
@@ -233,130 +233,136 @@ our %Offsets = (
     'experimental::lexical_topic'=> 106,
     'experimental::regex_sets'=> 108,
     'experimental::smartmatch'=> 110,
+
+    # Warnings Categories added in Perl 5.019
+
+    'syscalls'         => 112,
   );
 
 our %Bits = (
-    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..55]
-    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [29]
-    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [30]
-    'closed'           => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'closure'          => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'                => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'       => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [31]
-    'exec'             => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'exiting'          => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55", # [51..55]
-    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [52]
-    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [53]
-    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [54]
-    'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [55]
-    'glob'             => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'illegalproto'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [47]
-    'imprecision'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [46]
-    'inplace'          => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
-    'internal'         => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [24]
-    'io'               => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
-    'layer'            => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'malloc'           => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [25]
-    'misc'             => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'newline'          => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'non_unicode'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [48]
-    'nonchar'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [49]
-    'numeric'          => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'once'             => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'overflow'         => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'pack'             => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [32]
-    'pipe'             => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'portable'         => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [33]
-    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [34]
-    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [35]
-    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [36]
-    'recursion'                => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'redefine'         => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'regexp'           => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
-    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [37]
-    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [38]
-    'severe'           => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00", # [21..25]
-    'signal'           => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [26]
-    'substr'           => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [27]
-    'surrogate'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [50]
-    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00", # [28..38,47]
-    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [39]
-    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [40]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [41]
-    'unopened'         => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [42]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [43]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00", # [44,48..50]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [45]
+    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..56]
+    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [29]
+    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [30]
+    'closed'           => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'          => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'debugging'                => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
+    'deprecated'       => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [31]
+    'exec'             => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'          => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'experimental'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x00", # [51..55]
+    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [52]
+    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [53]
+    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [54]
+    'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [55]
+    'glob'             => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'illegalproto'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [47]
+    'imprecision'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [46]
+    'inplace'          => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'         => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
+    'io'               => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [5..11,56]
+    'layer'            => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'           => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
+    'misc'             => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'          => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'non_unicode'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [48]
+    'nonchar'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [49]
+    'numeric'          => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'             => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'         => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'             => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [32]
+    'pipe'             => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'         => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [33]
+    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [34]
+    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [35]
+    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [36]
+    'recursion'                => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'         => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'           => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [37]
+    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [38]
+    'severe'           => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
+    'signal'           => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
+    'substr'           => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
+    'surrogate'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [50]
+    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00", # [28..38,47]
+    'syscalls'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [56]
+    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [39]
+    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [40]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [41]
+    'unopened'         => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [42]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [43]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00", # [44,48..50]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [45]
   );
 
 our %DeadBits = (
-    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..55]
-    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [29]
-    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [30]
-    'closed'           => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
-    'closure'          => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'                => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'       => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [31]
-    'exec'             => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
-    'exiting'          => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa", # [51..55]
-    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [52]
-    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [53]
-    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [54]
-    'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [55]
-    'glob'             => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'illegalproto'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [47]
-    'imprecision'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [46]
-    'inplace'          => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
-    'internal'         => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [24]
-    'io'               => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
-    'layer'            => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'malloc'           => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [25]
-    'misc'             => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'newline'          => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'non_unicode'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [48]
-    'nonchar'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [49]
-    'numeric'          => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'once'             => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'overflow'         => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'pack'             => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [32]
-    'pipe'             => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'portable'         => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [33]
-    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [34]
-    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [35]
-    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [36]
-    'recursion'                => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'redefine'         => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'regexp'           => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
-    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [37]
-    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [38]
-    'severe'           => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00", # [21..25]
-    'signal'           => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [26]
-    'substr'           => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [27]
-    'surrogate'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [50]
-    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00", # [28..38,47]
-    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [39]
-    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [40]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [41]
-    'unopened'         => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [42]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [43]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00", # [44,48..50]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [45]
+    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..56]
+    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [29]
+    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [30]
+    'closed'           => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+    'closure'          => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+    'debugging'                => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
+    'deprecated'       => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [31]
+    'exec'             => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+    'exiting'          => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+    'experimental'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x00", # [51..55]
+    'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [52]
+    'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [53]
+    'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [54]
+    'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [55]
+    'glob'             => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+    'illegalproto'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [47]
+    'imprecision'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [46]
+    'inplace'          => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'         => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
+    'io'               => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [5..11,56]
+    'layer'            => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'           => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
+    'misc'             => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'          => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'non_unicode'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [48]
+    'nonchar'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [49]
+    'numeric'          => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'             => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'         => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'             => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [32]
+    'pipe'             => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'         => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [33]
+    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [34]
+    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [35]
+    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [36]
+    'recursion'                => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'         => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'           => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [37]
+    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [38]
+    'severe'           => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
+    'signal'           => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
+    'substr'           => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
+    'surrogate'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [50]
+    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00", # [28..38,47]
+    'syscalls'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [56]
+    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [39]
+    'threads'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [40]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [41]
+    'unopened'         => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [42]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [43]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00", # [44,48..50]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [45]
   );
 
-$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-$DEFAULT  = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55", # [2,52..55,4,22,23,25]
-$LAST_BIT = 112 ;
-$BYTES    = 14 ;
+$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
+$DEFAULT  = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x00", # [2,52..55,4,22,23,25]
+$LAST_BIT = 114 ;
+$BYTES    = 15 ;
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 
diff --git a/perl.h b/perl.h
index d2c5568..90495fd 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5671,6 +5671,12 @@ extern void moncontrol(int);
 #  define do_aexec(really, mark,sp)    do_aexec5(really, mark, sp, 0, 0)
 #endif
 
+/* check embedded \0 characters in pathnames passed to syscalls,
+   but allow one ending \0 */
+#define IS_SAFE_SYSCALL(pv, what, op_name) (S_is_safe_syscall(aTHX_ (pv), (what), (op_name)))
+
+#define IS_SAFE_PATHNAME(pv, op_name) IS_SAFE_SYSCALL((pv), "pathname", (op_name))
+
 #if defined(OEMVS)
 #define NO_ENV_ARRAY_IN_MAIN
 #endif
index 2e5a77d..963c3e8 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -310,6 +310,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
            return PerlIO_tmpfile();
        else {
            const char *name = SvPV_nolen_const(*args);
+            if (!IS_SAFE_PATHNAME(*args, "open"))
+                return NULL;
+
            if (*mode == IoTYPE_NUMERIC) {
                fd = PerlLIO_open3(name, imode, perm);
                if (fd >= 0)
@@ -2719,6 +2722,8 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
        if (imode != -1) {
            const char *path = SvPV_nolen_const(*args);
+           if (!IS_SAFE_PATHNAME(*args, "open"))
+                return NULL;
            fd = PerlLIO_open3(path, imode, perm);
        }
     }
@@ -3033,6 +3038,8 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        const char * const path = SvPV_nolen_const(*args);
        PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio);
        FILE *stdio;
+       if (!IS_SAFE_PATHNAME(*args, "open"))
+            return NULL;
        PerlIOUnix_refcnt_dec(fileno(s->stdio));
        stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
                            s->stdio);
@@ -3045,6 +3052,8 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
        if (narg > 0) {
            const char * const path = SvPV_nolen_const(*args);
+            if (!IS_SAFE_PATHNAME(*args, "open"))
+                return NULL;
            if (*mode == IoTYPE_NUMERIC) {
                mode++;
                fd = PerlLIO_open3(path, imode, perm);
index 23f147d..db8f898 100644 (file)
@@ -2505,6 +2505,12 @@ the indicated name isn't valid.  See L<charnames/CUSTOM ALIASES>.
 (F) Only certain characters are valid for character names.  The
 indicated one isn't.  See L<charnames/CUSTOM ALIASES>.
 
+=item Invalid \0 character in %s for %s: %s\0%s
+
+(W syscalls) Embedded \0 characters in pathnames or other syscall
+arguments create a warning since 5.20. The parts after the \0 were
+formerly ignored by syscalls.
+
 =item Invalid conversion in %s: "%s"
 
 (W printf) Perl does not understand the given format conversion.  See
index b193e3c..0d76e93 100644 (file)
@@ -252,6 +252,8 @@ will be lost.
          |                 |
          |                 +- pipe
          |                 |
+         |                 +- syscalls
+         |                 |
          |                 +- unopened
          |
          +- misc
index b71648c..262c930 100644 (file)
--- 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);
diff --git a/proto.h b/proto.h
index 0bc3b55..5b3a98f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1741,6 +1741,14 @@ PERL_CALLCONV bool       Perl_is_ascii_string(const U8 *s, STRLEN len)
 PERL_CALLCONV I32      Perl_is_lvalue_sub(pTHX)
                        __attribute__warn_unused_result__;
 
+PERL_STATIC_INLINE bool        S_is_safe_syscall(pTHX_ SV *pv, const char *what, const char *op_name)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2)
+                       __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_IS_SAFE_SYSCALL       \
+       assert(pv); assert(what); assert(op_name)
+
 PERL_CALLCONV bool     Perl_is_uni_alnum(pTHX_ UV c)
                        __attribute__deprecated__
                        __attribute__warn_unused_result__
index 72d9a0b..a3e2b44 100644 (file)
@@ -19,7 +19,7 @@
 #
 # This script is normally invoked from regen.pl.
 
-$VERSION = '1.02_03';
+$VERSION = '1.02_05';
 
 BEGIN {
     require 'regen/regen_lib.pl';
@@ -40,6 +40,7 @@ my $tree = {
                                        'newline'       => [ 5.008, DEFAULT_OFF],
                                        'exec'          => [ 5.008, DEFAULT_OFF],
                                        'layer'         => [ 5.008, DEFAULT_OFF],
+                               'syscalls'      => [ 5.019, DEFAULT_OFF],
                           }],
        'syntax'        => [ 5.008, {   
                                'ambiguous'     => [ 5.008, DEFAULT_OFF],
@@ -59,7 +60,7 @@ my $tree = {
                                'internal'      => [ 5.008, DEFAULT_OFF],
                                'debugging'     => [ 5.008, DEFAULT_ON],
                                'malloc'        => [ 5.008, DEFAULT_ON],
-                          }],
+                          }],
         'deprecated'   => [ 5.008, DEFAULT_ON],
                'void'          => [ 5.008, DEFAULT_OFF],
                'recursion'     => [ 5.008, DEFAULT_OFF],
@@ -465,7 +466,7 @@ close_and_rename($lexwarn);
 __END__
 package warnings;
 
-our $VERSION = '1.18';
+our $VERSION = '1.19';
 
 # Verify that we're called correctly so that warnings will work.
 # see also strict.pm.
index ef56dda..e170ab6 100644 (file)
@@ -10,7 +10,7 @@ $|  = 1;
 use warnings;
 use Config;
 
-plan tests => 122;
+plan tests => 145;
 
 my $Perl = which_perl();
 
@@ -391,3 +391,62 @@ sub _117941 { package _117941; open my $a, "TEST" }
 delete $::{"_117941::"};
 _117941();
 pass("no crash when open autovivifies glob in freed package");
+
+# [perl #117265] check for embedded nul in pathnames, allow ending \0 though
+{
+    my $WARN;
+    local $SIG{__WARN__} = sub { $WARN = shift };
+    my $temp = tempfile();
+    my $temp_match = quotemeta $temp;
+
+    # create the file, so we can check nothing actually touched it
+    open my $temp_fh, ">", $temp;
+    close $temp_fh;
+    ok(utime(time()-10, time(), $temp), "set mtime to a known value");
+    ok(chmod(0666, $temp), "set mode to a known value");
+    my ($final_mode, $final_mtime) = (stat $temp)[2, 9];
+
+    my $fn = "$temp\0.invalid";
+    is(open(I, $fn), undef, "open with nul in pathnames since 5.18 [perl #117265]");
+    like($WARN, qr/^Invalid \\0 character in pathname for open: $temp_match\\0\.invalid/,
+         "warn on embedded nul"); $WARN = '';
+    is (unlink($fn), 0);
+    like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.invalid/,
+         "also on unlink"); $WARN = '';
+    is(chmod(0444, $fn), 0);
+    like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.invalid/,
+         "also on chmod"); $WARN = '';
+    is (glob($fn), ());
+    like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.invalid/,
+         "also on glob"); $WARN = '';
+
+    {
+        no warnings 'syscalls';
+        $WARN = '';
+        is(open(I, $fn), undef, "open with nul with no warnings syscalls");
+        is($WARN, '', "ignore warning on embedded nul with no warnings syscalls");
+    }
+
+    use Errno 'ENOENT';
+    # check handling of multiple arguments, which the original patch
+    # mis-handled
+    $! = 0;
+    is (unlink($fn, $fn), 0, "check multiple arguments to unlink");
+    is($!+0, ENOENT, "check errno");
+    $! = 0;
+    is (chmod(0644, $fn, $fn), 0, "check multiple arguments to chmod");
+    is($!+0, ENOENT, "check errno");
+    $! = 0;
+    is (utime(time, time, $fn, $fn), 0, "check multiple arguments to utime");
+    is($!+0, ENOENT, "check errno");
+    SKIP: {
+        skip "no chown", 2 unless $Config{d_chown};
+        $! = 0;
+        is(chown(-1, -1, $fn, $fn), 0, "check multiple arguments to chown");
+        is($!+0, ENOENT, "check errno");
+    }
+
+    ok(-f $temp, "nothing removed the temp file");
+    is((stat $temp)[2], $final_mode, "nothing changed its mode");
+    is((stat $temp)[9], $final_mtime, "nothing changes its mtime");
+}
index 804161e..bf0cd78 100644 (file)
@@ -366,3 +366,35 @@ open ᶠᚻ2, ">doiowarn.tmp"; close ᶠᚻ2;
 unlink "doiowarn.tmp";
 EXPECT
 Filehandle STDIN reopened as ᶠᚻ1 only for output at - line 16.
+########
+open(my $i, "foo\0bar");
+use warnings 'io';
+open(my $i, "foo\0bar");
+EXPECT
+Invalid \0 character in pathname for open: foo\0bar at - line 3.
+########
+chmod(0, "foo\0bar");
+use warnings 'io';
+chmod(0, "foo\0bar");
+EXPECT
+Invalid \0 character in pathname for chmod: foo\0bar at - line 3.
+########
+unlink("foo\0bar", "foo\0bar2");
+use warnings 'io';
+unlink("foo\0bar", "foo\0bar2");
+EXPECT
+Invalid \0 character in pathname for unlink: foo\0bar at - line 3.
+Invalid \0 character in pathname for unlink: foo\0bar2 at - line 3.
+########
+utime(-1, -1, "foo\0bar", "foo\0bar2");
+use warnings 'io';
+utime(-1, -1, "foo\0bar", "foo\0bar2");
+EXPECT
+Invalid \0 character in pathname for utime: foo\0bar at - line 3.
+Invalid \0 character in pathname for utime: foo\0bar2 at - line 3.
+########
+my @foo = glob "foo\0bar";
+use warnings 'io';
+my @bar = glob "foo\0bar";
+EXPECT
+Invalid \0 character in pattern for glob: foo\0bar at - line 3.
index c37a6ed..09728d3 100644 (file)
@@ -111,8 +111,8 @@ sub testwarn {
 
     # The repetition number must be set to the value of $BYTES in
     # lib/warnings.pm
-    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 14, 'all bits off via "no warnings"' ) }
-    testwarn("\0" x 14, 'no bits');
+    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 15, 'all bits off via "no warnings"' ) }
+    testwarn("\0" x 15, 'no bits');
 
     use warnings;
     BEGIN { check_bits( ${^WARNING_BITS}, $default,
index e323948..28a52e3 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan(tests => 11);
+plan(tests => 17);
 
 my $nonfile = tempfile();
 
@@ -111,3 +111,25 @@ SKIP: {
 # I can't see how to test the EMFILE case
 # I can't see how to test the case of not displaying @INC in the message.
 # (and does that only happen on VMS?)
+
+# fail and print the full filename
+eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
+like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]';
+eval { no warnings 'syscalls'; do "strict.pm\0invalid"; };
+like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'do nul check';
+{
+  my $WARN;
+  local $SIG{__WARN__} = sub { $WARN = shift };
+  eval { require "strict.pm\0invalid"; };
+  like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning';
+  like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error';
+
+  $WARN = '';
+  local @INC = @INC;
+  unshift @INC, "lib\0invalid";
+  eval { require "unknown.pm" };
+  like $WARN, qr{^Invalid \\0 character in pathname for require: lib\\0invalid/unknown\.pm at }, 'nul warning';
+}
+eval "require strict\0::invalid;";
+like $@, qr/^syntax error at \(eval \d+\) line 1/, 'parse error with \0 in barewords module names';
+
index abe6b08..6b6081e 100644 (file)
@@ -463,6 +463,7 @@ Cannot apply "%s" in non-PerlIO perl
 Can't find string terminator %c%s%c anywhere before EOF
 Can't fix broken locale name "%s"
 Can't get short module name from a handle
+Can't locate %s:   %s
 Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)
 Can't pipe "%s": %s
 Can't spawn: %s
index 5c40d5c..f5ff791 100644 (file)
 #define WARN_EXPERIMENTAL__REGEX_SETS 54
 #define WARN_EXPERIMENTAL__SMARTMATCH 55
 
-#define WARNsize               14
-#define WARN_ALLstring         "\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
-#define WARN_NONEstring                "\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
+/* Warnings Categories added in Perl 5.019 */
+
+#define WARN_SYSCALLS           56
+
+#define WARNsize               15
+#define WARN_ALLstring         "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
+#define WARN_NONEstring                "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
 
 #define isLEXWARN_on   (PL_curcop->cop_warnings != pWARN_STD)
 #define isLEXWARN_off  (PL_curcop->cop_warnings == pWARN_STD)