This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Handle tainted values in lists returned from subs, evals
authorChip Salzenberg <chip@perl.com>
Fri, 25 Apr 1997 01:55:09 +0000 (13:55 +1200)
committerChip Salzenberg <chip@atlantic.net>
Wed, 30 Apr 1997 12:00:00 +0000 (00:00 +1200)
pp_ctl.c
pp_hot.c
t/op/taint.t

index b05e13f..009d636 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1316,6 +1316,7 @@ PP(pp_leaveloop)
     mark = newsp;
     POPLOOP1(cx);      /* Delay POPLOOP2 until stack values are safe */
 
+    TAINT_NOT;
     if (gimme == G_VOID)
        ; /* do nothing */
     else if (gimme == G_SCALAR) {
@@ -1325,8 +1326,10 @@ PP(pp_leaveloop)
            *++newsp = &sv_undef;
     }
     else {
-       while (mark < SP)
+       while (mark < SP) {
            *++newsp = sv_mortalcopy(*++mark);
+           TAINT_NOT;          /* Each item is independent */
+       }
     }
     SP = newsp;
     PUTBACK;
@@ -1389,6 +1392,7 @@ PP(pp_return)
        DIE("panic: return");
     }
 
+    TAINT_NOT;
     if (gimme == G_SCALAR) {
        if (MARK < SP)
            *++newsp = (popsub2 && SvTEMP(*SP))
@@ -1397,9 +1401,11 @@ PP(pp_return)
            *++newsp = &sv_undef;
     }
     else if (gimme == G_ARRAY) {
-       while (++MARK <= SP)
+       while (++MARK <= SP) {
            *++newsp = (popsub2 && SvTEMP(*MARK))
                        ? *MARK : sv_mortalcopy(*MARK);
+           TAINT_NOT;          /* Each item is independent */
+       }
     }
     stack_sp = newsp;
 
@@ -1461,6 +1467,7 @@ PP(pp_last)
        DIE("panic: last");
     }
 
+    TAINT_NOT;
     if (gimme == G_SCALAR) {
        if (MARK < SP)
            *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP))
@@ -1469,9 +1476,11 @@ PP(pp_last)
            *++newsp = &sv_undef;
     }
     else if (gimme == G_ARRAY) {
-       while (++MARK <= SP)
+       while (++MARK <= SP) {
            *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK))
                        ? *MARK : sv_mortalcopy(*MARK);
+           TAINT_NOT;          /* Each item is independent */
+       }
     }
     SP = newsp;
     PUTBACK;
@@ -2326,6 +2335,7 @@ PP(pp_leaveeval)
     POPEVAL(cx);
     retop = pop_return();
 
+    TAINT_NOT;
     if (gimme == G_VOID)
        MARK = newsp;
     else if (gimme == G_SCALAR) {
@@ -2342,10 +2352,13 @@ PP(pp_leaveeval)
        }
     }
     else {
-       for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(*mark) & SVs_TEMP))
+       /* in case LEAVE wipes old return values */
+       for (mark = newsp + 1; mark <= SP; mark++) {
+           if (!(SvFLAGS(*mark) & SVs_TEMP)) {
                *mark = sv_mortalcopy(*mark);
-               /* in case LEAVE wipes old return values */
+               TAINT_NOT;      /* Each item is independent */
+           }
+       }
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
@@ -2406,6 +2419,7 @@ PP(pp_leavetry)
     POPEVAL(cx);
     pop_return();
 
+    TAINT_NOT;
     if (gimme == G_VOID)
        SP = newsp;
     else if (gimme == G_SCALAR) {
@@ -2423,10 +2437,13 @@ PP(pp_leavetry)
        SP = MARK;
     }
     else {
-       for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+       /* in case LEAVE wipes old return values */
+       for (mark = newsp + 1; mark <= SP; mark++) {
+           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
                *mark = sv_mortalcopy(*mark);
-               /* in case LEAVE wipes old return values */
+               TAINT_NOT;      /* Each item is independent */
+           }
+       }
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
index 8a301e5..d8b1976 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -602,8 +602,10 @@ PP(pp_aassign)
     if (op->op_private & OPpASSIGN_COMMON) {
         for (relem = firstrelem; relem <= lastrelem; relem++) {
             /*SUPPRESS 560*/
-            if (sv = *relem)
+            if (sv = *relem) {
+               TAINT_NOT;      /* Each item is independent */
                 *relem = sv_mortalcopy(sv);
+           }
         }
     }
 
@@ -1313,6 +1315,7 @@ PP(pp_leave)
            gimme = G_SCALAR;
     }
 
+    TAINT_NOT;
     if (gimme == G_VOID)
        SP = newsp;
     else if (gimme == G_SCALAR) {
@@ -1329,10 +1332,13 @@ PP(pp_leave)
        SP = MARK;
     }
     else if (gimme == G_ARRAY) {
-       for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+       /* in case LEAVE wipes old return values */
+       for (mark = newsp + 1; mark <= SP; mark++) {
+           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
                *mark = sv_mortalcopy(*mark);
-               /* in case LEAVE wipes old return values */
+               TAINT_NOT;      /* Each item is independent */
+           }
+       }
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
@@ -1693,6 +1699,7 @@ PP(pp_leavesub)
     POPBLOCK(cx,newpm);
     POPSUB1(cx);       /* Delay POPSUB2 until stack values are safe */
  
+    TAINT_NOT;
     if (gimme == G_SCALAR) {
        MARK = newsp + 1;
        if (MARK <= SP)
@@ -1705,8 +1712,10 @@ PP(pp_leavesub)
     }
     else if (gimme == G_ARRAY) {
        for (MARK = newsp + 1; MARK <= SP; MARK++) {
-           if (!SvTEMP(*MARK))
+           if (!SvTEMP(*MARK)) {
                *MARK = sv_mortalcopy(*MARK);
+               TAINT_NOT;      /* Each item is independent */
+           }
        }
     }
     PUTBACK;
index 81d698a..8639fd6 100755 (executable)
@@ -79,7 +79,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..112\n";
+print "1..136\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -469,3 +469,39 @@ print "1..112\n";
     test 111, tainted($bar--);
     test 112, $bar == 0;
 }
+
+# Test assignment and return of lists
+{
+    my @foo = ("A", "tainted" . $TAINT, "B");
+    test 113, not tainted $foo[0];
+    test 114,     tainted $foo[1];
+    test 115, not tainted $foo[2];
+    my @bar = @foo;
+    test 116, not tainted $bar[0];
+    test 117,     tainted $bar[1];
+    test 118, not tainted $bar[2];
+    my @baz = eval { "A", "tainted" . $TAINT, "B" };
+    test 119, not tainted $baz[0];
+    test 120,     tainted $baz[1];
+    test 121, not tainted $baz[2];
+    my @plugh = eval q[ "A", "tainted" . $TAINT, "B" ];
+    test 122, not tainted $plugh[0];
+    test 123,     tainted $plugh[1];
+    test 124, not tainted $plugh[2];
+    my $nautilus = sub { "A", "tainted" . $TAINT, "B" };
+    test 125, not tainted ((&$nautilus)[0]);
+    test 126,     tainted ((&$nautilus)[1]);
+    test 127, not tainted ((&$nautilus)[2]);
+    my @xyzzy = &$nautilus;
+    test 128, not tainted $xyzzy[0];
+    test 129,     tainted $xyzzy[1];
+    test 130, not tainted $xyzzy[2];
+    my $red_october = sub { return "A", "tainted" . $TAINT, "B" };
+    test 131, not tainted ((&$red_october)[0]);
+    test 132,     tainted ((&$red_october)[1]);
+    test 133, not tainted ((&$red_october)[2]);
+    my @corge = &$red_october;
+    test 134, not tainted $corge[0];
+    test 135,     tainted $corge[1];
+    test 136, not tainted $corge[2];
+}