From 0d3185d28a0c30bf91a51c4c50b2a67a10f37c0d Mon Sep 17 00:00:00 2001
From: Sanjar Tulkinov Anvar o'g'li <sanjarbiy11@gmail.com>
Date: Wed, 24 Jun 2026 22:56:19 -0400
Subject: [PATCH] Bug 30233: Stop running call number split regexes as code

C4::ClassSplitRoutine::RegEx::split_callnumber ran the admin-configured rule
through eval "\$cn_item =~ $regex", executing arbitrary Perl. Parse the
rule as s<DELIM>PATTERN<DELIM>REPLACEMENT<DELIM>FLAGS, reject the /e flag,
compile the pattern with qr// and expand the replacement as data via
Koha::Regex::Replacement::expand_template, so the rule is applied without
eval.

Signed-off-by: Sanjar Tulkinov Anvar o'g'li <sanjarbiy11@gmail.com>
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>
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>
(cherry picked from commit c76e2dcc3360e2c4a7d3123f5625c3426dfe207e)
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>
---
 C4/ClassSplitRoutine/RegEx.pm | 50 ++++++++++++++++++++++++++++++++++-
 1 file changed, 49 insertions(+), 1 deletion(-)

diff --git a/C4/ClassSplitRoutine/RegEx.pm b/C4/ClassSplitRoutine/RegEx.pm
index 3a9f841876..801340a0b9 100644
--- a/C4/ClassSplitRoutine/RegEx.pm
+++ b/C4/ClassSplitRoutine/RegEx.pm
@@ -19,6 +19,8 @@ package C4::ClassSplitRoutine::RegEx;
 
 use Modern::Perl;
 
+use Koha::Regex::Replacement;
+
 =head1 NAME
 
 C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
@@ -41,13 +43,59 @@ sub split_callnumber {
     my ( $cn_item, $regexs ) = @_;
 
     for my $regex (@$regexs) {
-        eval "\$cn_item =~ $regex";    ## no critic (StringyEval)
+        _apply_substitution( \$cn_item, $regex );
     }
     my @lines = split "\n", $cn_item;
 
     return @lines;
 }
 
+=head2 _apply_substitution
+
+  _apply_substitution( \$string, $regex );
+
+Applies a single admin-configured s/// substitution to $string in place,
+without ever evaluating the input as code. The rule is parsed as
+s<DELIM>PATTERN<DELIM>REPLACEMENT<DELIM>FLAGS; the pattern is compiled with
+qr// (so embedded-code assertions are treated as a runtime pattern and blocked
+by Perl), and the replacement is expanded as data via
+Koha::Regex::Replacement::expand_template. The
+/e flag is rejected and anything that is not a plain substitution is ignored.
+This replaces the previous C<eval "\$cn_item =~ $regex"> stringy eval, which
+executed arbitrary Perl.
+
+=cut
+
+sub _apply_substitution {
+    my ( $ref, $regex ) = @_;
+
+    return unless defined $regex;
+
+    # Parse  s<DELIM>PATTERN<DELIM>REPLACEMENT<DELIM>FLAGS, allowing any
+    # non-space delimiter and backslash-escaped delimiters inside the pattern
+    # and replacement. Anything that is not a well-formed plain substitution is
+    # ignored rather than executed.
+    return unless $regex =~ m{^s(\S)((?:\\.|(?!\1).)*)\1((?:\\.|(?!\1).)*)\1([a-z]*)\z}s;
+    my ( $pattern, $replacement, $flags ) = ( $2, $3, $4 );
+
+    return if $flags =~ /e/;    # never evaluate the replacement as code
+    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}], {%+} ) };
+
+    if ($global) {
+        ${$ref} =~ s/$compiled/$expand->()/ge;
+    } else {
+        ${$ref} =~ s/$compiled/$expand->()/e;
+    }
+
+    return;
+}
+
 1;
 
 =head1 AUTHOR