From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

While debugging why commandline input to CGI.pm wasn't tainted, I found
that shellwords() in shellwords.pl loses the taint on the arguments.
The code tries to do a "use re 'taint'", but that only keeps taint on
list context results, $1 and co. are still untainted​:

#!/usr/bin/perl -Tlw
use Scalar​::Util qw(tainted);

require "shellwords.pl";
my @​result = shellwords("$0$^X");
print "result​: '$_' ", tainted($_) ? "tainted" : "untainted" for @​result;

Below is an updated version of shellwords.pl with the following
changes​:

- 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

;# shellwords.pl
;#
;# Usage​:
;# require 'shellwords.pl';
;# @​words = shellwords($line);
;# or
;# @​words = shellwords(@​lines);
;# or
;# @​words = shellwords(); # defaults to $_ (and clobbers it)

sub shellwords {
  local *_ = \join('', @​_) if @​_;
  my (@​words, $snippet);

  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;

Flags:
    category=core
    severity=low

This perlbug was built using Perl v5.8.5 - Sun Nov  7 13:52:55 CET 2004
It is being executed now by  Perl v5.8.4 - Thu Jun  3 13:28:19 CEST 2004.

Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun  3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
  Platform:
    osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
    uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686 gnulinux '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=define use64bitall=undef uselongdouble=define
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -fomit-frame-pointer',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.4.0 20031231 (experimental)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.4:
    /usr/lib/perl5/5.8.4/i686-linux-64int-ld
    /usr/lib/perl5/5.8.4
    /usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
    /usr/lib/perl5/site_perl/5.8.4
    /usr/lib/perl5/site_perl
    .


Environment for perl v5.8.4:
    HOME=/home/ton
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schily/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sbin:/bin:/sbin:.
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From @rgs

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.

- 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

The RT System itself - Status changed from 'new' to 'open'

@rgs - Status changed from 'open' to 'resolved'

From at@altlinux.ru

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;

From chromatic@wgz.org

On Tue, 2004-12-28 at 22​:29 +0300, Alexey Tourbin wrote​:

--- 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";

This being a module, it's okay to use at least test.pl here, if not
Test​::More. It should have test comments either way.

-- c

From perl5-porters@ton.iguana.be

(in sub old_shellwords)

- local($_) =3D join('', @​_);
- my(@​words,$snippet,$field);
+ no warnings 'uninitialized'; # we will be testing undef strings

Where would undef strings ever appear ? Except of course for the join of
@​_ if that has undef elements, or the $_ default case if that's undef.
And in these cases I'd prefer getting the warnings.

+ local *_ =3D \join('', @​_) if @​_;
+ my (@​words, $snippet);

From at@altlinux.ru

On Tue, Dec 28, 2004 at 08​:09​:44PM +0000, Ton Hospel wrote​:

(in sub old_shellwords)

- local($_) =3D join('', @​_);
- my(@​words,$snippet,$field);
+ no warnings 'uninitialized'; # we will be testing undef strings

Where would undef strings ever appear ? Except of course for the join of
@​_ if that has undef elements, or the $_ default case if that's undef.
And in these cases I'd prefer getting the warnings.

This is analogous to `sub parse_line' which had `no warnings' at all;
I changed this to `no warnings 'uninitialized'' for clarity. I am not
quite sure whether or not these routines should emit warnings.

From at@altlinux.ru

On Tue, Dec 28, 2004 at 11​:38​:22AM -0800, chromatic wrote​:

On Tue, 2004-12-28 at 22​:29 +0300, Alexey Tourbin wrote​:

--- 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

[...]

This being a module, it's okay to use at least test.pl here, if not
Test​::More. It should have test comments either way.

lib/Text/ParseWords/taint.t was quickly made after lib/Text/ParseWords.t,
which does not use test.pl or Test​::More, nor has it comments in ok/not ok
output.

(I placed it into separate file because it is impossible to enabled
taint mode in a Perl code. BTW, could there be a better location for
lib/Text/ParseWords/taint.t? I can add some more tests unrelated to
taint mode. Maybe lib/Text/ParseWords.t should be relocated or split.)

Anyway, I can't see the reason for using Test​::More offhand.
Having comments is nice, though.

-- c

From @rgs

Alexey Tourbin wrote​:

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

Thanks, applied as #23838.