summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorAlexey Tourbin <at@altlinux.ru>2004-12-29 01:29:37 +0300
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-01-20 18:21:36 +0000
commit6a724e38d06830f8a81d04a01e9feb8da8e1bfc9 (patch)
tree639706002f6b6343f3d1f337610de78efe74c428 /lib
parentdf344c0f087fe584f089183b340ab3608c6859f9 (diff)
downloadperl-6a724e38d06830f8a81d04a01e9feb8da8e1bfc9.tar.gz
Re: [perl #33173] shellwords.pl and tainting
Message-ID: <20041228192937.GB7824@solemn.turbinal.org> p4raw-id: //depot/perl@23838
Diffstat (limited to 'lib')
-rw-r--r--lib/Text/ParseWords.pm47
-rw-r--r--lib/Text/ParseWords/taint.t23
-rw-r--r--lib/shellwords.pl37
3 files changed, 51 insertions, 56 deletions
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;