Re: taint news

Message-ID: <m3d6yuvnwr.fsf@cs839290-a.mtth.phub.net.cable.rogers.com>

p4raw-id: //depot/perl@14853

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6d8e940..acd5fc2 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4029,6 +4029,13 @@ use, or using a different name altogether.  The warning can be
 suppressed for subroutine names by either adding a C<&> prefix, or using
 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 
+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>.
+
 =item Use of uninitialized value%s
 
 (W uninitialized) An undefined value was used as if it were already

diff --git a/pod/perlsec.pod b/pod/perlsec.pod
index e8d44c3..c86ac7c 100644 (file)
--- a/pod/perlsec.pod
+++ b/pod/perlsec.pod
@@ -45,7 +45,10 @@ directories, or processes, B<with the following exceptions>:
 =item *
 
 If you pass more than one argument to either C<system> or C<exec>,
-the arguments are B<not> checked for taintedness.
+the arguments are checked for taintedness B<but> the operation will still
+be attempted, emitting an optional warning.  This will be fatal in a 
+future version of perl so do not rely on it to bypass the tainting 
+mechanism.
 
 =item *
 
@@ -72,7 +75,8 @@ For example:
     $data = 'abc';             # Not tainted
 
     system "echo $arg";                # Insecure
-    system "/bin/echo", $arg;  # Secure (doesn't use sh)
+    system "/bin/echo", $arg;  # Allowed but considered insecure
+                               # (Perl doesn't know about /bin/echo)
     system "echo $hid";                # Insecure
     system "echo $data";       # Insecure until PATH set
 
@@ -87,17 +91,17 @@ For example:
     open(FOO, "< $arg");       # OK - read-only file
     open(FOO, "> $arg");       # Not OK - trying to write
 
-    open(FOO,"echo $arg|");    # Not OK, but...
+    open(FOO,"echo $arg|");    # Not OK
     open(FOO,"-|")
-       or exec 'echo', $arg;   # OK
+       or exec 'echo', $arg;   # Allowed but not really OK
 
     $shout = `echo $arg`;      # Insecure, $shout now tainted
 
     unlink $data, $arg;                # Insecure
     umask $arg;                        # Insecure
 
-    exec "echo $arg";          # Insecure (uses the shell)
-    exec "echo", $arg;         # Secure (doesn't use the shell)
+    exec "echo $arg";          # Insecure
+    exec "echo", $arg;         # Allowed but considered insecure
     exec "sh", '-c', $arg;     # Considered secure, alas!
 
     @files = <*.c>;            # insecure (uses readdir() or similar)
@@ -114,7 +118,8 @@ For example:
 If you try to do something insecure, you will get a fatal error saying
 something like "Insecure dependency" or "Insecure $ENV{PATH}".  Note that you
 can still write an insecure B<system> or B<exec>, but only by explicitly
-doing something like the "considered secure" example above.
+doing something like the "considered secure" example above.  This will not
+be possible in a future version of Perl.
 
 =head2 Laundering and Detecting Tainted Data
 

diff --git a/pp_sys.c b/pp_sys.c
index 7ce9dae..099eab9 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4031,12 +4031,22 @@ PP(pp_system)
     int pp[2];
     I32 did_pipes = 0;
 
-    if (SP - MARK == 1) {
-       if (PL_tainting) {
-           (void)SvPV_nolen(TOPs);      /* stringify for taint check */
-           TAINT_ENV();
+    if (PL_tainting) {
+       TAINT_ENV();
+       while (++MARK <= SP) {
+           (void)SvPV_nolen(*MARK);      /* stringify for taint check */
+           if (PL_tainted) 
+               break;
+       }
+       MARK = ORIGMARK;
+       /* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
+       if (SP - MARK == 1) {
            TAINT_PROPER("system");
        }
+       else if (ckWARN(WARN_TAINT)) {
+           Perl_warner(aTHX_ WARN_TAINT, 
+               "Use of tainted arguments in %s is deprecated", "system");
+       }
     }
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
@@ -4044,16 +4054,6 @@ PP(pp_system)
         Pid_t childpid;
         int status;
         Sigsave_t ihand,qhand;     /* place to save signals during system() */
-       
-        if (PL_tainting) {
-            SV *cmd = NULL;
-            if (PL_op->op_flags & OPf_STACKED)
-               cmd = *(MARK + 1);
-            else if (SP - MARK != 1)
-               cmd = *SP;
-            if (cmd && *(SvPV_nolen(cmd)) != '/')
-               TAINT_ENV();
-        }
 
         if (PerlProc_pipe(pp) >= 0)
              did_pipes = 1;
@@ -4155,6 +4155,23 @@ PP(pp_exec)
     I32 value;
     STRLEN n_a;
 
+    if (PL_tainting) {
+       TAINT_ENV();
+       while (++MARK <= SP) {
+           (void)SvPV_nolen(*MARK);      /* stringify for taint check */
+           if (PL_tainted) 
+               break;
+       }
+       MARK = ORIGMARK;
+       /* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
+       if (SP - MARK == 1) {
+           TAINT_PROPER("exec");
+       }
+       else if (ckWARN(WARN_TAINT)) {
+           Perl_warner(aTHX_ WARN_TAINT, 
+               "Use of tainted arguments in %s is deprecated", "exec");
+       }
+    }
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
@@ -4174,11 +4191,6 @@ PP(pp_exec)
 #  endif
 #endif
     else {
-       if (PL_tainting) {
-           (void)SvPV_nolen(*SP);      /* stringify for taint check */
-           TAINT_ENV();
-           TAINT_PROPER("exec");
-       }
 #ifdef VMS
        value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #else

diff --git a/t/op/taint.t b/t/op/taint.t
index 8591b34..b045c49 100755 (executable)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -119,7 +119,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..183\n";
+print "1..203\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -837,7 +837,7 @@ else {
 
     use warnings;
 
-    $SIG{__WARN__} = sub { print "not " };
+    local $SIG{__WARN__} = sub { print "not " };
 
     sub fmi {
        my $divnum = shift()/1;
@@ -927,3 +927,31 @@ else
     eval { system { "echo" } "/arg0", "arg1" };
     test 183, $@ =~ /^Insecure \$ENV/;
 }
+{
+    # bug 20020208.005 plus some extras
+    # single arg exec/system are tests 80-83
+    use if $] lt '5.009', warnings => FATAL => 'taint';
+    my $err = $] ge '5.009' ? qr/^Insecure dependency/ 
+                            : qr/^Use of tainted arguments/;
+    test 184, eval { exec $TAINT, $TAINT } eq '', 'exec';
+    test 185, $@ =~ $err, $@;
+    test 186, eval { exec $TAINT $TAINT } eq '', 'exec';
+    test 187, $@ =~ $err, $@;
+    test 188, eval { exec $TAINT $TAINT, $TAINT } eq '', 'exec';
+    test 189, $@ =~ $err, $@;
+    test 190, eval { exec $TAINT 'notaint' } eq '', 'exec';
+    test 191, $@ =~ $err, $@;
+    test 192, eval { exec {'notaint'} $TAINT } eq '', 'exec';
+    test 193, $@ =~ $err, $@;
+
+    test 194, eval { system $TAINT, $TAINT } eq '', 'system';
+    test 195, $@ =~ $err, $@;
+    test 196, eval { system $TAINT $TAINT } eq '', 'exec';
+    test 197, $@ =~ $err, $@;
+    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'exec';
+    test 199, $@ =~ $err, $@;
+    test 200, eval { system $TAINT 'notaint' } eq '', 'exec';
+    test 201, $@ =~ $err, $@;
+    test 202, eval { system {'notaint'} $TAINT } eq '', 'exec';
+    test 203, $@ =~ $err, $@;
+}