From: CPANSec Security Scanner Bot <cpan-security@security.metacpan.org>
Subject: [PATCH] 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.

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.

--- a/lib/HTML/FormHandler/Validate.pm
+++ b/lib/HTML/FormHandler/Validate.pm
@@ -158,13 +158,40 @@
     $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 if !defined $text || ref $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;
     };
 
@@ -199,10 +226,11 @@
                 eval { $new_value = $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 {
@@ -210,7 +238,8 @@
                 }
 
             }
-            $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
@@ -235,7 +264,8 @@
                 $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);
--- a/lib/HTML/FormHandler/Field.pm
+++ b/lib/HTML/FormHandler/Field.pm
@@ -864,7 +864,21 @@
     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);
@@ -1198,6 +1212,18 @@
 
     return $field->add_error( 'bad data' ) if $bad;
 
+The first argument is the localization FORMAT, which for a
+L<Locale::Maketext> 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.
--- a/lib/HTML/FormHandler/Field/Date.pm
+++ b/lib/HTML/FormHandler/Field/Date.pm
@@ -66,7 +66,11 @@
 
     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);