develooper Front page | perl.perl5.porters | Postings from December 2004

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

Thread Previous | Thread Next
From:
Alexey Tourbin
Date:
December 28, 2004 11:30
Subject:
Re: [perl #33173] shellwords.pl and tainting
Message ID:
20041228192937.GB7824@solemn.turbinal.org
On Fri, Dec 24, 2004 at 03:19:40PM +0100, Rafael Garcia-Suarez wrote:
> perl-5.8.0@ton.iguana.be (via RT) wrote:
> > Below is an updated version of shellwords.pl with the following 
> > changes:
> 
> Thanks, applied as #23681 to blead.

Hi,
Here is hopefully a better (incrimental) patch.

> > - keep taint
> > - use the local *_ = ref trick to defeat tied $_
> > - use my variables instead of local, and drop the now unneeded internal
> >   package
> > - use \A instead of ^ in the regexes (in case $* still exists and works)
> > - add a s modifier to the regexes using ., so that newlines can be escaped
> > - don't advise &fun style calls in the usage section

- fix also Text::ParseWords which has basically the same code
- replace shellwords() with Text::ParseWords::old_shellwords
- use Carp::carp() to report unmatched quotes
- add tests, place tests into separate file


--- perl-5.9.2.23688/lib/Text/ParseWords.pm-	2004-07-07 02:03:53 +0400
+++ perl-5.9.2.23688/lib/Text/ParseWords.pm	2004-12-28 22:25:07 +0300
@@ -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;
--- perl-5.9.2.23688/lib/Text/ParseWords/taint.t-	2004-12-28 21:21:26 +0300
+++ perl-5.9.2.23688/lib/Text/ParseWords/taint.t	2004-12-28 21:39:56 +0300
@@ -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";
--- perl-5.9.2.23688/lib/shellwords.pl-	2004-12-24 17:21:02 +0300
+++ perl-5.9.2.23688/lib/shellwords.pl	2004-12-28 21:35:07 +0300
@@ -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;

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About