From c7c69bb58883c0ab9dd7e5dbfa59c0eb11b36750 Mon Sep 17 00:00:00 2001 From: CPANSec Security Scanner Bot Date: Fri, 14 Aug 2026 09:44:01 +0100 Subject: [PATCH 1/4] HTML::FormHandler: stop routing foreign text into the Locale::Maketext format The first argument to add_error is the Locale::Maketext FORMAT: bracket groups in it are compiled into method-dispatch code. Three kinds of text that FormHandler did not author reach that position, all of them carrying submitted request data: * _apply_actions traps warnings into $error_message (Validate.pm, the $SIG{__WARN__} handler). A warning survives a SUCCESSFUL action, so an ordinary numeric transform on a text field turns `Argument "[sprintf,%2000000000d,0]" isn't numeric` into the format -- Perl quotes the value verbatim, so the group is well formed and reaches CORE::sprintf with an attacker-chosen width (~GB allocation). * a type constraint's failure message. Moose renders the rejected value with Devel::PartialDump when it can load it, Type::Tiny always uses its own dumper, and both render a reference in bracket-and-comma form -- so on any field with `apply => [ Str ]`, two same-named request parameters put `[ "a", "b" ]` in the format and maketext croaks, which add_error re-dies: an unhandled 500 with no payload at all. * exceptions from a coercion or transform. * a date parser's error message. Field/Date.pm passes `$strp->errmsg || $@` -- DateTime::Format::Strptime's own text -- straight into the format position. DTFS 1.80 answers a rejected value with the fixed string "Your datetime does not match your pattern.", so there is no reachable payload through it today; that is a property of the current version of a separate distribution rather than of this code, and the `|| $@` fallback is a second channel that was not exercised. Escaped for the same reason as the others. Escape the bracket-notation metacharacters in all four before they are used as a format. Tilde is Locale::Maketext's escape, and text with no brackets is returned unchanged, so lexicon lookups and translated type-constraint messages are byte-identical to before. Escape the bracket-notation metacharacters in all four before they are used as a format. Tilde is Locale::Maketext's escape, and text with no brackets is returned unchanged, so lexicon lookups and translated type-constraint messages are byte-identical to before. Also: add_error derefs an arrayref first argument into (template, @args). That spelling is the same list-or-arrayref convenience idiom as add_element_class and friends; it is not documented for add_error, and an instrumented run of the distribution's own suite (150 files, 1491 tests) never reaches the branch. 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. Since no message the library raises arrives in that shape, treat an arrayref argument as a value: keep the deref, render element 0 literally. A caller who wants a compiled template passes it as a plain list, `$field->add_error($template, @args)`, which is the documented spelling and is unchanged. One case cannot be fixed here: an application that concatenates the value into its own message, `add_error("The value '" . $field->value . "' is not allowed")`, is indistinguishable from a legitimate template, so the add_error POD now documents the hazard and the inert-argument idiom. Behaviour trade-offs -- the only output changes outside the attack cases: * a custom type constraint whose own message block uses bracket notation (message { 'Try [quant,1,thing]' }) now renders that literally. Such a block receives the rejected value and can interpolate it, so escaping it is the safe default; a maintainer who would rather keep those compiled can exempt the has_message branch specifically. * an application calling the undocumented arrayref spelling with a template that uses bracket notation, add_error([ 'Try [quant,_1,thing]', 3 ]), now renders it literally; the list spelling of the same call still compiles. FormHandler's own message templates, and application templates passed to add_error together with their arguments, are unaffected. Verified against the 0.40068 test suite: 150 files, 1491 tests, PASS both before and after. A before/after table of rendered error messages (maxlength, minlength, required, invalid select value, integer range, duplicate-parameter arrays, application template with arguments, plain and bracketed type messages, plain and bracketed warnings and exceptions) is byte-identical except the lines above. Co-Authored-By: Claude Opus 5 (1M context) Signed-off-by: Robert Rothenberg --- lib/HTML/FormHandler/Field.pm | 28 +++- lib/HTML/FormHandler/Field/Date.pm | 6 +- lib/HTML/FormHandler/Validate.pm | 41 +++++- t/errors/maketext_inert_argument.t | 226 +++++++++++++++++++++++++++++ 4 files changed, 293 insertions(+), 8 deletions(-) create mode 100644 t/errors/maketext_inert_argument.t diff --git a/lib/HTML/FormHandler/Field.pm b/lib/HTML/FormHandler/Field.pm index 5cb963ca..a19c6c0e 100644 --- a/lib/HTML/FormHandler/Field.pm +++ b/lib/HTML/FormHandler/Field.pm @@ -173,6 +173,18 @@ 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 ); + =item error_fields Compound fields will have an array of errors from the subfields. @@ -1415,7 +1427,21 @@ 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' ) { + # An arrayref argument is a value, not a message specification. The + # list-or-arrayref spelling here is the same convenience idiom as + # add_element_class and friends, it is not documented for add_error, + # and nothing in the distribution reaches it -- but request data does: + # $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 bracket-notation + # source. Dereference as before, but render element 0 literally. + # A caller who really wants a compiled template passes it as a plain + # list: $field->add_error($template, @args). + my @args = @{ $message[0] }; + $args[0] = $self->_escape_bracket_notation( $args[0] ); + @message = @args; + } my $out; try { $out = $self->_localize(@message); diff --git a/lib/HTML/FormHandler/Field/Date.pm b/lib/HTML/FormHandler/Field/Date.pm index 11fd5ec1..13da57e4 100644 --- a/lib/HTML/FormHandler/Field/Date.pm +++ b/lib/HTML/FormHandler/Field/Date.pm @@ -130,7 +130,11 @@ sub validate { my $dt = eval { $strp->parse_datetime( $self->value ) }; unless ($dt) { - $self->add_error( $strp->errmsg || $@ ); + # The parser's message is not ours to hand to the localizer as a + # bracket-notation FORMAT. DateTime::Format::Strptime 1.80 does not + # quote the rejected input into errmsg, but that is the parser's text + # to change, and the `|| $@` fallback is a second channel. + $self->add_error( $self->_escape_bracket_notation( $strp->errmsg || $@ ) ); return; } $self->_set_value($dt); diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm index 9d8d3896..ddfea198 100644 --- a/lib/HTML/FormHandler/Validate.pm +++ b/lib/HTML/FormHandler/Validate.pm @@ -164,13 +164,40 @@ sub _build_apply_list { $self->add_action(@apply_list); } +# Locale::Maketext treats its FORMAT argument as bracket-notation source: any +# '[...]' group inside it is compiled into method-dispatch code (see _compile +# in Locale::Maketext). Messages FormHandler itself authors are templates on +# purpose, but three kinds of text reaching _apply_actions are not ours and do +# embed request data: +# +# * warnings trapped by the $SIG{__WARN__} handler in _apply_actions -- Perl +# quotes the offending value into them verbatim, so a submitted value like +# '[sprintf,%2000000000d,0]' arrives as a well-formed bracket group; +# * a type constraint's failure message -- the type system renders a rejected +# reference in bracket-and-comma form (Devel::PartialDump when Moose can +# load it, Type::Tiny's own dumper always), so a duplicate request +# parameter is enough to put '[ "a", "b" ]' into the format; +# * exceptions from a coercion or a transform. +# +# Render those literally instead. Tilde is Locale::Maketext's escape character; +# text containing no brackets comes back unchanged, so lexicon lookups and +# translated type-constraint messages behave exactly as before. +sub _escape_bracket_notation { + my ( $self, $text ) = @_; + return $text unless defined $text; + $text = "$text"; + $text =~ s/~/~~/g; + $text =~ s/([\[\]])/~$1/g; + return $text; +} + sub _apply_actions { my $self = shift; my $error_message; local $SIG{__WARN__} = sub { my $error = shift; - $error_message = $error; + $error_message = $self->_escape_bracket_notation($error); return 1; }; @@ -205,10 +232,11 @@ sub _apply_actions { my $coerce_returned = eval { $tobj->coerce($value) }; if ($@) { if ( $tobj->has_message ) { - $error_message = $tobj->message->($value); + $error_message = $self->_escape_bracket_notation( + $tobj->message->($value) ); } else { - $error_message = $@; + $error_message = $self->_escape_bracket_notation($@); } } else { @@ -217,7 +245,8 @@ sub _apply_actions { } } - $error_message ||= $tobj->validate($new_value); + $error_message ||= $self->_escape_bracket_notation( + $tobj->validate($new_value) ); } # now maybe: http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail # actions in a hashref @@ -242,7 +271,8 @@ sub _apply_actions { $action->{transform}->($value, $self); }; if ($@) { - $error_message = $@ || $self->get_message('error_occurred'); + $error_message = $self->_escape_bracket_notation($@) + || $self->get_message('error_occurred'); } else { $self->_set_value($new_value); @@ -303,4 +333,3 @@ sub match_when { use namespace::autoclean; 1; - diff --git a/t/errors/maketext_inert_argument.t b/t/errors/maketext_inert_argument.t new file mode 100644 index 00000000..ba075633 --- /dev/null +++ b/t/errors/maketext_inert_argument.t @@ -0,0 +1,226 @@ +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. +# It contains no bracket metacharacters, so it must still be looked up and +# translated -- this is what distinguishes diverting only parseable text from +# diverting everything. +{ + 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), 'TRANSLATED OK', + 'a type message with no bracket metacharacters is still looked up in the lexicon and translated'; +} + +done_testing; From bbebaef903f772a008ca6a4851e7d9dfcc626d2d Mon Sep 17 00:00:00 2001 From: Robert Rothenberg Date: Fri, 21 Aug 2026 09:55:21 +0100 Subject: [PATCH 2/4] Revert "HTML::FormHandler: stop routing foreign text into the Locale::Maketext format" This reverts commit c7c69bb58883c0ab9dd7e5dbfa59c0eb11b36750. --- lib/HTML/FormHandler/Field.pm | 28 +--- lib/HTML/FormHandler/Field/Date.pm | 6 +- lib/HTML/FormHandler/Validate.pm | 41 +----- t/errors/maketext_inert_argument.t | 226 ----------------------------- 4 files changed, 8 insertions(+), 293 deletions(-) delete mode 100644 t/errors/maketext_inert_argument.t diff --git a/lib/HTML/FormHandler/Field.pm b/lib/HTML/FormHandler/Field.pm index a19c6c0e..5cb963ca 100644 --- a/lib/HTML/FormHandler/Field.pm +++ b/lib/HTML/FormHandler/Field.pm @@ -173,18 +173,6 @@ 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 ); - =item error_fields Compound fields will have an array of errors from the subfields. @@ -1427,21 +1415,7 @@ sub add_error { unless ( defined $message[0] ) { @message = ( $class_messages->{field_invalid}); } - if ( ref $message[0] eq 'ARRAY' ) { - # An arrayref argument is a value, not a message specification. The - # list-or-arrayref spelling here is the same convenience idiom as - # add_element_class and friends, it is not documented for add_error, - # and nothing in the distribution reaches it -- but request data does: - # $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 bracket-notation - # source. Dereference as before, but render element 0 literally. - # A caller who really wants a compiled template passes it as a plain - # list: $field->add_error($template, @args). - my @args = @{ $message[0] }; - $args[0] = $self->_escape_bracket_notation( $args[0] ); - @message = @args; - } + @message = @{$message[0]} if ref $message[0] eq 'ARRAY'; my $out; try { $out = $self->_localize(@message); diff --git a/lib/HTML/FormHandler/Field/Date.pm b/lib/HTML/FormHandler/Field/Date.pm index 13da57e4..11fd5ec1 100644 --- a/lib/HTML/FormHandler/Field/Date.pm +++ b/lib/HTML/FormHandler/Field/Date.pm @@ -130,11 +130,7 @@ sub validate { my $dt = eval { $strp->parse_datetime( $self->value ) }; unless ($dt) { - # The parser's message is not ours to hand to the localizer as a - # bracket-notation FORMAT. DateTime::Format::Strptime 1.80 does not - # quote the rejected input into errmsg, but that is the parser's text - # to change, and the `|| $@` fallback is a second channel. - $self->add_error( $self->_escape_bracket_notation( $strp->errmsg || $@ ) ); + $self->add_error( $strp->errmsg || $@ ); return; } $self->_set_value($dt); diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm index ddfea198..9d8d3896 100644 --- a/lib/HTML/FormHandler/Validate.pm +++ b/lib/HTML/FormHandler/Validate.pm @@ -164,40 +164,13 @@ sub _build_apply_list { $self->add_action(@apply_list); } -# Locale::Maketext treats its FORMAT argument as bracket-notation source: any -# '[...]' group inside it is compiled into method-dispatch code (see _compile -# in Locale::Maketext). Messages FormHandler itself authors are templates on -# purpose, but three kinds of text reaching _apply_actions are not ours and do -# embed request data: -# -# * warnings trapped by the $SIG{__WARN__} handler in _apply_actions -- Perl -# quotes the offending value into them verbatim, so a submitted value like -# '[sprintf,%2000000000d,0]' arrives as a well-formed bracket group; -# * a type constraint's failure message -- the type system renders a rejected -# reference in bracket-and-comma form (Devel::PartialDump when Moose can -# load it, Type::Tiny's own dumper always), so a duplicate request -# parameter is enough to put '[ "a", "b" ]' into the format; -# * exceptions from a coercion or a transform. -# -# Render those literally instead. Tilde is Locale::Maketext's escape character; -# text containing no brackets comes back unchanged, so lexicon lookups and -# translated type-constraint messages behave exactly as before. -sub _escape_bracket_notation { - my ( $self, $text ) = @_; - return $text unless defined $text; - $text = "$text"; - $text =~ s/~/~~/g; - $text =~ s/([\[\]])/~$1/g; - return $text; -} - sub _apply_actions { my $self = shift; my $error_message; local $SIG{__WARN__} = sub { my $error = shift; - $error_message = $self->_escape_bracket_notation($error); + $error_message = $error; return 1; }; @@ -232,11 +205,10 @@ sub _apply_actions { my $coerce_returned = eval { $tobj->coerce($value) }; if ($@) { if ( $tobj->has_message ) { - $error_message = $self->_escape_bracket_notation( - $tobj->message->($value) ); + $error_message = $tobj->message->($value); } else { - $error_message = $self->_escape_bracket_notation($@); + $error_message = $@; } } else { @@ -245,8 +217,7 @@ sub _apply_actions { } } - $error_message ||= $self->_escape_bracket_notation( - $tobj->validate($new_value) ); + $error_message ||= $tobj->validate($new_value); } # now maybe: http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail # actions in a hashref @@ -271,8 +242,7 @@ sub _apply_actions { $action->{transform}->($value, $self); }; if ($@) { - $error_message = $self->_escape_bracket_notation($@) - || $self->get_message('error_occurred'); + $error_message = $@ || $self->get_message('error_occurred'); } else { $self->_set_value($new_value); @@ -333,3 +303,4 @@ sub match_when { use namespace::autoclean; 1; + diff --git a/t/errors/maketext_inert_argument.t b/t/errors/maketext_inert_argument.t deleted file mode 100644 index ba075633..00000000 --- a/t/errors/maketext_inert_argument.t +++ /dev/null @@ -1,226 +0,0 @@ -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. -# It contains no bracket metacharacters, so it must still be looked up and -# translated -- this is what distinguishes diverting only parseable text from -# diverting everything. -{ - 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), 'TRANSLATED OK', - 'a type message with no bracket metacharacters is still looked up in the lexicon and translated'; -} - -done_testing; From b4c965d0c9f633c13edeed427910cf24f5d73c42 Mon Sep 17 00:00:00 2001 From: Robert Rothenberg Date: Fri, 21 Aug 2026 10:21:30 +0100 Subject: [PATCH 3/4] fix: pass foreign text to the localizer as an argument, not as the format This implements the approach you suggested, after the earlier patch -- which escaped the bracket metacharacters in the text instead -- was declined. Thank you for the suggestion; it is a better fix than the one it replaces, for the reasons set out below, and it is shorter. Generated against the SOURCE REPOSITORY at 0.40068-28-gb032539, and `git apply` takes it cleanly there. It deliberately does NOT apply to the 0.40068 release tarball: the coercion branch of _apply_actions changed after the tag (6f58359, "Check the return value of an eval call"), so the context around one hunk differs between the two trees. The defect itself is present in 0.40068 and every earlier release -- only the fix's anchor point moved. There is no MANIFEST hunk, on purpose: MANIFEST is a Dist::Zilla build product and is not in the repository, so a hunk touching it could not apply -- and `git apply` is all-or-nothing, which would take the code hunks down with it. Adding t/errors/maketext_inert_argument.t to the repository is enough; the [Manifest] plugin picks it up at build time. The problem. The first argument to _localize is the Locale::Maketext FORMAT: a "[...]" group in it is compiled into method-dispatch code. Several kinds of text that FormHandler did not author reach that position, all of them carrying submitted request data: * _apply_actions traps warnings into $error_message (Validate.pm, the $SIG{__WARN__} handler). A warning survives a SUCCESSFUL action, so an ordinary numeric transform on a text field turns `Argument "[sprintf,%2000000000d,0]" isn't numeric` into the format -- Perl quotes the value verbatim, so the group is well formed and reaches CORE::sprintf with a submitter-chosen width (~GB allocation). * a type constraint's failure message. Moose renders the rejected value with Devel::PartialDump when it can load it, Type::Tiny always uses its own dumper, and both render a reference in bracket-and-comma form -- so on any field with `apply => [ Str ]`, two same-named request parameters put `[ "a", "b" ]` in the format and maketext croaks, which add_error re-dies: an unhandled 500 with no payload at all. * exceptions from a coercion or transform. * add_error's arrayref first argument, dereferenced into (template, @args). That spelling is the same list-or-arrayref convenience idiom as add_element_class and friends; it is not documented for add_error, and an instrumented run of the distribution's own suite never reaches the branch. 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, and it is the one route that hands over the ARGUMENTS as well as the template. The fix. Hand such text to the localizer as an argument, with a constant format -- the idiom the add_error POD already recommends to applications: $self->add_error( '[_1]', $foreign_text ); A $foreign_message flag records which of the assignments in _apply_actions put text there that this distribution did not write; at the single point where that function calls add_error, such text moves into an argument slot. A message the application supplied through `action => { message => ... }` is a template on purpose and is left alone. Field.pm's add_error does the same for element 0 of an arrayref argument. References count as foreign text, and are diverted too. Every source 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 -- all five confirmed reachable by test. Locale:: Maketext then stringifies whatever it is handed as the format (_compile's own fast-path regex does it before anything else), honouring a '""' overload, so an object stringifying to a bracket group would slip past a bailout on references and be compiled anyway. Testing the stringification instead would not close it: 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. Handing the object over as an argument sidesteps all of it: an argument is interpolated, never compiled, so it stringifies exactly as it did before a bracket group was ever involved, and only the compilation is gone. The interpolation is written explicitly, because a format consisting of one bracket group compiles to a single chunk and Locale::Maketext only prepends its `join ''` when there is more than one -- so '[_1]' by itself hands back the argument as it was, which would put an exception object into the errors attribute where the type constraint is ArrayRef[Str]. Why this is better than escaping, beyond being shorter. Escaping requires knowing that the escape character is "~", that both brackets need it, and that "~" must be doubled before the brackets are touched; getting exactly that wrong in the other direction is CVE-2012-6329. Passing the text as an argument means it is never parsed as anything, so there is no such rule to get right. And it fixes something escaping does not. With _AUTO set -- the default 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 it was compiled for. Using submitted text as the format therefore accumulates a permanent entry per distinct value for as long as the process runs. Escaping the text does not help there; it just memoises the escaped form instead. Measured over five distinct payloads through the warning route: five permanent compiled entries both unpatched and with the escaping patch, one with this patch, however many payloads arrive. Behaviour trade-offs -- the only output changes outside the attack cases: * text this distribution did not author is no longer used as a lexicon key, so a custom type constraint's own message is shown as the type gave it rather than translated. For a deployment using the default _AUTO lexicon this changes nothing, since an _AUTO lookup returns the phrase itself; it matters only where an application has such a message as a real lexicon entry. If you would rather keep that lookup, _needs_inert_format can return false for text containing none of "~", "[" or "]" -- that is the complete set of characters Locale::Maketext's compiler treats specially, so such text cannot form a group and is safe as a format. The comment above the sub says so, and the corresponding assertion in the new test would need inverting. Both variants were measured; this one is the default here because it is the simpler rule and because of the memoisation above. * a custom type constraint whose own message block uses bracket notation (message { 'Try [quant,1,thing]' }) now renders that literally. Such a block receives the rejected value and can interpolate it, so treating it as data is the safe default; a maintainer who would rather keep those compiled can exempt the has_message branch specifically. * an application calling the undocumented arrayref spelling with a template that uses bracket notation, add_error([ 'Try [quant,_1,thing]', 3 ]), now renders it literally; the list spelling of the same call still compiles. FormHandler's own message templates, and application templates passed to add_error together with their arguments, are unaffected. One case cannot be fixed in this distribution: an application that concatenates the value into its own message, `add_error("The value '" . $field->value . "' is not allowed")`, is indistinguishable from a legitimate template. The add_error POD now documents the hazard and shows the inert-argument idiom against it. The new test, t/errors/maketext_inert_argument.t, uses only Test::More and Test::Exception, both already in TEST_REQUIRES. Its first assertions fail without this patch -- the payload is dispatched rather than shown, or processing dies -- and the rest pin behaviour the fix must not break: built-in messages, bracket notation in application templates, and a bracket-free warning still used as the message. Those pass either way, by design. The sprintf assertion deliberately uses a 20-character width rather than a large one: it detects that dispatch happened, without allocating anything. Verified against the repository tree at 0.40068-28-gb032539: the suite is green before (149 files, 1494 tests) and after (150 files, 1511 tests), both touched files compile, and the new test fails on the unpatched tree and passes 17/17 on the patched one. Note for anyone reproducing that: t/fields/request_token.t needs Test::Needs, added by c49c5f6 after the tag -- without it that file dies at compile time with zero tests run, which looks like patch fallout and is not. Co-Authored-By: Claude Opus 5 (1M context) Signed-off-by: Robert Rothenberg --- lib/HTML/FormHandler/Field.pm | 38 ++++- lib/HTML/FormHandler/Validate.pm | 79 +++++++++- t/errors/maketext_inert_argument.t | 228 +++++++++++++++++++++++++++++ 3 files changed, 341 insertions(+), 4 deletions(-) create mode 100644 t/errors/maketext_inert_argument.t 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..cf5a47eb 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,7 +272,10 @@ 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 @@ -243,6 +301,7 @@ sub _apply_actions { }; if ($@) { $error_message = $@ || $self->get_message('error_occurred'); + $foreign_message = 1; } else { $self->_set_value($new_value); @@ -261,6 +320,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; From 3b00836d2a8d65672e140996eb8b29fc8b3fdb74 Mon Sep 17 00:00:00 2001 From: Robert Rothenberg Date: Mon, 17 Aug 2026 19:26:31 +0100 Subject: [PATCH 4/4] Remove comment about smart matching This was added in 2011 but smart matchting has been deprecated. --- lib/HTML/FormHandler/Validate.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/HTML/FormHandler/Validate.pm b/lib/HTML/FormHandler/Validate.pm index cf5a47eb..0666d3e2 100644 --- a/lib/HTML/FormHandler/Validate.pm +++ b/lib/HTML/FormHandler/Validate.pm @@ -277,8 +277,6 @@ sub _apply_actions { $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');