diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/Text/ParseWords.pm | 47 | ||||
| -rw-r--r-- | lib/Text/ParseWords/taint.t | 23 | ||||
| -rw-r--r-- | lib/shellwords.pl | 37 |
4 files changed, 52 insertions, 56 deletions
@@ -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 94e6db7bcf..c260ad52dc 100644 --- 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 index 0000000000..27f6de50cb --- /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 124c29a497..b3ef33ebd9 100644 --- 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; |