diff options
| -rw-r--r-- | lib/utf8_heavy.pl | 25 | ||||
| -rw-r--r-- | pod/perldiag.pod | 8 | ||||
| -rw-r--r-- | pod/perlunicode.pod | 4 | ||||
| -rw-r--r-- | t/op/taint.t | 16 |
4 files changed, 46 insertions, 7 deletions
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index 41cace887b..e0cdc7bb46 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -109,8 +109,18 @@ sub croak { require Carp; Carp::croak(@_) } if (defined $caller1 && $type =~ /^I[ns]\w+$/) { my $prop = "${caller1}::$type"; if (exists &{$prop}) { + # stolen from Scalar::Util::PP::tainted() + my $tainted; + { + local($@, $SIG{__DIE__}, $SIG{__WARN__}); + local $^W = 0; + no warnings; + eval { kill 0 * $prop }; + $tainted = 1 if $@ =~ /^Insecure/; + } + die "Insecure user-defined property \\p{$prop}\n" + if $tainted; no strict 'refs'; - $list = &{$prop}($caseless); last GETFILE; } @@ -444,11 +454,12 @@ sub croak { require Carp; Carp::croak(@_) } my $bits = $minbits; if ($list) { + my $taint = substr($list,0,0); # maintain taint my @tmp = split(/^/m, $list); my %seen; no warnings; - $extras = join '', grep /^[^0-9a-fA-F]/, @tmp; - $list = join '', + $extras = join '', $taint, grep /^[^0-9a-fA-F]/, @tmp; + $list = join '', $taint, map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { /^([0-9a-fA-F]+)/; [ CORE::hex($1), $_ ] } @@ -478,11 +489,13 @@ sub croak { require Carp; Carp::croak(@_) } my @extras; if ($extras) { for my $x ($extras) { + my $taint = substr($x,0,0); # maintain taint pos $x = 0; while ($x =~ /^([^0-9a-fA-F\n])(.*)/mg) { - my $char = $1; - my $name = $2; - print STDERR __LINE__, ": $1 => $2\n" if DEBUG; + my $char = "$1$taint"; + my $name = "$2$taint"; + print STDERR __LINE__, ": char [$char] => name [$name]\n" + if DEBUG; if ($char =~ /[-+!&]/) { my ($c,$t) = split(/::/, $name, 2); # bogus use of ::, really my $subobj; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 442106450f..aae2dd3b08 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2188,6 +2188,14 @@ C<$ENV{ENV}>, C<$ENV{BASH_ENV}> or C<$ENV{TERM}> are derived from data supplied (or potentially supplied) by the user. The script must set the path to a known value, using trustworthy data. See L<perlsec>. +=item Insecure user-defined property %s + +(F) Perl detected tainted data when trying to compile a regular +expression that contains a call to a user-defined character property +function, i.e. C<\p{IsFoo}> or C<\p{InFoo}>. +See L<perlunicode/User-Defined Character Properties> and L<perlsec>. + + =item Integer overflow in format string for %s (F) The indexes and widths specified in the format string of C<printf()> diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index edb722d97f..97ac89e04d 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -801,6 +801,10 @@ the value of the flag, and one set of values will immutably be in effect for all case-sensitive matches; the other set for all case-insensitive matches. +Note that if the regular expression is tainted, then perl will die rather +than calling the subroutine, where the name of the subroutine is +determined by the tainted data. + The subroutines must return a specially-formatted string, with one or more newline-separated lines. Each line must be one of the following: diff --git a/t/op/taint.t b/t/op/taint.t index c2ab75d5a5..a040e464ff 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -17,7 +17,7 @@ use Config; use File::Spec::Functions; BEGIN { require './test.pl'; } -plan tests => 687; +plan tests => 689; $| = 1; @@ -2188,6 +2188,20 @@ end is($s, 'xbc', "match bare regex taint value"); } +{ + # [perl #82616] security Issues with user-defined \p{} properties + # A using a tainted user-defined property should croak + + sub IsA { sprintf "%02x", ord("A") } + + my $prop = "IsA"; + ok("A" =~ /\p{$prop}/, "user-defined property: non-tainted case"); + $prop = "IsA$TAINT"; + eval { "A" =~ /\p{$prop}/}; + like($@, qr/Insecure user-defined property \\p{main::IsA}/, + "user-defined property: tainted case"); +} + # This may bomb out with the alarm signal so keep it last SKIP: { skip "No alarm()" unless $Config{d_alarm}; |