This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement $^A tainting
authorNiko Tyni <ntyni@debian.org>
Fri, 12 Nov 2010 22:02:07 +0000 (00:02 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 15 Nov 2010 00:52:23 +0000 (16:52 -0800)
The format accumulator $^A now becomes tainted when formline() is
called with tainted data.

There is still one failing test from the TODO set; it seems
that the $^A get magic is handled too late for the taintedness
to show up.

mg.c
pp_ctl.c
t/op/taint.t

diff --git a/mg.c b/mg.c
index 4a342d4..e734d80 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -809,6 +809,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     switch (*mg->mg_ptr) {
     case '\001':               /* ^A */
        sv_setsv(sv, PL_bodytarget);
+       if (SvTAINTED(PL_bodytarget))
+           SvTAINTED_on(sv);
        break;
     case '\003':               /* ^C, ^CHILD_ERROR_NATIVE */
        if (nextchar == '\0') {
@@ -2395,6 +2397,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     const char * const remaining = mg->mg_ptr + 1;
     I32 i;
     STRLEN len;
+    MAGIC *tmg;
 
     PERL_ARGS_ASSERT_MAGIC_SET;
 
@@ -2431,6 +2434,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         break;
     case '\001':       /* ^A */
        sv_setsv(PL_bodytarget, sv);
+       /* mg_set() has temporarily made sv non-magical */
+       if (PL_tainting) {
+           if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
+               SvTAINTED_on(PL_bodytarget);
+           else
+               SvTAINTED_off(PL_bodytarget);
+       }
        break;
     case '\003':       /* ^C */
        PL_minus_c = cBOOL(SvIV(sv));
index 4c3ffaf..3e6e46c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -524,6 +524,8 @@ PP(pp_formline)
            return parseres;
     }
     SvPV_force(PL_formtarget, len);
+    if (SvTAINTED(tmpForm))
+       SvTAINTED_on(PL_formtarget);
     if (DO_UTF8(PL_formtarget))
        targ_is_utf8 = TRUE;
     t = SvGROW(PL_formtarget, len + fudge + 1);  /* XXX SvCUR bad */
@@ -605,6 +607,8 @@ PP(pp_formline)
                sv = &PL_sv_no;
                Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
            }
+           if (SvTAINTED(sv))
+               SvTAINTED_on(PL_formtarget);
            break;
 
        case FF_CHECKNL:
index 76e312f..86372bd 100644 (file)
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 335;
+plan tests => 336;
 
 $| = 1;
 
@@ -1405,8 +1405,7 @@ end
     "formline survives a tainted dynamic picture");
 }
 
-TODO: {
-    local $::TODO = '$^A tainting unimplemented';
+{
     ok(!tainted($^A), "format accumulator not tainted yet");
     formline('@ | @*', 'hallo' . $TAINT, 'welt');
     ok(tainted($^A), "tainted formline argument makes a tainted accumulator");
@@ -1423,6 +1422,10 @@ TODO: {
     formline('@' .('<'*5) . ' | @*', 'hallo', 'welt');
     ok(!tainted($^A), "accumulator still untainted");
     formline('@' .('<'*(5+$TAINT0)) . ' | @*', 'hallo', 'welt');
+    TODO: {
+        local $::TODO = "get magic handled too late?";
+        ok(tainted($^A), "the accumulator should be tainted already");
+    }
     ok(tainted($^A), "tainted formline picture makes a tainted accumulator");
 }