In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e1e9e450cffebeb6cd494b47723b965a2d44f10b?hp=f54530a43a9d4dd069e26aefc7ae572ac4e299cf>
- Log ----------------------------------------------------------------- commit e1e9e450cffebeb6cd494b47723b965a2d44f10b Merge: f54530a e5000e0 Author: Tony Cook <[email protected]> Date: Tue May 10 12:03:02 2016 +1000 (perl #127923) add blacklists/whitelists to Locale::Maketext commit e5000e04e4da352e379d186098fdee6c8edd4fb8 Author: Tony Cook <[email protected]> Date: Wed Apr 20 16:30:05 2016 +1000 (perl #127923) note priority between the white and blacklist M dist/Locale-Maketext/lib/Locale/Maketext.pod commit cf6c81467061cd51e29062107db165a6fea9fe19 Author: Tony Cook <[email protected]> Date: Wed Apr 20 16:27:09 2016 +1000 (perl #127923) pass porting tests - update MANIFEST, AUTHORS - bump $Locale::Maketext::VERSION M AUTHORS M MANIFEST M dist/Locale-Maketext/lib/Locale/Maketext.pm commit 6a810bd43dcf7de311a8b308e7f58bbb7c0f758e Author: John Lightsey <[email protected]> Date: Thu Mar 17 16:06:09 2016 +0000 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. M dist/Locale-Maketext/lib/Locale/Maketext.pm M dist/Locale-Maketext/lib/Locale/Maketext.pod A dist/Locale-Maketext/t/92_blacklist.t A dist/Locale-Maketext/t/93_whitelist.t ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + MANIFEST | 2 + dist/Locale-Maketext/lib/Locale/Maketext.pm | 73 ++++++++++++++++++--- dist/Locale-Maketext/lib/Locale/Maketext.pod | 74 +++++++++++++++++++++ dist/Locale-Maketext/t/92_blacklist.t | 93 +++++++++++++++++++++++++++ dist/Locale-Maketext/t/93_whitelist.t | 96 ++++++++++++++++++++++++++++ 6 files changed, 329 insertions(+), 10 deletions(-) create mode 100644 dist/Locale-Maketext/t/92_blacklist.t create mode 100644 dist/Locale-Maketext/t/93_whitelist.t diff --git a/AUTHORS b/AUTHORS index 3cc2ef1..167efd9 100644 --- a/AUTHORS +++ b/AUTHORS @@ -620,6 +620,7 @@ John Holdsworth <[email protected]> John Hughes <[email protected]> John Kristian <[email protected]> John L. Allen <[email protected]> +John Lightsey <[email protected]> John Macdonald <[email protected]> John Malmberg <[email protected]> John Nolan <[email protected]> diff --git a/MANIFEST b/MANIFEST index d0d64f5..1602cdd 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 24c31ea..823c8d7 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 @@ -27,7 +26,7 @@ BEGIN { } -$VERSION = '1.26'; +$VERSION = '1.27'; @ISA = (); $MATCH_SUPERS = 1; @@ -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..564e5af 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,73 @@ 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. + +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 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' ); + -- Perl5 Master Repository
