Re: [perl #33173] shellwords.pl and tainting

Message-ID: <20041228192937.GB7824@solemn.turbinal.org>

p4raw-id: //depot/perl@23838

diff --git a/MANIFEST b/MANIFEST
index ba69743..fbed499 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1865,6 +1865,7 @@ lib/Text/Balanced/t/extvar.t      See if Text::Balanced works
 lib/Text/Balanced/t/gentag.t   See if Text::Balanced works
 lib/Text/ParseWords.pm         Perl module to split words on arbitrary delimiter
 lib/Text/ParseWords.t          See if Text::ParseWords works
+lib/Text/ParseWords/taint.t    See if Text::ParseWords works with tainting
 lib/Text/Soundex.pm            Perl module to implement Soundex
 lib/Text/Soundex.t             See if Soundex works
 lib/Text/Tabs.pm               Do expand and unexpand

diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm
index 94e6db7..c260ad5 100644 (file)
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -12,7 +12,7 @@ use Exporter;
 
 
 sub shellwords {
-    local(@lines) = @_;
+    my(@lines) = @_;
     $lines[$#lines] =~ s/\s+$//;
     return(quotewords('\s+', 0, @lines));
 }
@@ -22,7 +22,6 @@ sub shellwords {
 sub quotewords {
     my($delim, $keep, @lines) = @_;
     my($line, @words, @allwords);
-    
 
     foreach $line (@lines) {
        @words = parse_line($delim, $keep, $line);
@@ -37,7 +36,7 @@ sub quotewords {
 sub nested_quotewords {
     my($delim, $keep, @lines) = @_;
     my($i, @allwords);
-    
+
     for ($i = 0; $i < @lines; $i++) {
        @{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
        return() unless (@{$allwords[$i]} || !length($lines[$i]));
@@ -48,13 +47,11 @@ sub nested_quotewords {
 
 
 sub parse_line {
-       # We will be testing undef strings
-       no warnings;
-       use re 'taint'; # if it's tainted, leave it as such
-
     my($delimiter, $keep, $line) = @_;
     my($word, @pieces);
 
+    no warnings 'uninitialized';       # we will be testing undef strings
+
     while (length($line)) {
        $line =~ s/^(["'])                      # a $quote
                    ((?:\\.|(?!\1)[^\\])*)      # and $quoted text
@@ -77,6 +74,7 @@ sub parse_line {
                $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
             }
        }
+        $word .= substr($line, 0, 0);  # leave results tainted
         $word .= defined $quote ? $quoted : $unquoted;
  
         if (length($delim)) {
@@ -100,41 +98,48 @@ sub old_shellwords {
     #  @words = old_shellwords($line);
     #  or
     #  @words = old_shellwords(@lines);
+    #  or
+    #  @words = old_shellwords();      # defaults to $_ (and clobbers it)
 
-    local($_) = join('', @_);
-    my(@words,$snippet,$field);
+    no warnings 'uninitialized';       # we will be testing undef strings
+    local *_ = \join('', @_) if @_;
+    my (@words, $snippet);
 
-    s/^\s+//;
+    s/\A\s+//;
     while ($_ ne '') {
-       $field = '';
+       my $field = substr($_, 0, 0);   # leave results tainted
        for (;;) {
-           if (s/^"(([^"\\]|\\.)*)"//) {
-               ($snippet = $1) =~ s#\\(.)#$1#g;
+           if (s/\A"(([^"\\]|\\.)*)"//s) {
+               ($snippet = $1) =~ s#\\(.)#$1#sg;
            }
-           elsif (/^"/) {
+           elsif (/\A"/) {
+               require Carp;
+               Carp::carp("Unmatched double quote: $_");
                return();
            }
-           elsif (s/^'(([^'\\]|\\.)*)'//) {
-               ($snippet = $1) =~ s#\\(.)#$1#g;
+           elsif (s/\A'(([^'\\]|\\.)*)'//s) {
+               ($snippet = $1) =~ s#\\(.)#$1#sg;
            }
-           elsif (/^'/) {
+           elsif (/\A'/) {
+               require Carp;
+               Carp::carp("Unmatched single quote: $_");
                return();
            }
-           elsif (s/^\\(.)//) {
+           elsif (s/\A\\(.)//s) {
                $snippet = $1;
            }
-           elsif (s/^([^\s\\'"]+)//) {
+           elsif (s/\A([^\s\\'"]+)//) {
                $snippet = $1;
            }
            else {
-               s/^\s+//;
+               s/\A\s+//;
                last;
            }
            $field .= $snippet;
        }
        push(@words, $field);
     }
-    @words;
+    return @words;
 }
 
 1;

diff --git a/lib/Text/ParseWords/taint.t b/lib/Text/ParseWords/taint.t
new file mode 100644 (file)
index 0000000..27f6de5
--- /dev/null
+++ b/lib/Text/ParseWords/taint.t
@@ -0,0 +1,23 @@
+#!./perl -Tw
+# [perl #33173] shellwords.pl and tainting
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config;
+    if ($Config::Config{extensions} !~ /\bList\/Util\b/) {
+       print "1..0 # Skip: Scalar::Util was not built\n";
+       exit 0;
+    }
+}
+
+use Text::ParseWords qw(shellwords old_shellwords);
+use Scalar::Util qw(tainted);
+
+print "1..2\n";
+
+print "not " if grep { not tainted($_) } shellwords("$0$^X");
+print "ok 1\n";
+
+print "not " if grep { not tainted($_) } old_shellwords("$0$^X");
+print "ok 2\n";

diff --git a/lib/shellwords.pl b/lib/shellwords.pl
index 124c29a..b3ef33e 100644 (file)
--- a/lib/shellwords.pl
+++ b/lib/shellwords.pl
@@ -8,40 +8,7 @@
 ;#     or
 ;#     @words = shellwords();          # defaults to $_ (and clobbers it)
 
-sub shellwords {
-    local *_ = \join('', @_) if @_;
-    my (@words, $snippet);
+require Text::ParseWords;
+*shellwords = \&Text::ParseWords::old_shellwords;
 
-    s/\A\s+//;
-    while ($_ ne '') {
-       my $field = substr($_, 0, 0);   # leave results tainted
-       for (;;) {
-           if (s/\A"(([^"\\]|\\.)*)"//s) {
-               ($snippet = $1) =~ s#\\(.)#$1#sg;
-           }
-           elsif (/\A"/) {
-               die "Unmatched double quote: $_\n";
-           }
-           elsif (s/\A'(([^'\\]|\\.)*)'//s) {
-               ($snippet = $1) =~ s#\\(.)#$1#sg;
-           }
-           elsif (/\A'/) {
-               die "Unmatched single quote: $_\n";
-           }
-           elsif (s/\A\\(.)//s) {
-               $snippet = $1;
-           }
-           elsif (s/\A([^\s\\'"]+)//) {
-               $snippet = $1;
-           }
-           else {
-               s/\A\s+//;
-               last;
-           }
-           $field .= $snippet;
-       }
-       push(@words, $field);
-    }
-    return @words;
-}
 1;