gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bug 30233: (follow-up) fix some errors reported by QA tools 

Note: While the methodology in Koha::Regex::Replacement may seem
bespoke, it's similar to how Python's re.sub(pattern, repl, string)
regex substitution works.

Unit tests:
prove -v t/Koha/Regex/Replacement.t \
    t/SimpleMARC.t \
    t/db_dependent/MarcModificationTemplates.t \
    t/Labels_split_Regex.t

Signed-off-by: David Cook <dcook@prosentient.com.au>
Signed-off-by: Martin Renvoize <martin.renvoize@openfifth.co.uk>
Signed-off-by: Baptiste Wojtkowski <baptiste.wojtkowski@biblibre.com>
This commit is contained in:
David Cook 2026-06-25 13:38:11 +00:00 committed by Baptiste Wojtkowski
parent 4c7b2972e2
commit 70eb221030
No known key found for this signature in database
GPG Key ID: 47A8A13E10BC0D40
3 changed files with 21 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C4/ClassSplitRoutine/RegEx.pm
View File

@ -79,13 +79,13 @@ sub _apply_substitution {
my ( $pattern, $replacement, $flags ) = ( $2, $3, $4 );
return if $flags =~ /e/; # never evaluate the replacement as code
my $global = $flags =~ /g/ ? 1 : 0;
my $global = $flags =~ /g/ ? 1 : 0;
my $ci = $flags =~ /i/ ? '(?i)' : '';
my $compiled = eval { qr/$ci$pattern/ };
return unless defined $compiled;
my $expand = sub { Koha::Regex::Replacement::expand_template( $replacement, [@{^CAPTURE}], {%+} ) };
my $expand = sub { Koha::Regex::Replacement::expand_template( $replacement, [ @{^CAPTURE} ], {%+} ) };
if ($global) {
${$ref} =~ s/$compiled/$expand->()/ge;

21
Koha/Regex/Replacement.pm
View File

@ -40,6 +40,16 @@ fields and call numbers. The replacement half of those substitutions used to be
run through Perl's C<s///ee>, which evaluated the replacement as Perl code and
so allowed arbitrary code execution (see bug 30233).
Note: It was necessary to use C<s///ee> because Perl does not provide a native
way of processing backreferences and backslash escapes in the replacement string
at runtime. While this doesn't matter when running hard-coded regular expressions,
it does make it difficult to support replacement strings provided by end users.
Note: While the "expand_template" may seem bespoke, it works similarly to
how Python's own template expansion works in Python's re.sub() regular
expression substitution function:
https://github.com/python/cpython/blob/3.15/Modules/_sre/sre.c#L3022
This module expands the replacement string as B<data> instead of evaluating it.
It walks the string once, from left to right, and only acts on the handful of
placeholders a replacement legitimately contains:
@ -98,14 +108,13 @@ sub expand_template {
if ( $character eq '\\' && $position + 1 < @characters ) {
my $escaped = $characters[ $position + 1 ];
if ( $escaped eq 'n' ) { $output .= "\n"; }
elsif ( $escaped eq 'r' ) { $output .= "\r"; }
elsif ( $escaped eq 't' ) { $output .= "\t"; }
elsif ( $escaped =~ /[1-9]/ ) { # legacy \1 .. \9 backreference
if ( $escaped eq 'n' ) { $output .= "\n"; }
elsif ( $escaped eq 'r' ) { $output .= "\r"; }
elsif ( $escaped eq 't' ) { $output .= "\t"; }
elsif ( $escaped =~ /[1-9]/ ) { # legacy \1 .. \9 backreference
my $group_value = $captures->[ $escaped - 1 ];
$output .= defined $group_value ? $group_value : '';
}
else { # \\ -> \, \$ -> $, any other \X -> X
} else { # \\ -> \, \$ -> $, any other \X -> X
$output .= $escaped;
}

8
t/Koha/Regex/Replacement.t Normal file → Executable file
View File

@ -30,7 +30,7 @@ use Koha::Regex::Replacement;
sub subst {
my ( $value, $search, $replacement, $modifiers ) = @_;
$modifiers //= '';
my $expand = sub { Koha::Regex::Replacement::expand_template( $replacement, [@{^CAPTURE}], {%+} ) };
my $expand = sub { Koha::Regex::Replacement::expand_template( $replacement, [ @{^CAPTURE} ], {%+} ) };
if ( $modifiers eq 'g' ) { $value =~ s/$search/$expand->()/ge }
elsif ( $modifiers eq 'i' ) { $value =~ s/$search/$expand->()/ie }
else { $value =~ s/$search/$expand->()/e }
@ -74,9 +74,9 @@ subtest 'legacy \1 backreferences and fixed escapes' => sub {
'the $1-$2-$3 form gives the same result'
);
is( subst( 'z', '.', 'a\nb' ), "a\nb", '\n becomes a newline' );
is( subst( 'z', '.', 'a\tb' ), "a\tb", '\t becomes a tab' );
is( subst( 'x', '(x)', '\$1' ), '$1', '\$ emits a literal dollar, not a backref' );
is( subst( 'z', '.', 'a\nb' ), "a\nb", '\n becomes a newline' );
is( subst( 'z', '.', 'a\tb' ), "a\tb", '\t becomes a tab' );
is( subst( 'x', '(x)', '\$1' ), '$1', '\$ emits a literal dollar, not a backref' );
};
subtest 'malicious replacements are inert (no code execution)' => sub {