This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This patch with tests resolves CPAN RT #40727. The issue is an infi-
authorTodd Rinaldo <toddr@cpanel.net>
Sat, 25 Sep 2010 18:20:10 +0000 (11:20 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 25 Sep 2010 18:20:10 +0000 (11:20 -0700)
nite loop during _compile when working with tainted values. The issue
was triggered by perlbugs 60378,27344. Both have been resolved but
they are still broken in perl 5.12.x and earlier.

The patch simply assigns $_[1] to a variable and uses that
from then on.

dist/Locale-Maketext/lib/Locale/Maketext.pm
dist/Locale-Maketext/t/09_compile.t [new file with mode: 0644]

index 929a70e..0e7c6d2 100644 (file)
@@ -1,3 +1,4 @@
+
 package Locale::Maketext;
 use strict;
 use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
@@ -498,7 +499,8 @@ sub _compile {
         my $in_group = 0; # start out outside a group
         my($m, @params); # scratch
 
-        while($_[1] =~  # Iterate over chunks.
+       my $string_to_compile = $_[1]; # There are taint issues using regex on @_ - perlbug 60378,27344
+        while($string_to_compile =~  # Iterate over chunks.
             m/\G(
                 [^\~\[\]]+  # non-~[] stuff
                 |
@@ -520,10 +522,10 @@ sub _compile {
                 #  preceding literal.
                 if($in_group) {
                     if($1 eq '') {
-                        $target->_die_pointing($_[1], 'Unterminated bracket group');
+                        $target->_die_pointing($string_to_compile, 'Unterminated bracket group');
                     }
                     else {
-                        $target->_die_pointing($_[1], 'You can\'t nest bracket groups');
+                        $target->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
                     }
                 }
                 else {
@@ -533,7 +535,7 @@ sub _compile {
                     else {
                         $in_group = 1;
                     }
-                    die "How come \@c is empty?? in <$_[1]>" unless @c; # sanity
+                    die "How come \@c is empty?? in <$string_to_compile>" unless @c; # sanity
                     if(length $c[-1]) {
                         # Now actually processing the preceding literal
                         $big_pile .= $c[-1];
@@ -612,7 +614,7 @@ sub _compile {
                         # Yes, it even supports the demented (and undocumented?)
                         #  $obj->Foo::bar(...) syntax.
                         $target->_die_pointing(
-                            $_[1], q{Can't use "SUPER::" in a bracket-group method},
+                            $string_to_compile, q{Can't use "SUPER::" in a bracket-group method},
                             2 + length($c[-1])
                         )
                         if $m =~ m/^SUPER::/s;
@@ -625,7 +627,7 @@ sub _compile {
                     else {
                         # TODO: implement something?  or just too icky to consider?
                         $target->_die_pointing(
-                            $_[1],
+                            $string_to_compile,
                             "Can't use \"$m\" as a method name in bracket group",
                             2 + length($c[-1])
                         );
@@ -666,7 +668,7 @@ sub _compile {
                     push @c, '';
                 }
                 else {
-                    $target->_die_pointing($_[1], q{Unbalanced ']'});
+                    $target->_die_pointing($string_to_compile, q{Unbalanced ']'});
                 }
 
             }
diff --git a/dist/Locale-Maketext/t/09_compile.t b/dist/Locale-Maketext/t/09_compile.t
new file mode 100644 (file)
index 0000000..e2bbe43
--- /dev/null
@@ -0,0 +1,20 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use Scalar::Util qw(tainted);
+use Locale::Maketext;
+
+my @ENV_values = values %ENV;
+my $tainted_value;
+do { $tainted_value = shift @ENV_values  } while(!$tainted_value || ref $tainted_value);
+
+ok(tainted($tainted_value), "\$tainted_value is tainted") or die('huh... %ENV has no entries? I don\'t know how to test taint without it');
+
+my $result = Locale::Maketext::_compile("hello [_1]", $tainted_value);
+
+pass("_compile does not hang on tainted values");
+