From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Sat, 13 Jul 2002 11:28:01 +0000 (+0000)
Subject: The warning "Use of tainted arguments in %s is deprecated"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=159f47d9c50d8b3750644c8f166145335385b847;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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 '';
 }