diff --git a/lib/HTML/FormHandler/Field.pm b/lib/HTML/FormHandler/Field.pm index 5cb963ca..e54275a8 100644 --- a/lib/HTML/FormHandler/Field.pm +++ b/lib/HTML/FormHandler/Field.pm @@ -173,6 +173,23 @@ See also L. return $field->add_error( 'bad data' ) if $bad; +The first argument is the localization FORMAT, which for a +L handle means bracket notation in it is compiled and +executed. Do not build that argument out of submitted data: a value +containing a C<[...]> group would be run as a method call rather than +shown. Pass the value as an argument instead, where it is inert: + + # wrong -- the submitted value becomes part of the format + $field->add_error( "The value '" . $field->value . "' is not allowed" ); + + # right -- the format is yours, the value is just an argument + $field->add_error( "The value '[_1]' is not allowed", $field->value ); + +Also note that the first argument is cached by L, +without any size limits or purging of data. Passing error messages in +the first argument that contain text submitted over the internet opens +up a system to memory consumption attacks. + =item error_fields Compound fields will have an array of errors from the subfields. @@ -1415,7 +1432,26 @@ sub add_error { unless ( defined $message[0] ) { @message = ( $class_messages->{field_invalid}); } - @message = @{$message[0]} if ref $message[0] eq 'ARRAY'; + if ( ref $message[0] eq 'ARRAY' ) { + # The list-or-arrayref spelling here is the same convenience idiom as + # add_element_class and friends. It is not documented for add_error, + # nothing in the distribution reaches it, and what does reach it is + # request data: $field->add_error($field->value), where the request + # parser folded a duplicate parameter into an arrayref, puts submitted + # text in element 0 -- which _localize hands to Locale::Maketext as the + # FORMAT. Dereference as before, but if element 0 could be parsed as a + # bracket group, pass it as an inert argument instead of as the format. + # A caller who really wants a compiled template passes it as a plain + # list, $field->add_error($template, @args), which is the documented + # spelling and is unchanged. + my @args = @{ $message[0] }; + # Interpolate explicitly: '[_1]' alone returns its argument unchanged + # (see the note in Validate.pm's _needs_inert_format caller), and the + # errors attribute holds strings. + @message = $self->_needs_inert_format( $args[0] ) + ? ( '[_1]', "$args[0]" ) + : @args; + } my $out; try { $out = $self->_localize(@message); diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm index 9d8d3896..0666d3e2 100644 --- a/lib/HTML/FormHandler/Validate.pm +++ b/lib/HTML/FormHandler/Validate.pm @@ -164,13 +164,66 @@ sub _build_apply_list { $self->add_action(@apply_list); } + +# Locale::Maketext compiles its FORMAT argument: a '[...]' group in it becomes +# method-dispatch code (see _compile in Locale::Maketext). Messages FormHandler +# itself authors are templates on purpose, but several kinds of text reaching +# _apply_actions are not ours and do carry request data -- a warning trapped by +# the $SIG{__WARN__} handler below (Perl quotes the offending value into it +# verbatim), a type constraint's failure message (the type system renders a +# rejected reference in bracket-and-comma form), and exceptions from a coercion +# or a transform. +# +# Rather than escape the bracket metacharacters in such text, hand it to the +# localizer as an ARGUMENT with a constant format, which is the idiom the +# add_error POD recommends to applications: the text then cannot be parsed as +# anything at all, so there is no escaping to get right. +# +# This applies to all such text, not only text that happens to contain a +# bracket. Two reasons. It keeps the rule simple enough to check by reading it +# -- "text we did not author is never a format" -- with no predicate to get +# wrong. And it stops the text being used as a LEXICON KEY: with _AUTO set, as +# it is for HTML::FormHandler::I18N::en_us, Locale::Maketext memoises every +# distinct format into a package-global hash that is never evicted and outlives +# the handle, so distinct submitted values otherwise accumulate in a long-lived +# process for as long as it runs. +# +# The cost is that such text is no longer looked up in the lexicon, so a +# translated custom type-constraint message is now shown as the type gave it. +# A maintainer who would rather keep that lookup can return false for text with +# no '~', '[' or ']' in it, which is the complete set of characters +# Locale::Maketext's compiler treats specially: +# +# return 0 if $text !~ /[~\[\]]/; +# +# and adjust the corresponding assertion in t/errors/maketext_inert_argument.t. +# References are diverted too, and deliberately so. All of the sources above can +# deliver one: `warn $object` hands the object itself to $SIG{__WARN__}, `die +# $object` in a transform or a coercion leaves it in $@, and a type constraint's +# message block may return one. Locale::Maketext then STRINGIFIES whatever it is +# given as the format -- _compile's own fast-path regex does it before anything +# else -- so an object with a '""' overload that yields bracket notation would +# skip a reference bailout and be compiled anyway. Testing the stringification +# here instead would not help: Maketext performs its own, later stringification, +# so inspecting one and compiling the other leaves a gap, and an overload is +# arbitrary code that need not answer the same way twice. Passing the object as +# an argument sidesteps all of it -- an argument is interpolated, never compiled, +# so it stringifies exactly as it did before and only the compilation is gone. +sub _needs_inert_format { + my ( $self, $text ) = @_; + + return defined $text ? 1 : 0; +} sub _apply_actions { my $self = shift; my $error_message; + # True when $error_message holds text this module did not author. + my $foreign_message; local $SIG{__WARN__} = sub { my $error = shift; - $error_message = $error; + $error_message = $error; + $foreign_message = 1; return 1; }; @@ -180,7 +233,8 @@ sub _apply_actions { }; for my $action ( @{ $self->actions || [] } ) { - $error_message = undef; + $error_message = undef; + $foreign_message = undef; # the first time through value == input my $value = $self->value; my $new_value = $value; @@ -210,6 +264,7 @@ sub _apply_actions { else { $error_message = $@; } + $foreign_message = 1; } else { $new_value = $coerce_returned; @@ -217,10 +272,11 @@ sub _apply_actions { } } - $error_message ||= $tobj->validate($new_value); + unless ($error_message) { + $error_message = $tobj->validate($new_value); + $foreign_message = 1 if $error_message; + } } - # now maybe: http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail - # actions in a hashref elsif ( ref $action->{check} eq 'CODE' ) { if ( !$action->{check}->($value, $self) ) { $error_message = $self->get_message('wrong_value'); @@ -243,6 +299,7 @@ sub _apply_actions { }; if ($@) { $error_message = $@ || $self->get_message('error_occurred'); + $foreign_message = 1; } else { $self->_set_value($new_value); @@ -261,6 +318,20 @@ sub _apply_actions { elsif ( ref \$act_msg eq 'SCALAR' ) { @message = ($act_msg); } + # The application supplied this message, so it is a template on + # purpose and foreignness no longer applies. + $foreign_message = 0; + } + if ( $foreign_message && $self->_needs_inert_format( $message[0] ) ) { + # Interpolate explicitly. A format that is a single bracket group + # compiles to one chunk, and Locale::Maketext only prepends its + # `join ''` when there is more than one, so '[_1]' alone returns the + # argument UNCHANGED rather than a string -- which would put an + # exception object into the errors attribute, where the type + # constraint is ArrayRef[Str]. Stringifying here also means the + # conversion happens exactly once, under our control, and its result + # can never be reparsed as a format. + @message = ( '[_1]', "$message[0]" ); } $self->add_error(@message); } diff --git a/t/errors/maketext_inert_argument.t b/t/errors/maketext_inert_argument.t new file mode 100644 index 00000000..6c234c65 --- /dev/null +++ b/t/errors/maketext_inert_argument.t @@ -0,0 +1,228 @@ +use strict; +use warnings; +use Test::More; +use Test::Exception; + +# Text this distribution did not author must not be used as the Locale::Maketext +# FORMAT. Maketext compiles a '[...]' group in the format into a method call, so +# any such text carrying request data lets a submitted value reach a method on +# the language handle, with the submitter choosing the method and its arguments. +# +# The first five blocks below FAIL without the fix: the payload is dispatched +# instead of shown, or form processing dies outright. The remaining tests assert +# the behaviour the fix must not break -- ordinary messages, bracket notation in +# templates this distribution or the application authored, and lexicon lookup of +# a message that merely happens to be translatable. Those pass either way, by +# design; they are the regression guard. + +{ + package Test::Inert::Warn; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + # An ordinary numeric transform. It succeeds, but it warns, and Perl quotes + # the offending value into the warning verbatim -- so the submitted value + # lands in text that _apply_actions traps and turns into a message. The + # coderef must be compiled under 'use warnings' (as it is here) for the + # warning to happen at all. + has_field 'qty' => ( + type => 'Text', + apply => [ { transform => sub { $_[0] + 0 } } ], + ); + no HTML::FormHandler::Moose; +} + +{ + package Test::Inert::ValueAsMessage; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + has_field 'echo' => ( type => 'Text' ); + # add_error($value) where a duplicate request parameter made $value an + # arrayref: the arrayref lands where a template and its arguments go. + sub validate_echo { my ( $self, $field ) = @_; $field->add_error( $field->value ) } + no HTML::FormHandler::Moose; +} + +{ + package Test::Inert::Typed; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + has_field 'nickname' => ( type => 'Text', apply => [ { type => 'Str' } ] ); + no HTML::FormHandler::Moose; +} + +{ + package Test::Inert::MaxLen; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + has_field 'short' => ( type => 'Text', maxlength => 3 ); + no HTML::FormHandler::Moose; +} + +{ + package Test::Inert::Template; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + has_field 'tags' => ( type => 'Text' ); + # The documented spelling: the template is the application's, the value is + # an argument. Bracket notation in it must still compile. + sub validate_tags { + my ( $self, $field ) = @_; + $field->add_error( 'Too many [quant,_1,tag,tags] in [_2]', 3, $field->value ); + } + no HTML::FormHandler::Moose; +} + +# A custom type whose message is a phrase the application has in its lexicon. +# Text this distribution did not author is never used as the format, so it is +# never a lexicon key either: the message is shown as the type gave it. That is +# a deliberate consequence and is asserted here so it cannot change silently. +{ + package Test::Inert::L10N; + our @ISA = ('HTML::FormHandler::I18N'); + package Test::Inert::L10N::en; + our @ISA = ('Test::Inert::L10N'); + our %Lexicon = ( '_AUTO' => 1, 'Must be positive' => 'TRANSLATED OK' ); +} +{ + package Test::Inert::Translated; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + use Moose::Util::TypeConstraints; + subtype 'TestInertPositive', + as 'Int', + where { $_ > 0 }, + message { 'Must be positive' }; + has_field 'p' => ( type => 'Text', apply => [ { type => 'TestInertPositive' } ] ); + no HTML::FormHandler::Moose; +} + +# An exception object, or any other reference, reaching one of those sources. +# Locale::Maketext stringifies its format argument -- honouring a '""' overload +# -- so text arriving inside an object must be diverted just as a plain string +# is, or the object becomes a way around the whole thing. +{ + package Test::Inert::Strung; + use overload '""' => sub { $_[0]->{text} }, fallback => 1; + sub new { my ( $class, %a ) = @_; return bless {%a}, $class } +} + +{ + package Test::Inert::Dies; + use HTML::FormHandler::Moose; + extends 'HTML::FormHandler'; + has 'boom' => ( is => 'rw' ); + has_field 'f' => ( + type => 'Text', + apply => [ { transform => sub { die $_[1]->form->boom } } ], + ); + no HTML::FormHandler::Moose; +} + +sub errors_of { + my $form = shift; + return join ' | ', map { $_->all_errors } $form->fields; +} + +# -------------------------------------------------------------------------- +# These five blocks fail without the fix. +# -------------------------------------------------------------------------- + +# A method call in a trapped warning must be shown, not dispatched. sprintf is +# used with a small width on purpose: the point is to detect that dispatch +# happened at all, not to allocate anything. +{ + my $form = Test::Inert::Warn->new; + lives_ok { $form->process( params => { qty => '[sprintf,%20d,7]' } ) } + 'a bracket group in a trapped warning does not kill form processing'; + my $errors = errors_of($form); + like $errors, qr/\Q[sprintf,%20d,7]\E/, + 'the bracket group is shown literally in the error message'; + unlike $errors, qr/\s{15,}7/, + 'sprintf was not called (no padded output in the message)'; +} + +# A bracket group that does not compile must not become an exception. Without +# the fix this reaches Locale::Maketext's code generator and dies, which +# add_error re-raises: an unhandled error out of process(). +{ + my $form = Test::Inert::Warn->new; + lives_ok { $form->process( params => { qty => '[0]' } ) } + 'a malformed bracket group in a trapped warning does not die'; + like errors_of($form), qr/\Q[0]\E/, 'it is shown literally too'; +} + +# A duplicate request parameter must not supply a template and its arguments. +{ + my $form = Test::Inert::ValueAsMessage->new; + lives_ok { $form->process( params => { echo => [ '[quant,_1,x]', '9' ] } ) } + 'an arrayref value passed to add_error does not die'; + my $errors = errors_of($form); + like $errors, qr/\Q[quant,_1,x]\E/, 'element 0 is shown literally'; + unlike $errors, qr/\b9 xs\b/, + 'quant was not called with the submitter\'s argument'; +} + +# A type constraint renders a rejected reference in bracket-and-comma form into +# its own failure message, so a duplicate parameter alone is enough. Moose only +# renders it that way when it can load a dumper, so skip when it cannot. +SKIP: { + skip 'Devel::PartialDump not available, so the type-constraint message does ' + . 'not render the rejected value as a bracket group', 1 + unless eval { require Devel::PartialDump; Devel::PartialDump->VERSION(0.14); 1 }; + my $form = Test::Inert::Typed->new; + lives_ok { $form->process( params => { nickname => [ 'a', 'b' ] } ) } + 'a duplicate parameter on a typed field does not die'; +} + + +# A payload carried inside an exception object must be shown, not dispatched. +{ + my $form = Test::Inert::Dies->new( + boom => Test::Inert::Strung->new( text => '[sprintf,%20d,7]' ) ); + lives_ok { $form->process( params => { f => 'x' } ) } + 'an exception object stringifying to a bracket group does not kill ' + . 'form processing'; + my $errors = errors_of($form); + like $errors, qr/\Q[sprintf,%20d,7]\E/, + 'the object\'s stringification is shown literally'; + unlike $errors, qr/\s{15,}7/, + 'sprintf was not called through the object'; +} + +# -------------------------------------------------------------------------- +# These pass with and without the fix. They are the regression guard. +# -------------------------------------------------------------------------- + +{ + my $form = Test::Inert::MaxLen->new; + $form->process( params => { short => 'abcdef' } ); + like errors_of($form), qr/should not exceed/, + 'an ordinary built-in message is unchanged'; +} + +{ + my $form = Test::Inert::Template->new; + $form->process( params => { tags => 'a,b,c' } ); + my $errors = errors_of($form); + like $errors, qr/Too many 3 tags/, + 'bracket notation in an application template still compiles'; + like $errors, qr/\Qa,b,c\E/, 'and its argument is interpolated'; +} + +{ + my $form = Test::Inert::Warn->new; + $form->process( params => { qty => 'abc' } ); + like errors_of($form), qr/isn't numeric/, + 'a warning with no bracket metacharacters is still used as the message'; +} + +{ + my $lh = Test::Inert::L10N->get_handle('en'); + my $form = Test::Inert::Translated->new( language_handle => $lh ); + $form->process( params => { p => '-5' } ); + is errors_of($form), 'Must be positive', + 'a type constraint message is shown as the type gave it -- foreign text ' + . 'is never used as the format, so it is never a lexicon key either'; +} + +done_testing;