[PATCH] Add blacklist and whitelist functionality to Locale::Maketext #15282
Labels
Comments
From @lightseyCreated by @lightseyThe patch attached to this bug report adds support for blacklist Webapps that use Locale::Maketext tend to pre-filter maketext Perl Info |
From @lightsey0001-Add-blacklist-and-whitelist-support-to-Locale-Makete.patchFrom 1429085edd6dde7f605b27094ae03ae5bfe54b5a Mon Sep 17 00:00:00 2001
From: John Lightsey <jd@cpanel.net>
Date: Thu, 17 Mar 2016 16:06:09 +0000
Subject: [PATCH] Add blacklist and whitelist support to Locale::Maketext.
Format string attacks against Locale::Maketext have been discovered in
several popular web applications and addresed by pre-filtering maketext
strings before they are fed into the maketext() method. It is now
possible to restrict the allowed bracked notation methods directly in
Maketext.
This commit also introduces a default blacklist that prevents using the
object and class methods in the Locale::Maketext namespace that were not
intended as bracked notation methods.
---
dist/Locale-Maketext/lib/Locale/Maketext.pm | 71 +++++++++++++++++---
dist/Locale-Maketext/lib/Locale/Maketext.pod | 71 ++++++++++++++++++++
dist/Locale-Maketext/t/92_blacklist.t | 93 +++++++++++++++++++++++++++
dist/Locale-Maketext/t/93_whitelist.t | 96 ++++++++++++++++++++++++++++
4 files changed, 322 insertions(+), 9 deletions(-)
create mode 100644 dist/Locale-Maketext/t/92_blacklist.t
create mode 100644 dist/Locale-Maketext/t/93_whitelist.t
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index 24c31ea..f213c74 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -1,4 +1,3 @@
-
package Locale::Maketext;
use strict;
use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
@@ -138,6 +137,56 @@ sub fail_with { # an actual attribute method!
#--------------------------------------------------------------------------
+sub blacklist {
+ my ( $handle, @methods ) = @_;
+
+ unless ( defined $handle->{'blacklist'} ) {
+ no strict 'refs';
+
+ # Don't let people call methods they're not supposed to from maketext.
+ # Explicitly exclude all methods in this package that start with an
+ # underscore on principle.
+ $handle->{'blacklist'} = {
+ map { $_ => 1 } (
+ qw/
+ blacklist
+ encoding
+ fail_with
+ failure_handler_auto
+ fallback_language_classes
+ fallback_languages
+ get_handle
+ init
+ language_tag
+ maketext
+ new
+ whitelist
+ /, grep { /^_/ } keys %{ __PACKAGE__ . "::" }
+ ),
+ };
+ }
+
+ if ( scalar @methods ) {
+ $handle->{'blacklist'} = { %{ $handle->{'blacklist'} }, map { $_ => 1 } @methods };
+ }
+
+ delete $handle->{'_external_lex_cache'};
+ return;
+}
+
+sub whitelist {
+ my ( $handle, @methods ) = @_;
+ if ( scalar @methods ) {
+ $handle->{'whitelist'} = {} unless defined $handle->{'whitelist'};
+ $handle->{'whitelist'} = { %{ $handle->{'whitelist'} }, map { $_ => 1 } @methods };
+ }
+
+ delete $handle->{'_external_lex_cache'};
+ return;
+}
+
+#--------------------------------------------------------------------------
+
sub failure_handler_auto {
# Meant to be used like:
# $handle->fail_with('failure_handler_auto')
@@ -179,6 +228,7 @@ sub new {
# Nothing fancy!
my $class = ref($_[0]) || $_[0];
my $handle = bless {}, $class;
+ $handle->blacklist;
$handle->init;
return $handle;
}
@@ -508,7 +558,7 @@ sub _compile {
# on strings that don't need compiling.
return \"$string_to_compile" if($string_to_compile !~ m/[\[~\]]/ms); # return a string ref if chars [~] are not in the string
- my $target = ref($_[0]) || $_[0];
+ my $handle = $_[0];
my(@code);
my(@c) = (''); # "chunks" -- scratch.
@@ -540,10 +590,10 @@ sub _compile {
# preceding literal.
if($in_group) {
if($1 eq '') {
- $target->_die_pointing($string_to_compile, 'Unterminated bracket group');
+ $handle->_die_pointing($string_to_compile, 'Unterminated bracket group');
}
else {
- $target->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
+ $handle->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
}
}
else {
@@ -627,13 +677,15 @@ sub _compile {
push @code, ' (';
}
elsif($m =~ /^\w+$/s
- # exclude anything fancy, especially fully-qualified module names
+ && !$handle->{'blacklist'}{$m}
+ && ( !defined $handle->{'whitelist'} || $handle->{'whitelist'}{$m} )
+ # exclude anything fancy and restrict to the whitelist/blacklist.
) {
push @code, ' $_[0]->' . $m . '(';
}
else {
# TODO: implement something? or just too icky to consider?
- $target->_die_pointing(
+ $handle->_die_pointing(
$string_to_compile,
"Can't use \"$m\" as a method name in bracket group",
2 + length($c[-1])
@@ -675,7 +727,7 @@ sub _compile {
push @c, '';
}
else {
- $target->_die_pointing($string_to_compile, q{Unbalanced ']'});
+ $handle->_die_pointing($string_to_compile, q{Unbalanced ']'});
}
}
@@ -760,8 +812,9 @@ sub _compile {
sub _die_pointing {
# This is used by _compile to throw a fatal error
- my $target = shift; # class name
- # ...leaving $_[0] the error-causing text, and $_[1] the error message
+ my $target = shift;
+ $target = ref($target) || $target; # class name
+ # ...leaving $_[0] the error-causing text, and $_[1] the error message
my $i = index($_[0], "\n");
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pod b/dist/Locale-Maketext/lib/Locale/Maketext.pod
index a391b29..8c5be19 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pod
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pod
@@ -307,6 +307,13 @@ interested in hearing about it.)
These two methods are discussed in the section "Controlling
Lookup Failure".
+=item $lh->blacklist(@list)
+
+=item $lh->whitelist(@list)
+
+These methods are discussed in the section "Bracket Notation
+Security".
+
=back
=head2 Utility Methods
@@ -861,6 +868,70 @@ I do not anticipate that you will need (or particularly want)
to nest bracket groups, but you are welcome to email me with
convincing (real-life) arguments to the contrary.
+=head1 BRACKET NOTATION SECURITY
+
+Locale::Maketext does not use any special syntax to differentiate
+bracket notation methods from normal class or object methods. This
+design makes it vulnerable to format string attacks whenever it is
+used to process strings provided by untrusted users.
+
+Locale::Maketext does support blacklist and whitelist functionality
+to limit which methods may be called as bracket notation methods.
+
+By default, Locale::Maketext blacklists all methods in the
+Locale::Maketext namespace that begin with the '_' character,
+and all methods which include Perl's namespace separator characters.
+
+The default blacklist for Locale::Maketext also prevents use of the
+following methods in bracket notation:
+
+ blacklist
+ encoding
+ fail_with
+ failure_handler_auto
+ fallback_language_classes
+ fallback_languages
+ get_handle
+ init
+ language_tag
+ maketext
+ new
+ whitelist
+
+This list can be extended by either blacklisting additional "known bad"
+methods, or whitelisting only "known good" methods.
+
+To prevent specific methods from being called in bracket notation, use
+the blacklist() method:
+
+ my $lh = MyProgram::L10N->get_handle();
+ $lh->blacklist(qw{my_internal_method my_other_method});
+ $lh->maketext('[my_internal_method]'); # dies
+
+To limit the allowed bracked notation methods to a specific list, use the
+whitelist() method:
+
+ my $lh = MyProgram::L10N->get_handle();
+ $lh->whitelist('numerate', 'numf');
+ $lh->maketext('[_1] [numerate, _1,shoe,shoes]', 12); # works
+ $lh->maketext('[my_internal_method]'); # dies
+
+The blacklist() and whitelist() methods extend their internal lists
+whenever they are called. To reset the blacklist or whitelist, create
+a new maketext object.
+
+ my $lh = MyProgram::L10N->get_handle();
+ $lh->blacklist('numerate');
+ $lh->blacklist('numf');
+ $lh->maketext('[_1] [numerate,_1,shoe,shoes]', 12); # dies
+
+For lexicons that use an internal cache, translations which have already
+been cached in their compiled form are not affected by subsequent changes
+to the whitelist or blacklist settings. Lexicons that use an external
+cache will have their cache cleared whenever the whitelist of blacklist
+setings change. The difference between the two types of caching is explained
+in the "Readonly Lexicons" section.
+
=head1 AUTO LEXICONS
If maketext goes to look in an individual %Lexicon for an entry
diff --git a/dist/Locale-Maketext/t/92_blacklist.t b/dist/Locale-Maketext/t/92_blacklist.t
new file mode 100644
index 0000000..6ed36d1
--- /dev/null
+++ b/dist/Locale-Maketext/t/92_blacklist.t
@@ -0,0 +1,93 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 17;
+
+BEGIN {
+ use_ok("Locale::Maketext");
+}
+
+{
+
+ package MyTestLocale;
+ no warnings 'once';
+
+ @MyTestLocale::ISA = qw(Locale::Maketext);
+ %MyTestLocale::Lexicon = ();
+}
+
+{
+
+ package MyTestLocale::en;
+ no warnings 'once';
+
+ @MyTestLocale::en::ISA = qw(MyTestLocale);
+
+ %MyTestLocale::en::Lexicon = ( '_AUTO' => 1 );
+
+ sub custom_handler {
+ return "custom_handler_response";
+ }
+
+ sub _internal_method {
+ return "_internal_method_response";
+ }
+
+ sub new {
+ my ( $class, @args ) = @_;
+ my $lh = $class->SUPER::new(@args);
+ $lh->{use_external_lex_cache} = 1;
+ return $lh;
+ }
+}
+
+my $lh = MyTestLocale->get_handle('en');
+my $res;
+
+# get_handle blocked by default
+$res = eval { $lh->maketext('[get_handle,en]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default blacklist' );
+
+# _ambient_langprefs blocked by default
+$res = eval { $lh->maketext('[_ambient_langprefs]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default blacklist' );
+
+# _internal_method not blocked by default
+$res = eval { $lh->maketext('[_internal_method]') };
+is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default blacklist' );
+is( $@, '', 'no exception thrown by use of _internal_method under default blacklist' );
+
+# sprintf not blocked by default
+$res = eval { $lh->maketext('[sprintf,%s,hello]') };
+is( $res, "hello", 'sprintf allowed in bracket notation by default blacklist' );
+is( $@, '', 'no exception thrown by use of sprintf under default blacklist' );
+
+# blacklisting sprintf and numerate
+$lh->blacklist( 'sprintf', 'numerate' );
+
+# sprintf blocked by custom blacklist
+$res = eval { $lh->maketext('[sprintf,%s,hello]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist' );
+
+# blacklisting numf and _internal_method
+$lh->blacklist('numf');
+$lh->blacklist('_internal_method');
+
+# sprintf blocked by custom blacklist
+$res = eval { $lh->maketext('[sprintf,%s,hello]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist after extension of blacklist' );
+
+# _internal_method blocked by custom blacklist
+$res = eval { $lh->maketext('[_internal_method]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'sprintf blocked in bracket notation by custom blacklist after extension of blacklist' );
+
+# custom_handler not in default or custom blacklist
+$res = eval { $lh->maketext('[custom_handler]') };
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by default and custom blacklists' );
+is( $@, '', 'no exception thrown by use of custom_handler under default and custom blacklists' );
diff --git a/dist/Locale-Maketext/t/93_whitelist.t b/dist/Locale-Maketext/t/93_whitelist.t
new file mode 100644
index 0000000..21f2d85
--- /dev/null
+++ b/dist/Locale-Maketext/t/93_whitelist.t
@@ -0,0 +1,96 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 17;
+
+BEGIN {
+ use_ok("Locale::Maketext");
+}
+
+{
+
+ package MyTestLocale;
+ no warnings 'once';
+
+ @MyTestLocale::ISA = qw(Locale::Maketext);
+ %MyTestLocale::Lexicon = ();
+}
+
+{
+
+ package MyTestLocale::en;
+ no warnings 'once';
+
+ @MyTestLocale::en::ISA = qw(MyTestLocale);
+
+ %MyTestLocale::en::Lexicon = ( '_AUTO' => 1 );
+
+ sub custom_handler {
+ return "custom_handler_response";
+ }
+
+ sub _internal_method {
+ return "_internal_method_response";
+ }
+
+ sub new {
+ my ( $class, @args ) = @_;
+ my $lh = $class->SUPER::new(@args);
+ $lh->{use_external_lex_cache} = 1;
+ return $lh;
+ }
+}
+
+my $lh = MyTestLocale->get_handle('en');
+my $res;
+
+# _internal_method not blocked by default
+$res = eval { $lh->maketext('[_internal_method]') };
+is( $res, "_internal_method_response", '_internal_method allowed when no whitelist defined' );
+is( $@, '', 'no exception thrown by use of _internal_method without whitelist setting' );
+
+# whitelisting sprintf
+$lh->whitelist('sprintf');
+
+# _internal_method blocked by whitelist
+$res = eval { $lh->maketext('[_internal_method]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by whitelist' );
+
+# sprintf allowed by whitelist
+$res = eval { $lh->maketext('[sprintf,%s,hello]') };
+is( $res, "hello", 'sprintf allowed in bracket notation by whitelist' );
+is( $@, '', 'no exception thrown by use of sprintf with whitelist' );
+
+# custom_handler blocked by whitelist
+$res = eval { $lh->maketext('[custom_handler]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'custom_handler blocked in bracket notation by whitelist' );
+
+# adding custom_handler to whitelist
+$lh->whitelist('custom_handler');
+
+# sprintf still allowed by whitelist
+$res = eval { $lh->maketext('[sprintf,%s,hello]') };
+is( $res, "hello", 'sprintf allowed in bracket notation by whitelist' );
+is( $@, '', 'no exception thrown by use of sprintf with whitelist' );
+
+# custom_handler allowed by whitelist
+$res = eval { $lh->maketext('[custom_handler]') };
+is( $res, "custom_handler_response", 'custom_handler allowed in bracket notation by whitelist' );
+is( $@, '', 'no exception thrown by use of custom_handler with whitelist' );
+
+# _internal_method blocked by whitelist
+$res = eval { $lh->maketext('[_internal_method]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, '_internal_method blocked in bracket notation by whitelist' );
+
+# adding fail_with to whitelist
+$lh->whitelist('fail_with');
+
+# fail_with still blocked by blacklist
+$res = eval { $lh->maketext('[fail_with,xyzzy]') };
+is( $res, undef, 'no return value from blocked expansion' );
+like( $@, qr/Can't use .* as a method name/, 'fail_with blocked in bracket notation by blacklist even when whitelisted' );
+
--
2.7.1
|
From @tonycozOn Mon Apr 18 11:11:27 2016, john@nixnuts.net wrote:
I plan to apply this along with the fixes needed to pass the porting tests after 5.24 is releases. I'll also add a note that clarifies the priority of the black and white lists, per the attached. Tony |
From @tonycoz0002-perl-127923-pass-porting-tests.patchFrom 7666a3db2882281360faf15df656c8541e00dd50 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 20 Apr 2016 16:27:09 +1000
Subject: (perl #127923) pass porting tests
- update MANIFEST, AUTHORS
- bump $Locale::Maketext::VERSION
---
AUTHORS | 1 +
MANIFEST | 2 ++
dist/Locale-Maketext/lib/Locale/Maketext.pm | 2 +-
3 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/AUTHORS b/AUTHORS
index 3cc2ef1..167efd9 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -620,6 +620,7 @@ John Holdsworth <coldwave@bigfoot.com>
John Hughes <john@AtlanTech.COM>
John Kristian <jmk2001@engineer.com>
John L. Allen <allen@grumman.com>
+John Lightsey <jd@cpanel.net>
John Macdonald <jmm@revenge.elegant.com>
John Malmberg <wb8tyw@gmail.com>
John Nolan <jpnolan@Op.Net>
diff --git a/MANIFEST b/MANIFEST
index 3da3119..eafece8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3264,6 +3264,8 @@ dist/Locale-Maketext/t/60_super.t See if Locale::Maketext works
dist/Locale-Maketext/t/70_fail_auto.t See if Locale::Maketext works
dist/Locale-Maketext/t/90_utf8.t See if Locale::Maketext works
dist/Locale-Maketext/t/91_backslash.t See if Locale::Maketext works
+dist/Locale-Maketext/t/92_blacklist.t See if Locale::Maketext works
+dist/Locale-Maketext/t/93_whitelist.t See if Locale::Maketext works
dist/Module-CoreList/Changes Module::CoreList Changes
dist/Module-CoreList/corelist The corelist command-line utility
dist/Module-CoreList/identify-dependencies A usage example for Module::CoreList
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
index f213c74..823c8d7 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pm
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -26,7 +26,7 @@ BEGIN {
}
-$VERSION = '1.26';
+$VERSION = '1.27';
@ISA = ();
$MATCH_SUPERS = 1;
--
2.1.4
|
From @tonycoz0003-perl-127923-note-priority-between-the-white-and-blac.patchFrom 7d7310252826cac426f75cca1e8780bbdbb1bcd8 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 20 Apr 2016 16:30:05 +1000
Subject: (perl #127923) note priority between the white and blacklist
---
dist/Locale-Maketext/lib/Locale/Maketext.pod | 3 +++
1 file changed, 3 insertions(+)
diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pod b/dist/Locale-Maketext/lib/Locale/Maketext.pod
index 8c5be19..564e5af 100644
--- a/dist/Locale-Maketext/lib/Locale/Maketext.pod
+++ b/dist/Locale-Maketext/lib/Locale/Maketext.pod
@@ -932,6 +932,9 @@ cache will have their cache cleared whenever the whitelist of blacklist
setings change. The difference between the two types of caching is explained
in the "Readonly Lexicons" section.
+Methods disallowed by the blacklist cannot be permitted by the
+whitelist.
+
=head1 AUTO LEXICONS
If maketext goes to look in an individual %Lexicon for an entry
--
2.1.4
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @lightseyOn Tue, 2016-04-19 at 23:33 -0700, Tony Cook via RT wrote:
Excellent, looks good to me. |
From @toddrOn Tue Apr 19 23:33:47 2016, tonyc wrote:
FYI I'm going to wait on this merge before releasing L:MT to CPAN. |
From @toddrOn Fri Apr 22 08:23:14 2016, TODDR wrote:
Bump. Are we ok to merge this now? Todd |
From @tonycozOn Mon May 09 11:44:30 2016, TODDR wrote:
Thanks, applied as 6a810bd, which my fixes as cf6c814 and note as e5000e0. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.26.0, this and 210 other issues have been Perl 5.26.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#127923 (status was 'resolved')
Searchable as RT127923$
The text was updated successfully, but these errors were encountered: