From b9e797364929f55067c3ac5ba53f797650b6bf2b Mon Sep 17 00:00:00 2001 From: David Cook Date: Thu, 25 Jun 2026 13:38:11 +0000 Subject: [PATCH] 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 Signed-off-by: Martin Renvoize Signed-off-by: Baptiste Wojtkowski Signed-off-by: Pedro Amorim --- C4/ClassSplitRoutine/RegEx.pm | 4 ++-- Koha/Regex/Replacement.pm | 21 +++++++++++++++------ t/Koha/Regex/Replacement.t | 8 ++++---- 3 files changed, 21 insertions(+), 12 deletions(-) mode change 100644 => 100755 t/Koha/Regex/Replacement.t diff --git a/C4/ClassSplitRoutine/RegEx.pm b/C4/ClassSplitRoutine/RegEx.pm index 801340a0b9..b2dfd2d385 100644 --- a/C4/ClassSplitRoutine/RegEx.pm +++ b/C4/ClassSplitRoutine/RegEx.pm @@ -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; diff --git a/Koha/Regex/Replacement.pm b/Koha/Regex/Replacement.pm index c93eb38d30..07a61b2db1 100644 --- a/Koha/Regex/Replacement.pm +++ b/Koha/Regex/Replacement.pm @@ -40,6 +40,16 @@ fields and call numbers. The replacement half of those substitutions used to be run through Perl's C, which evaluated the replacement as Perl code and so allowed arbitrary code execution (see bug 30233). +Note: It was necessary to use C 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 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; } diff --git a/t/Koha/Regex/Replacement.t b/t/Koha/Regex/Replacement.t old mode 100644 new mode 100755 index fdf75c6ba8..c873f02e4f --- a/t/Koha/Regex/Replacement.t +++ b/t/Koha/Regex/Replacement.t @@ -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 {