From: CPANSec Security Scanner Bot <cpan-security@security.metacpan.org>
Subject: [PATCH] Data::MuForm::Localizer: guard the locale tag and parse the Plural-Forms expression

CVE-2026-13048.  load_lexicon builds the catalog path by appending
"Messages/$lang.po" to the directory holding Localizer.pm, where $lang
is the language attribute, with no check that it names a bare locale
tag, so a value holding '/' or '..' segments loads a catalog from
outside the messages directory.  While the catalog is parsed,
extract_header_msgstr prefixes '$' to the bare words nplurals, plural
and n in the Plural-Forms header and passes the rest verbatim into a
string eval, so a header of "nplurals=2; plural=(system('...'),0);" runs
that command as the catalog loads.  An application that sets the
language attribute from request data, together with any writable
location holding a file with a .po suffix, reaches code execution.

Fix: require $lang to match /\A[A-Za-z0-9_.\-]+\z/ before it is built
into a filename, returning undef otherwise, which is what a locale with
no catalog already does (the message falls back to the msgid).  Then
tokenize the Plural-Forms header, parse it against the gettext plural
grammar (gettext's plural.y: the variable n, unsigned integers, the
conditional and the C integer operators), and build the code that is
evaluated from the accepted tokens rather than from the header text.
nplurals is now taken from the header as an integer and is not evaluated
at all.

A character allowlist over the expression would not be enough: **, //,
++ and <> are Perl operators spelled with characters the gettext
operators also use, so they pass a character check while keeping their
Perl meaning in the eval, exponentiation among them.  The tokenizer
emits two tokens for each of those pairs and the parser has no
production for the result, so they are refused along with everything
else outside the grammar.

Verified against the 0.05 sources.  Twelve Plural-Forms headers,
covering the gettext plural rules from nplurals=1 through nplurals=6 and
including the header of the en.po the distribution ships, return the
same nplurals, the same plural text and the same plural_code result for
every n from 0 to 210 as they do unpatched.  Headers built around **,
//, ++, <>, a single & or |, backticks, the x operator, a bare $0,
system() and unlink() are refused before the eval, as are unbalanced
parentheses, a missing operand and an identifier other than n.  Five
locale tags (en, en_US, pt-BR, zh_Hans, en_US.UTF-8) resolve to the same
paths, and locale values holding '..', a leading '/', an embedded '/',
an embedded ';', an embedded newline, or the empty string no longer
produce a path.

diff --git a/lib/Data/MuForm/Localizer.pm b/lib/Data/MuForm/Localizer.pm
index 5be1ef6..2a34c4d 100644
--- a/lib/Data/MuForm/Localizer.pm
+++ b/lib/Data/MuForm/Localizer.pm
@@ -56,6 +56,14 @@ sub get_lexicon {
 sub load_lexicon {
   my ( $self, $lang ) = @_;
 
+  # $lang is interpolated into the catalog filename below, so it has to
+  # be a bare locale tag.  Anything else, in particular a value holding
+  # '/' or '..' segments, would load a catalog from outside the messages
+  # directory.  Returning undef here is what a locale with no catalog
+  # already does: the message falls back to the msgid.
+  return undef
+    if ! defined $lang || $lang !~ m{\A[A-Za-z0-9_.\-]+\z};
+
   my $file = $self->module_path;
   $file =~ s/Localizer.pm//;
   $file .= "Messages/$lang.po";
@@ -379,47 +387,176 @@ sub join_message_key {
 }
 
 #====== Header Extract =======
-my $perlify_plural_forms_ref__code_ref = sub {
-    my $plural_forms_ref = shift;
 
-    ${$plural_forms_ref} =~ s{ \b ( nplurals | plural | n ) \b }{\$$1}xmsg;
+# The Plural-Forms expression from the catalog reaches a string eval, so
+# it has to be checked before it is used.  A character allowlist is not
+# enough: **, //, ++ and <> are Perl operators spelled with the same
+# characters the gettext plural operators use.  The header is therefore
+# tokenized and parsed against the gettext plural grammar (gettext's
+# plural.y: the variable n, unsigned integers, the conditional and the C
+# integer operators, nothing else), and the code that is evaluated is
+# generated from the accepted tokens rather than from the header text.
+
+# Longest match first, so that <= is one token and not < followed by =.
+# A single & or |, an identifier other than n, and anything else outside
+# the grammar leave the expression untokenizable.
+my $plural_tokenize__code_ref = sub {
+    my $expression = shift;
+
+    my @tokens;
+    pos $expression = 0;
+    TOKEN:
+    while ( pos $expression < length $expression ) {
+        $expression =~ m{ \G [ \t]+ }xmsgc
+            and next TOKEN;
+        $expression =~ m{
+            \G (
+                [0-9]+ | n \b
+                | \|\| | && | == | != | <= | >=
+                | [-+*/%<>?:!()]
+            )
+        }xmsgc
+            or return;
+        push @tokens, $1;
+    }
 
-    return;
+    return \@tokens;
 };
 
-my $nplurals__code_ref = sub {
-    my $plural_forms = shift;
+# Binary operators by C precedence, lowest binding first.  The
+# conditional binds lower still and is right associative, so it is
+# parsed separately.
+my @plural_binary_operators = (
+    [ q{||} ],
+    [ q{&&} ],
+    [ q{==}, q{!=} ],
+    [ q{<}, q{>}, q{<=}, q{>=} ],
+    [ q{+}, q{-} ],
+    [ q{*}, q{/}, q{%} ],
+);
+
+my $plural_expression__code_ref;
+my $plural_binary__code_ref;
+my $plural_unary__code_ref;
+
+# Each parser returns the Perl source for what it accepted, or nothing
+# if the tokens are not that production.
+$plural_expression__code_ref = sub {
+    my ( $tokens, $index_ref ) = @_;
+
+    my $condition = $plural_binary__code_ref->( $tokens, $index_ref, 0 );
+    defined $condition
+        or return;
+    my $token = $tokens->[ ${$index_ref} ];
+    defined $token && $token eq q{?}
+        or return $condition;
+    ${$index_ref}++;
+    my $then = $plural_expression__code_ref->( $tokens, $index_ref );
+    defined $then
+        or return;
+    $token = $tokens->[ ${$index_ref} ];
+    defined $token && $token eq q{:}
+        or return;
+    ${$index_ref}++;
+    my $else = $plural_expression__code_ref->( $tokens, $index_ref );
+    defined $else
+        or return;
+
+    return "( $condition ? $then : $else )";
+};
 
-    $perlify_plural_forms_ref__code_ref->(\$plural_forms);
-    my $code = <<"EOC";
-        my \$n = 0;
-        my (\$nplurals, \$plural);
-        $plural_forms;
-        \$nplurals;
-EOC
-    my $nplurals = eval $code;
+$plural_binary__code_ref = sub {
+    my ( $tokens, $index_ref, $level ) = @_;
+
+    $level <= $#plural_binary_operators
+        or return $plural_unary__code_ref->( $tokens, $index_ref );
+    my $left = $plural_binary__code_ref->( $tokens, $index_ref, $level + 1 );
+    defined $left
+        or return;
+    OPERATOR:
+    while ( defined( my $token = $tokens->[ ${$index_ref} ] ) ) {
+        grep { $token eq $_ } @{ $plural_binary_operators[$level] }
+            or last OPERATOR;
+        ${$index_ref}++;
+        my $right = $plural_binary__code_ref->( $tokens, $index_ref, $level + 1 );
+        defined $right
+            or return;
+        $left = "( $left $token $right )";
+    }
 
-    return $nplurals;
+    return $left;
 };
 
-my $plural__code_ref = sub {
+$plural_unary__code_ref = sub {
+    my ( $tokens, $index_ref ) = @_;
+
+    my $token = $tokens->[ ${$index_ref} ];
+    defined $token
+        or return;
+    if ( $token eq q{!} ) {
+        ${$index_ref}++;
+        my $operand = $plural_unary__code_ref->( $tokens, $index_ref );
+        defined $operand
+            or return;
+        return "( ! $operand )";
+    }
+    if ( $token eq q{n} ) {
+        ${$index_ref}++;
+        return q{$n};
+    }
+    if ( $token =~ m{ \A [0-9]+ \z }xms ) {
+        ${$index_ref}++;
+        return $token;
+    }
+    if ( $token eq q{(} ) {
+        ${$index_ref}++;
+        my $inner = $plural_expression__code_ref->( $tokens, $index_ref );
+        defined $inner
+            or return;
+        $token = $tokens->[ ${$index_ref} ];
+        defined $token && $token eq q{)}
+            or return;
+        ${$index_ref}++;
+        return "( $inner )";
+    }
+
+    return;
+};
+
+# Returns the nplurals count, the plural expression as it stands in the
+# header, and the Perl source generated from it, or nothing if the
+# header is not a gettext plural header.
+my $plural_forms_parse__code_ref = sub {
     my $plural_forms = shift;
 
-    return $plural_forms =~ m{ \b plural= ( [^;\n]+ ) }xms;
+    defined $plural_forms
+        or return;
+    my ( $nplurals, $plural ) = $plural_forms =~ m{
+        \A
+        nplurals [ ]* = [ ]* ( [0-9]+ ) [ ]* ;
+        [ ]*
+        plural   [ ]* = [ ]* ( [^;\n]+? ) [ ]* ;? [ ]*
+        \z
+    }xms
+        or return;
+    my $tokens = $plural_tokenize__code_ref->($plural)
+        or return;
+    my $index = 0;
+    my $code = $plural_expression__code_ref->( $tokens, \$index );
+    defined $code && $index == @{$tokens}
+        or return;
+
+    return ( 0 + $nplurals, $plural, $code );
 };
 
 my $plural_code__code_ref = sub {
-    my $plural_forms = shift;
+    my $plural_expression = shift;
 
-    $perlify_plural_forms_ref__code_ref->(\$plural_forms);
     my $code = <<"EOC";
         sub {
             my \$n = shift;
 
-            my (\$nplurals, \$plural);
-            $plural_forms;
-
-            return 0 + \$plural;
+            return 0 + ( $plural_expression );
         }
 EOC
     my $code_ref = eval $code;
@@ -447,6 +584,10 @@ sub extract_header_msgstr {
     }xms
         or die 'Plural-Forms not found in header';
     ## use critic (ComplexRegexes)
+    my ( $nplurals, $plural, $plural_expression )
+        = $plural_forms_parse__code_ref->($plural_forms);
+    defined $plural_expression
+        or die 'Plural-Forms is not a gettext plural expression';
     my ( $charset ) = $header_msgstr =~ m{
         ^
         Content-Type:
@@ -462,9 +603,9 @@ sub extract_header_msgstr {
     }xms;
 
     return {(
-        nplurals    => $nplurals__code_ref->($plural_forms),
-        plural      => $plural__code_ref->($plural_forms),
-        plural_code => $plural_code__code_ref->($plural_forms),
+        nplurals    => $nplurals,
+        plural      => $plural,
+        plural_code => $plural_code__code_ref->($plural_expression),
         charset     => $charset,
         (
             $multiplural_nplurals
