From 41188aa0f6683329a6ebb1811827fce0a096df6e Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 3 Sep 2013 10:17:35 +1000 Subject: [PATCH] [perl #117265] correctly handle overloaded strings --- doio.c | 30 ++++++++++++++++++------------ embed.fnc | 2 +- embed.h | 2 +- ext/File-Glob/Glob.xs | 11 ++++++----- inline.h | 11 +++++------ perl.h | 4 ++-- perlio.c | 20 ++++++++++++-------- pp_ctl.c | 9 +++++---- proto.h | 6 +++--- t/io/open.t | 6 ------ 10 files changed, 53 insertions(+), 48 deletions(-) diff --git a/doio.c b/doio.c index d79bf44..3988c78 100644 --- a/doio.c +++ b/doio.c @@ -206,6 +206,8 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, *--tend = '\0'; if (num_svs) { + const char *p; + STRLEN nlen = 0; /* New style explicit name, type is just mode and layer info */ #ifdef USE_STDIO if (SvROK(*svp) && !strchr(oname,'&')) { @@ -216,11 +218,13 @@ 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")) + p = (SvOK(*svp) || SvGMAGICAL(*svp)) ? SvPV(*svp, nlen) : NULL; + + if (p && !IS_SAFE_PATHNAME(p, nlen, "open")) goto say_false; - name = (SvOK(*svp) || SvGMAGICAL(*svp)) ? - savesvpv (*svp) : savepvs (""); + name = p ? savepvn(p, nlen) : savepvs(""); + SAVEFREEPV(name); } else { @@ -1661,9 +1665,9 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) } } else { - const char *name = SvPV_nomg_const_nolen(*mark); + const char *name = SvPV_nomg_const(*mark, len); APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(*mark, "chmod") || + if (!IS_SAFE_PATHNAME(name, len, "chmod") || PerlLIO_chmod(name, val)) { tot--; } @@ -1697,9 +1701,9 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) } } else { - const char *name = SvPV_nomg_const_nolen(*mark); + const char *name = SvPV_nomg_const(*mark, len); APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(*mark, "chown") || + if (!IS_SAFE_PATHNAME(name, len, "chown") || PerlLIO_chown(name, val, val2)) { tot--; } @@ -1800,9 +1804,9 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - s = SvPV_nolen_const(*mark); + s = SvPV_const(*mark, len); APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(*mark, "unlink")) { + if (!IS_SAFE_PATHNAME(s, len, "unlink")) { tot--; } else if (PerlProc_geteuid() || PL_unsafe) { @@ -1881,9 +1885,9 @@ nothing in the core. } } else { - const char * const name = SvPV_nomg_const_nolen(*mark); + const char * const name = SvPV_nomg_const(*mark, len); APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(*mark, "utime")) { + if (!IS_SAFE_PATHNAME(name, len, "utime")) { tot--; } else @@ -2376,10 +2380,12 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) dVAR; SV * const tmpcmd = newSV(0); PerlIO *fp; + STRLEN len; + const char *s = SvPV(tmpglob, len); PERL_ARGS_ASSERT_START_GLOB; - if (!IS_SAFE_SYSCALL(tmpglob, "pattern", "glob")) + if (!IS_SAFE_SYSCALL(s, len, "pattern", "glob")) return NULL; ENTER; diff --git a/embed.fnc b/embed.fnc index 896f709..0f686d4 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1598,7 +1598,7 @@ 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 +AiR |bool |is_safe_syscall|NN const char *pv|STRLEN len|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 diff --git a/embed.h b/embed.h index 3662b97..7e0f83e 100644 --- a/embed.h +++ b/embed.h @@ -231,7 +231,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_safe_syscall(a,b,c,d) S_is_safe_syscall(aTHX_ a,b,c,d) #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) diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs index 43904df..6189b0f 100644 --- a/ext/File-Glob/Glob.xs +++ b/ext/File-Glob/Glob.xs @@ -136,6 +136,12 @@ csh_glob(pTHX_ AV *entries, SV *patsv) else pat = SvPV_nomg(patsv,len), is_utf8 = !!SvUTF8(patsv); patend = pat + len; + assert(SvTYPE(entries) != SVt_PVAV); + sv_upgrade((SV *)entries, SVt_PVAV); + + if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")) + return FALSE; + /* extract patterns */ s = pat-1; while (++s < patend) { @@ -225,11 +231,6 @@ csh_glob(pTHX_ AV *entries, SV *patsv) } end_of_parsing: - 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); diff --git a/inline.h b/inline.h index a5742b8..a2727f4 100644 --- a/inline.h +++ b/inline.h @@ -288,7 +288,7 @@ S_isALNUM_lazy(pTHX_ const char* p) /* ------------------------------- perl.h ----------------------------- */ /* -=for apidoc AiR|bool|is_safe_syscall|SV *pv|const char *what|const char *op_name +=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name Test that the given C doesn't contain any internal NUL characters. If it does, set C to ENOENT, optionally warn, and return FALSE. @@ -301,21 +301,20 @@ Used by the IS_SAFE_SYSCALL() macro. */ PERL_STATIC_INLINE bool -S_is_safe_syscall(pTHX_ SV *pv, const char *what, const char *op_name) { +S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, 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); + if (pv && len > 1) { char *null_at; - if (UNLIKELY((null_at = (char *)memchr(p, 0, SvCUR(pv)-1)) != NULL)) { + if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) { SETERRNO(ENOENT, LIB_INVARG); Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS), "Invalid \\0 character in %s for %s: %s\\0%s", - what, op_name, p, null_at+1); + what, op_name, pv, null_at+1); return FALSE; } } diff --git a/perl.h b/perl.h index e4cee69..5adc8d4 100644 --- a/perl.h +++ b/perl.h @@ -5692,9 +5692,9 @@ extern void moncontrol(int); /* 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_SYSCALL(p, len, what, op_name) (S_is_safe_syscall(aTHX_ (p), (len), (what), (op_name))) -#define IS_SAFE_PATHNAME(pv, op_name) IS_SAFE_SYSCALL((pv), "pathname", (op_name)) +#define IS_SAFE_PATHNAME(p, len, op_name) IS_SAFE_SYSCALL((p), (len), "pathname", (op_name)) #if defined(OEMVS) #define NO_ENV_ARRAY_IN_MAIN diff --git a/perlio.c b/perlio.c index 7de7085..c2cc319 100644 --- a/perlio.c +++ b/perlio.c @@ -312,8 +312,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, if (*args == &PL_sv_undef) return PerlIO_tmpfile(); else { - const char *name = SvPV_nolen_const(*args); - if (!IS_SAFE_PATHNAME(*args, "open")) + STRLEN len; + const char *name = SvPV_nolen_const(*args, len); + if (!IS_SAFE_PATHNAME(name, len, "open")) return NULL; if (*mode == IoTYPE_NUMERIC) { @@ -2725,8 +2726,9 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, #endif } if (imode != -1) { - const char *path = SvPV_nolen_const(*args); - if (!IS_SAFE_PATHNAME(*args, "open")) + STRLEN len; + const char *path = SvPV_const(*args, len); + if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; fd = PerlLIO_open3(path, imode, perm); } @@ -3039,10 +3041,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, { char tmode[8]; if (PerlIOValid(f)) { - const char * const path = SvPV_nolen_const(*args); + STRLEN len; + const char * const path = SvPV_const(*args, len); PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio); FILE *stdio; - if (!IS_SAFE_PATHNAME(*args, "open")) + if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; PerlIOUnix_refcnt_dec(fileno(s->stdio)); stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)), @@ -3055,8 +3058,9 @@ 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")) + STRLEN len; + const char * const path = SvPV_const(*args, len); + if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; if (*mode == IoTYPE_NUMERIC) { mode++; diff --git a/pp_ctl.c b/pp_ctl.c index 7fd27f8..243bcac 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3597,7 +3597,8 @@ STATIC PerlIO * S_check_type_and_open(pTHX_ SV *name) { Stat_t st; - const char *p = SvPV_nolen_const(name); + STRLEN len; + const char *p = SvPV_const(name, len); int st_rc; PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN; @@ -3608,7 +3609,7 @@ S_check_type_and_open(pTHX_ SV *name) * rather than for the .pm file. * This check prevents a \0 in @INC causing problems. */ - if (!IS_SAFE_PATHNAME(name, "require")) + if (!IS_SAFE_PATHNAME(p, len, "require")) return NULL; st_rc = PerlLIO_stat(p, &st); @@ -3637,7 +3638,7 @@ S_doopen_pm(pTHX_ SV *name) * warning referring to the .pmc which the user probably doesn't * know or care about */ - if (!IS_SAFE_PATHNAME(name, "require")) + if (!IS_SAFE_PATHNAME(p, namelen, "require")) return NULL; if (namelen > 3 && memEQs(p + namelen - 3, 3, ".pm")) { @@ -3772,7 +3773,7 @@ PP(pp_require) name = SvPV_const(sv, len); if (!(name && len > 0 && *name)) DIE(aTHX_ "Null filename used"); - if (!IS_SAFE_PATHNAME(sv, "require")) { + if (!IS_SAFE_PATHNAME(name, len, "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), diff --git a/proto.h b/proto.h index 88aaa0a..7281242 100644 --- a/proto.h +++ b/proto.h @@ -1761,11 +1761,11 @@ 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) +PERL_STATIC_INLINE bool S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_3); + __attribute__nonnull__(pTHX_3) + __attribute__nonnull__(pTHX_4); #define PERL_ARGS_ASSERT_IS_SAFE_SYSCALL \ assert(pv); assert(what); assert(op_name) diff --git a/t/io/open.t b/t/io/open.t index 711c27e..3e6efb4 100644 --- a/t/io/open.t +++ b/t/io/open.t @@ -419,21 +419,17 @@ pass("no crash when open autovivifies glob in freed package"); like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.invalid/, "also on chmod"); $WARN = ''; - $TODO = "broken for overloading"; is(chmod(0444, $fno), 0, "chmod fails with \\0 in name (overload)"); like($WARN, qr/^Invalid \\0 character in pathname for chmod: $temp_match\\0\.overload/, "also on chmod"); $WARN = ''; - undef $TODO; is (glob($fn), undef, "glob fails with \\0 in name"); like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.invalid/, "also on glob"); $WARN = ''; - $TODO = "broken for overloading"; is (glob($fno), undef, "glob fails with \\0 in name (overload)"); like($WARN, qr/^Invalid \\0 character in pattern for glob: $temp_match\\0\.overload/, "also on glob"); $WARN = ''; - undef $TODO; { no warnings 'syscalls'; @@ -465,12 +461,10 @@ pass("no crash when open autovivifies glob in freed package"); like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.invalid/, "also on unlink"); $WARN = ''; - $TODO = "broken for overloading"; is (unlink($fno), 0, "unlink fails with \\0 in name (overload)"); like($WARN, qr/^Invalid \\0 character in pathname for unlink: $temp_match\\0\.overload/, "also on unlink"); $WARN = ''; - local $TODO = "this is broken for overloading"; 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"); -- 2.7.4