The warning "Use of tainted arguments in %s is deprecated"

was incorrectly reported whenever system or exec was
invoked with multiple arguments.

p4raw-id: //depot/perl@17516

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 8ff754d..8a2e4a4 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4166,7 +4166,7 @@ a package qualifier, e.g. C<&our()>, or C<Foo::our()>.
 
 =item Use of tainted arguments in %s is deprecated
 
-(W taint) You have supplied C<system()> or C<exec()> with multiple
+(W taint, deprecated) You have supplied C<system()> or C<exec()> with multiple
 arguments and at least one of them is tainted.  This used to be allowed
 but will become a fatal error in a future version of perl.  Untaint your
 arguments.  See L<perlsec>.

diff --git a/pp_sys.c b/pp_sys.c
index 88f45c3..2639fe9 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4049,18 +4049,21 @@ PP(pp_system)
     I32 did_pipes = 0;
 
     if (PL_tainting) {
+       int some_arg_tainted = 0;
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-           if (PL_tainted)
+           if (PL_tainted) {
+               some_arg_tainted = 1;
                break;
+           }
        }
        MARK = ORIGMARK;
        /* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
        if (SP - MARK == 1) {
            TAINT_PROPER("system");
        }
-       else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
+       else if (some_arg_tainted && ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
            Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
                "Use of tainted arguments in %s is deprecated", "system");
        }
@@ -4175,18 +4178,21 @@ PP(pp_exec)
     STRLEN n_a;
 
     if (PL_tainting) {
+       int some_arg_tainted = 0;
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-           if (PL_tainted)
+           if (PL_tainted) {
+               some_arg_tainted = 1;
                break;
+           }
        }
        MARK = ORIGMARK;
        /* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
        if (SP - MARK == 1) {
            TAINT_PROPER("exec");
        }
-       else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
+       else if (some_arg_tainted && ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
            Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
                "Use of tainted arguments in %s is deprecated", "exec");
        }

diff --git a/t/op/taint.t b/t/op/taint.t
index bbe643c..5c58938 100755 (executable)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -124,7 +124,7 @@ my $echo = "$Invoke_Perl $ECHO";
 
 my $TEST = catfile(curdir(), 'TEST');
 
-print "1..203\n";
+print "1..205\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -452,7 +452,7 @@ else {
        test 87, $@ eq '', $@;
     }
     else {
-       for (86..87) { print "ok $_ # Skipped: this is not VMS\n"; }
+       for (86..87) { print "ok $_ # Skipped: This is not VMS\n"; }
     }
 }
 
@@ -957,12 +957,17 @@ else
 
     test 194, eval { system $TAINT, $TAINT } eq '', 'system';
     test 195, $@ =~ $err, $@;
-    test 196, eval { system $TAINT $TAINT } eq '', 'exec';
+    test 196, eval { system $TAINT $TAINT } eq '', 'system';
     test 197, $@ =~ $err, $@;
-    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'exec';
+    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'system';
     test 199, $@ =~ $err, $@;
-    test 200, eval { system $TAINT 'notaint' } eq '', 'exec';
+    test 200, eval { system $TAINT 'notaint' } eq '', 'system';
     test 201, $@ =~ $err, $@;
-    test 202, eval { system {'notaint'} $TAINT } eq '', 'exec';
+    test 202, eval { system {'notaint'} $TAINT } eq '', 'system';
     test 203, $@ =~ $err, $@;
+
+    eval { system("lskdfj does not exist","with","args"); };
+    test 204, $@ eq '';
+    eval { exec("lskdfj does not exist","with","args"); };
+    test 205, $@ eq '';
 }