Fix CVE-2022-4993 stop routing foreign text into the Locale::Maketext format

lib/HTML/FormHandler/Field.pm

@@ -173,6 +173,18 @@ See also L<HTML::FormHandler::TraitFor::I18N>.
 
     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.
@@ -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);

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);

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 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;
     };
 
@@ -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);