In perl.git, the branch maint-5.22 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1407ca1882f2dda6b7a38969cdf605658ba8e78f?hp=905191b82c0a0cfd09d089733df39fcdbf715fde>
- Log ----------------------------------------------------------------- commit 1407ca1882f2dda6b7a38969cdf605658ba8e78f Author: Steve Hay <[email protected]> Date: Thu Feb 23 09:06:13 2017 +0000 Run regen/embed.pl following previous cherry-pick M proto.h commit ffce894221517d6a4f3af69afd7e9c10b5ed6ce3 Author: Father Chrysostomos <[email protected]> Date: Thu Feb 23 08:30:58 2017 +0000 Fix checks for tainted dir in $ENV{PATH} $ cat > foo print "What?!\n" ^D $ chmod +x foo $ ./perl -Ilib -Te '$ENV{PATH}="."; exec "foo"' Insecure directory in $ENV{PATH} while running with -T switch at -e line 1. That is what I expect to see. But: $ ./perl -Ilib -Te '$ENV{PATH}="/\\:."; exec "foo"' What?! Perl is allowing the \ to escape the :, but the \ is not treated as an escape by the system, allowing a relative path in PATH to be consid- ered safe. (cherry picked from commit ba0a4150f6f1604df236035adf6df18bd43de88e) M embed.fnc M embed.h M mg.c M proto.h M t/op/taint.t M util.c commit 647faecbfb5146126cf26e82d201154eb23ed6ac Author: Karl Williamson <[email protected]> Date: Sat Aug 27 19:16:17 2016 -0600 PATCH: [perl #129038] Crash with s///l The cause of this was bad logic. It thought it was dealing with UTF-8 when it wasn't. (cherry picked from commit 109ac342a6bc5a3a67c3b52341607100cedafdf7) (cherry picked from commit 5747c35638c5183ddf9e4b7f3949aa0f7414661c) M regexec.c M t/re/subst.t ----------------------------------------------------------------------- Summary of changes: embed.fnc | 4 ++++ embed.h | 1 + mg.c | 2 +- proto.h | 9 +++++++++ regexec.c | 27 +++++++++++++++------------ t/op/taint.t | 18 +++++++++++++++++- t/re/subst.t | 20 +++++++++++++++++++- util.c | 25 ++++++++++++++++++++++--- 8 files changed, 88 insertions(+), 18 deletions(-) diff --git a/embed.fnc b/embed.fnc index b26ba18b1d..3e1ff72e11 100644 --- a/embed.fnc +++ b/embed.fnc @@ -343,6 +343,10 @@ Ap |I32 |debstackptrs pR |SV * |defelem_target |NN SV *sv|NULLOK MAGIC *mg Anp |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ |NN const char* fromend|int delim|NN I32* retlen +np |char* |delimcpy_no_escape|NN char* to|NN const char* toend \ + |NN const char* from \ + |NN const char* fromend|int delim \ + |NN I32* retlen : Used in op.c, perl.c pM |void |delete_eval_scope Aprd |OP* |die_sv |NN SV *baseex diff --git a/embed.h b/embed.h index e09ffee89c..fe310b6990 100644 --- a/embed.h +++ b/embed.h @@ -1161,6 +1161,7 @@ #define deb_stack_all() Perl_deb_stack_all(aTHX) #define defelem_target(a,b) Perl_defelem_target(aTHX_ a,b) #define delete_eval_scope() Perl_delete_eval_scope(aTHX) +#define delimcpy_no_escape Perl_delimcpy_no_escape #define die_unwind(a) Perl_die_unwind(aTHX_ a) #define do_aexec5(a,b,c,d,e) Perl_do_aexec5(aTHX_ a,b,c,d,e) #define do_dump_pad(a,b,c,d) Perl_do_dump_pad(aTHX_ a,b,c,d) diff --git a/mg.c b/mg.c index 064a1ae134..b67f8e25e0 100644 --- a/mg.c +++ b/mg.c @@ -1254,7 +1254,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) #else const char path_sep = ':'; #endif - s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, + s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, s, strend, path_sep, &i); s++; if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */ diff --git a/proto.h b/proto.h index ab782025c5..0a4f9f6ce4 100644 --- a/proto.h +++ b/proto.h @@ -891,6 +891,15 @@ PERL_CALLCONV char* Perl_delimcpy(char* to, const char* toend, const char* from, #define PERL_ARGS_ASSERT_DELIMCPY \ assert(to); assert(toend); assert(from); assert(fromend); assert(retlen) +PERL_CALLCONV char* Perl_delimcpy_no_escape(char* to, const char* toend, const char* from, const char* fromend, int delim, I32* retlen) + __attribute__nonnull__(1) + __attribute__nonnull__(2) + __attribute__nonnull__(3) + __attribute__nonnull__(4) + __attribute__nonnull__(6); +#define PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE \ + assert(to); assert(toend); assert(from); assert(fromend); assert(retlen) + PERL_CALLCONV void Perl_despatch_signals(pTHX); PERL_CALLCONV_NO_RET OP* Perl_die(pTHX_ const char* pat, ...) __attribute__noreturn__ diff --git a/regexec.c b/regexec.c index e38c6ca6f1..b7335aec69 100644 --- a/regexec.c +++ b/regexec.c @@ -5797,23 +5797,26 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), (U8) nextchr)))) { sayNO; } + + locinput++; + break; } - else if (UTF8_IS_DOWNGRADEABLE_START(nextchr)) { - if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), - (U8) TWO_BYTE_UTF8_TO_NATIVE(nextchr, - *(locinput + 1)))))) - { - sayNO; - } - } - else { /* Here, must be an above Latin-1 code point */ + + if (! UTF8_IS_DOWNGRADEABLE_START(nextchr)) { /* An above Latin-1 code point */ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend); goto utf8_posix_above_latin1; } - /* Here, must be utf8 */ - locinput += UTF8SKIP(locinput); - break; + /* Here is a UTF-8 variant code point below 256 and the target is + * UTF-8 */ + if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), + TWO_BYTE_UTF8_TO_NATIVE(nextchr, + *(locinput + 1)))))) + { + sayNO; + } + + goto increment_locinput; case NPOSIXD: /* \W or [:^punct:] etc. under /d */ to_complement = 1; diff --git a/t/op/taint.t b/t/op/taint.t index 08afc7858e..5437dbd445 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -17,7 +17,7 @@ BEGIN { use strict; use Config; -plan tests => 801; +plan tests => 805; $| = 1; @@ -187,6 +187,22 @@ my $TEST = 'TEST'; like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); } + # Relative paths in $ENV{PATH} are always implicitly tainted. + SKIP: { + skip "Do these work on VMS?", 4 if $Is_VMS; + skip "Not applicable to DOSish systems", 4 if! $tmp; + + local $ENV{PATH} = '.'; + is(eval { `$echo 1` }, undef); + like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); + + # Backslash should not fool perl into thinking that this is one + # path. + local $ENV{PATH} = '/\:.'; + is(eval { `$echo 1` }, undef); + like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); + } + SKIP: { skip "This is not VMS", 4 unless $Is_VMS; diff --git a/t/re/subst.t b/t/re/subst.t index 4c661a957c..0d173f178c 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -6,9 +6,10 @@ BEGIN { set_up_inc('../lib'); require Config; import Config; require './charset_tools.pl'; + require './loc_tools.pl'; } -plan( tests => 268 ); +plan( tests => 269 ); $_ = 'david'; $a = s/david/rules/r; @@ -1085,3 +1086,20 @@ SKIP: { fresh_perl_is('s//*_=0;s|0||;00.y0/e; print qq(ok\n)', "ok\n", { stderr => 1 }, "[perl #126602] s//*_=0;s|0||/e crashes"); } + +SKIP: { + if (! locales_enabled('LC_CTYPE')) { + skip "Can't test locale", 1; + } + + # To cause breakeage, we need a locale in which \xff matches whatever + # POSIX class is used in the pattern. Easiest is C, with \W. + fresh_perl_is(' use POSIX qw(locale_h); + setlocale(&POSIX::LC_CTYPE, "C"); + my $s = "\xff"; + $s =~ s/\W//l; + print qq(ok$s\n)', + "ok\n", + {stderr => 1 }, + '[perl #129038 ] s/\xff//l no longer crashes'); +} diff --git a/util.c b/util.c index 457b013df3..b3235e6203 100644 --- a/util.c +++ b/util.c @@ -520,15 +520,17 @@ Free_t Perl_mfree (Malloc_t where) /* copy a string up to some (non-backslashed) delimiter, if any */ -char * -Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend, int delim, I32 *retlen) +static char * +S_delimcpy(char *to, const char *toend, const char *from, + const char *fromend, int delim, I32 *retlen, + const bool allow_escape) { I32 tolen; PERL_ARGS_ASSERT_DELIMCPY; for (tolen = 0; from < fromend; from++, tolen++) { - if (*from == '\\') { + if (allow_escape && *from == '\\') { if (from[1] != delim) { if (to < toend) *to++ = *from; @@ -547,6 +549,23 @@ Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend return (char *)from; } +char * +Perl_delimcpy(char *to, const char *toend, const char *from, const char *fromend, int delim, I32 *retlen) +{ + PERL_ARGS_ASSERT_DELIMCPY; + + return S_delimcpy(to, toend, from, fromend, delim, retlen, 1); +} + +char * +Perl_delimcpy_no_escape(char *to, const char *toend, const char *from, + const char *fromend, int delim, I32 *retlen) +{ + PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE; + + return S_delimcpy(to, toend, from, fromend, delim, retlen, 0); +} + /* return ptr to little string in big string, NULL if not found */ /* This routine was donated by Corey Satten. */ -- Perl5 Master Repository
