From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 18 Feb 2006 18:23:43 +0000 (+0000)
Subject: Turn of tainting locally inside swash_init(), as the internal
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d020f5c489f4f9dfad0aa88c9bea73bdb19071d1;p=p5sagit%2Fp5-mst-13.2.git

Turn of tainting locally inside swash_init(), as the internal
implementation of the regexp engine has nothing to do with user data,
so when and where it happens to call require is agnostic of the current
expression's taintedness.

p4raw-id: //depot/perl@27221
---

diff --git a/t/op/utftaint.t b/t/op/utftaint.t
index 59dd96f..1294526 100644
--- a/t/op/utftaint.t
+++ b/t/op/utftaint.t
@@ -18,7 +18,7 @@ sub tainted ($) {
 }
 
 require './test.pl';
-plan(tests => 3*10 + 3*8 + 2*16);
+plan(tests => 3*10 + 3*8 + 2*16 + 2);
 
 my $arg = $ENV{PATH}; # a tainted value
 use constant UTF8 => "\x{1234}";
@@ -143,4 +143,10 @@ for my $ary ([ascii => 'perl'], [latin1 => "\xB6"]) {
     is(tainted($taint), tainted($arg), "tainted: $encode, downgrade down");
 }
 
+fresh_perl_is('$a = substr $^X, 0, 0; /\x{100}/i; /$a\x{100}/i || print q,ok,',
+	      'ok', {switches => ["-T", "-l"]},
+	      "matching a regexp is taint agnostic");
 
+fresh_perl_is('$a = substr $^X, 0, 0; /$a\x{100}/i || print q,ok,',
+	      'ok', {switches => ["-T", "-l"]},
+	      "therefore swash_init should be taint agnostic");
diff --git a/utf8.c b/utf8.c
index 992629d..9dc57a2 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1592,6 +1592,10 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     ENTER;
     SAVEI32(PL_hints);
     PL_hints = 0;
+    /* It is assumed that callers of this routine are not passing in any
+       user derived data.  */
+    SAVEBOOL(PL_tainted);
+    PL_tainted = 0;
     save_re_context();
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {	/* demand load utf8 */
 	ENTER;