[perl #82250] fix tainted (s)print format

commit 20ee07fbbcfa6be9f90bb8e5474a4d69d7396617
introduced dieing in (s)printf when the format is tainted;
however it only worked when the format is part of an expression
(because TAINT_PROPER checks for PL_tainted being set).

Fix by doing TAINT_PROPER only after get magic has been done on the format
SV (which will set PL_tainted). This is done by moving the checks in
pp_sprintf and pp_prtf into do_sprintf() (which is called by the two pp
functions).

diff --git a/doop.c b/doop.c
index 717ee66..4e0d9e3 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -741,6 +741,14 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
 
     PERL_ARGS_ASSERT_DO_SPRINTF;
 
+    if (SvTAINTED(*sarg))
+       TAINT_PROPER(
+               (PL_op && PL_op->op_type < OP_max)
+                   ? (PL_op->op_type == OP_PRTF)
+                       ? "printf"
+                       : PL_op_name[PL_op->op_type]
+                   : "(unknown)"
+       );
     SvUTF8_off(sv);
     if (DO_UTF8(*sarg))
         SvUTF8_on(sv);

diff --git a/pp.c b/pp.c
index 4bf4b18..751a0bf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3708,8 +3708,6 @@ PP(pp_index)
 PP(pp_sprintf)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    if (SvTAINTED(MARK[1]))
-       TAINT_PROPER("sprintf");
     SvTAINTED_off(TARG);
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));

diff --git a/pp_sys.c b/pp_sys.c
index 30a2645..3c42133 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1531,8 +1531,6 @@ PP(pp_prtf)
        goto just_say_no;
     }
     else {
-       if (SvTAINTED(MARK[1]))
-           TAINT_PROPER("printf");
        do_sprintf(sv, SP - MARK, MARK + 1);
        if (!do_print(sv, fp))
            goto just_say_no;

diff --git a/t/op/taint.t b/t/op/taint.t
index ae031cf..c695570 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 766;
+plan tests => 770;
 
 $| = 1;
 
@@ -1829,12 +1829,17 @@ SKIP:
 
 {
     # tests for tainted format in s?printf
-    violates_taint(sub { printf($TAINT . "# %s\n", "foo") }, 'printf',
+    my $fmt = $TAINT . "# %s\n";
+    violates_taint(sub { printf($fmt, "foo") }, 'printf',
                   q/printf doesn't like tainted formats/);
+    violates_taint(sub { printf($TAINT . "# %s\n", "foo") }, 'printf',
+                  q/printf doesn't like tainted format expressions/);
     eval { printf("# %s\n", $TAINT . "foo") };
     is($@, '', q/printf accepts other tainted args/);
-    violates_taint(sub { sprintf($TAINT . "# %s\n", "foo") }, 'sprintf',
+    violates_taint(sub { sprintf($fmt, "foo") }, 'sprintf',
                   q/sprintf doesn't like tainted formats/);
+    violates_taint(sub { sprintf($TAINT . "# %s\n", "foo") }, 'sprintf',
+                  q/sprintf doesn't like tainted format expressions/);
     eval { sprintf("# %s\n", $TAINT . "foo") };
     is($@, '', q/sprintf accepts other tainted args/);
 }