File CVE-Level-issue-with-Rule-Files.patch of Package spamassassin

Overview Repositories Revisions Requests Users Attributes Meta

File CVE-Level-issue-with-Rule-Files.patch of Package spamassassin (Revision c7b73556a0153bcce4a627d6612a6a0c)

Currently displaying revision c7b73556a0153bcce4a627d6612a6a0c , Show latest

--- lib/Mail/SpamAssassin/Conf/Parser.pm.orig	2018-09-14 03:27:51.000000000 +0200
+++ lib/Mail/SpamAssassin/Conf/Parser.pm	2019-07-24 12:02:54.973712418 +0200
@@ -137,7 +137,7 @@
 use Mail::SpamAssassin::Conf;
 use Mail::SpamAssassin::Constants qw(:sa);
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var compile_regexp);
 use Mail::SpamAssassin::NetSet;
 
 use strict;
@@ -147,6 +147,9 @@
 
 our @ISA = qw();
 
+my $RULENAME_RE = RULENAME_RE;
+my $ARITH_EXPRESSION_LEXER = ARITH_EXPRESSION_LEXER;
+
 ###########################################################################
 
 sub new {
@@ -508,13 +511,12 @@
   my ($self, $key, $value, $if_stack_ref, $skip_parsing_ref) = @_;
   my $conf = $self->{conf};
 
-  my $lexer = ARITH_EXPRESSION_LEXER;
-  my @tokens = ($value =~ m/($lexer)/og);
+  my @tokens = ($value =~ /($ARITH_EXPRESSION_LEXER)/og);
 
   my $eval = '';
   my $bad = 0;
   foreach my $token (@tokens) {
-    if ($token =~ /^(?:\W+|[+-]?\d+(?:\.\d+)?)$/) {
+    if ($token =~ /^(?:\W{1,5}|[+-]?\d+(?:\.\d+)?)$/) {
       # using tainted subr. argument may taint the whole expression, avoid
       my $u = untaint_var($token);
       $eval .= $u . " ";
@@ -538,17 +540,25 @@
       $eval .= $]." ";
     }
     elsif ($token =~ /^\w[\w\:]+$/) { # class name
-      my $u = untaint_var($token);
-      $eval .= '"' . $u . '" ';
+      # Strictly controlled form:
+      if ($token =~ /^(?:\w+::){0,10}\w+$/) {
+        my $u = untaint_var($token);
+        $eval .= "'$u'";
+      } else {
+        warn "config: illegal name '$token' in 'if $value'\n";
+        $bad++;
+        last;
+      }
     }
     else {
       $bad++;
       warn "config: unparseable chars in 'if $value': '$token'\n";
+      last;
     }
   }
 
   if ($bad) {
-    $self->lint_warn("bad 'if' line, in \"$self->{currentfile}\"", undef);
+    $self->lint_warn("config: bad 'if' line, in \"$self->{currentfile}\"", undef);
     return -1;
   }
 
@@ -574,7 +584,7 @@
 
 sub cond_clause_can {
   my ($self, $method) = @_;
-  if ($self->{currentfile} =~ q!/user_prefs$! ) {
+  if ($self->{currentfile} =~ q!\buser_prefs$! ) {
     warn "config: 'if can $method' not available in user_prefs";
     return 0
   }
@@ -591,7 +601,7 @@
 
   local($1,$2);
   if (!defined $method) {
-    $self->lint_warn("bad 'if' line, no argument to $fn_name(), ".
+    $self->lint_warn("config: bad 'if' line, no argument to $fn_name(), ".
                      "in \"$self->{currentfile}\"", undef);
   } elsif ($method =~ /^(.*)::([^:]+)$/) {
     no strict "refs";
@@ -599,7 +609,7 @@
     return 1  if $module->can($meth) &&
                  ( $fn_name eq 'has' || &{$method}() );
   } else {
-    $self->lint_warn("bad 'if' line, cannot find '::' in $fn_name($method), ".
+    $self->lint_warn("config: bad 'if' line, cannot find '::' in $fn_name($method), ".
                      "in \"$self->{currentfile}\"", undef);
   }
   return;
@@ -878,39 +888,40 @@
 
     # eval type handling
     if (($type & 1) == 1) {
-      if (my ($function, $args) = ($text =~ m/(.*?)\s*$(.*?)$\s*$/)) {
-        my ($packed, $argsref) =
-                $self->pack_eval_method($function, $args, $name, $text);
-
-        if (!$packed) {
-          # we've already warned about this
+      if (my ($function, $args) = ($text =~ /^(\w+)$(.*?)$$/)) {
+        my $argsref = $self->pack_eval_args($args);
+        if (!defined $argsref) {
+          $self->lint_warn("syntax error for eval function $name: $text");
+          next;
         }
         elsif ($type == $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS) {
-          $conf->{body_evals}->{$priority}->{$name} = $packed;
+          $conf->{body_evals}->{$priority}->{$name} = [ $function, [@$argsref] ];
         }
         elsif ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS) {
-          $conf->{head_evals}->{$priority}->{$name} = $packed;
+          $conf->{head_evals}->{$priority}->{$name} = [ $function, [@$argsref] ];
         }
         elsif ($type == $Mail::SpamAssassin::Conf::TYPE_RBL_EVALS) {
           # We don't do priorities for $Mail::SpamAssassin::Conf::TYPE_RBL_EVALS
           # we also use the arrayref instead of the packed string
-          $conf->{rbl_evals}->{$name} = [ $function, @$argsref ];
+          $conf->{rbl_evals}->{$name} = [ $function, [@$argsref] ];
         }
         elsif ($type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_EVALS) {
-          $conf->{rawbody_evals}->{$priority}->{$name} = $packed;
+          $conf->{rawbody_evals}->{$priority}->{$name} = [ $function, [@$argsref] ];
         }
         elsif ($type == $Mail::SpamAssassin::Conf::TYPE_FULL_EVALS) {
-          $conf->{full_evals}->{$priority}->{$name} = $packed;
+          $conf->{full_evals}->{$priority}->{$name} = [ $function, [@$argsref] ];
         }
         #elsif ($type == $Mail::SpamAssassin::Conf::TYPE_URI_EVALS) {
-        #  $conf->{uri_evals}->{$priority}->{$name} = $packed;
+        #  $conf->{uri_evals}->{$priority}->{$name} = [ $function, [@$argsref] ];
         #}
         else {
           $self->lint_warn("unknown type $type for $name: $text", $name);
+          next;
         }
       }
       else {
         $self->lint_warn("syntax error for eval function $name: $text", $name);
+        next;
       }
     }
     # non-eval tests
@@ -937,6 +948,7 @@
       }
       else {
         $self->lint_warn("unknown type $type for $name: $text", $name);
+        next;
       }
     }
   }
@@ -988,8 +1000,7 @@
   return unless $rule;
 
   # Lex the rule into tokens using a rather simple RE method ...
-  my $lexer = ARITH_EXPRESSION_LEXER;
-  my @tokens = ($rule =~ m/$lexer/og);
+  my @tokens = ($rule =~ /($ARITH_EXPRESSION_LEXER)/og);
 
   # Go through each token in the meta rule
   my $conf_tests = $conf->{tests};
@@ -1088,40 +1099,36 @@
   }
 }
 
+# Deprecated function
 sub pack_eval_method {
-  my ($self, $function, $args, $name, $text) = @_;
+  warn "deprecated function pack_eval_method() used\n";
+  return ('',undef);
+}
 
+sub pack_eval_args {
+  my ($self, $args) = @_;
+
+  return [] if $args =~ /^\s+$/;
+
+  # bug 4419: Parse quoted strings, unquoted alphanumerics/floats,
+  # unquoted IPv4 and IPv6 addresses, and unquoted common domain names.
+  # s// is used so that we can determine whether or not we successfully
+  # parsed ALL arguments.
   my @args;
-  if (defined $args) {
-    # bug 4419: Parse quoted strings, unquoted alphanumerics/floats,
-    # unquoted IPv4 and IPv6 addresses, and unquoted common domain names.
-    # s// is used so that we can determine whether or not we successfully
-    # parsed ALL arguments.
-    local($1,$2,$3);
-    while ($args =~ s/^\s* (?: (['"]) (.*?) \1 | ( [\d\.:A-Za-z-]+? ) )
-                       \s* (?: , \s* | $ )//x) {
-      if (defined $2) {
-        push @args, $2;
-      }
-      else {
-        push @args, $3;
-      }
-    }
+  local($1,$2,$3);
+  while ($args =~ s/^\s* (?: (['"]) (.*?) \1 | ( [\d\.:A-Za-z-]+? ) )
+                     \s* (?: , \s* | $ )//x) {
+    # DO NOT UNTAINT THESE ARGS
+    # The eval function that handles these should do that as necessary,
+    # we have no idea what acceptable arguments look like here.
+    push @args, defined $2 ? $2 : $3;
   }
 
   if ($args ne '') {
-    $self->lint_warn("syntax error (unparsable argument: $args) for eval function: $name: $text", $name);
-    return;
+    return undef;
   }
 
-  my $argstr = $function;
-  $argstr =~ s/\s+//gs;
-
-  if (@args > 0) {
-    $argstr .= ',' . join(', ',
-              map { my $s = $_; $s =~ s/\#/[HASH]/gs; 'q#' . $s . '#' } @args);
-  }
-  return ($argstr, \@args);
+  return \@args;
 }
 
 ###########################################################################
@@ -1183,7 +1190,7 @@
   my $conf = $self->{conf};
 
   # Don't allow invalid names ...
-  if ($name !~ /^[_[:alpha:]]\w*$/) {
+  if ($name !~ /^${RULENAME_RE}$/) {
     $self->lint_warn("config: error: rule '$name' has invalid characters ".
 	   "(not Alphanumeric + Underscore + starting with a non-digit)\n", $name);
     return;
@@ -1206,29 +1213,68 @@
     }
   }
 
+  # parameter to compile_regexp()
+  my $ignore_amre =
+    $self->{conf}->{lint_rules} ||
+    $self->{conf}->{ignore_always_matching_regexps};
+
   # all of these rule types are regexps
   if ($type == $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS ||
       $type == $Mail::SpamAssassin::Conf::TYPE_FULL_TESTS ||
       $type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS ||
       $type == $Mail::SpamAssassin::Conf::TYPE_URI_TESTS)
   {
-    return unless $self->is_delimited_regexp_valid($name, $text);
+    my ($rec, $err) = compile_regexp($text, 1, $ignore_amre);
+    if (!$rec) {
+      $self->lint_warn("config: invalid regexp for $name '$text': $err", $name);
+      return;
+    }
+    $conf->{test_qrs}->{$name} = $rec;
   }
-  if ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS)
+  elsif ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS)
   {
+    local($1,$2,$3);
     # RFC 5322 section 3.6.8, ftext printable US-ASCII chars not including ":"
     # no re "strict";  # since perl 5.21.8: Ranges of ASCII printables...
-    if ($text =~ /^!?defined$[!-9;-\176]+$$/) {
-      # fine, implements 'exists:'
+    if ($text =~ /^exists:(.*)/) {
+      my $hdr = $1;
+      # never evaled, so can be quite generous with the name
+      # check :addr etc header options
+      if ($hdr !~ /^[^:\s]+:?$/) {
+        $self->lint_warn("config: invalid head test $name header: $hdr");
+        return;
+      }
+      $hdr =~ s/:$//;
+      $conf->{test_opt_header}->{$name} = $hdr;
+      $conf->{test_opt_exists}->{$name} = 1;
     } else {
-      my ($pat) = ($text =~ /^\s*\S+\s*(?:\=|\!)\~\s*(\S.*?\S)\s*$/);
-      if ($pat) { $pat =~ s/\s+\[if-unset:\s+(.+)\]\s*$//; }
-      return unless $self->is_delimited_regexp_valid($name, $pat);
+      if ($text !~ /^([^:\s]+(?:\:|(?:\:[a-z]+){1,2})?)\s*([=!]~)\s*(.+)$/) {
+        $self->lint_warn("config: invalid head test $name: $text");
+        return;
+      }
+      my ($hdr, $op, $pat) = ($1, $2, $3);
+      $hdr =~ s/:$//;
+      if ($pat =~ s/\s+\[if-unset:\s+(.+)\]$//) {
+        $conf->{test_opt_unset}->{$name} = $1;
+      }
+      my ($rec, $err) = compile_regexp($pat, 1, $ignore_amre);
+      if (!$rec) {
+        $self->lint_warn("config: invalid regexp for $name '$pat': $err", $name);
+        return;
+      }
+      $conf->{test_qrs}->{$name} = $rec;
+      $conf->{test_opt_header}->{$name} = $hdr;
+      $conf->{test_opt_neg}->{$name} = 1 if $op eq '!~';
     }
   }
   elsif ($type == $Mail::SpamAssassin::Conf::TYPE_META_TESTS)
   {
-    return unless $self->is_meta_valid($name, $text);
+    if ($self->is_meta_valid($name, $text)) {
+      # Untaint now once and not repeatedly later
+      $text = untaint_var($text);
+    } else {
+      return;
+    }
   }
 
   $conf->{tests}->{$name} = $text;
@@ -1293,38 +1339,33 @@
 
   # $meta is a degenerate translation of the rule, replacing all variables (i.e. rule names) with 0. 
   my $meta = '';
-  $rule = untaint_var($rule);  # must be careful below
-  # Bug #7557 code injection
-  if ( $rule =~ /\S(::|->)\S/ )  {
-    warn("is_meta_valid: Bogus rule $name: $rule") ;
+  # Paranoid check (Bug #7557)
+  if ($rule =~ /(?:\:\:|->)/)  {
+    warn("config: invalid meta $name rule: $rule") ;
     return 0;
   }
 
   # Lex the rule into tokens using a rather simple RE method ...
-  my $lexer = ARITH_EXPRESSION_LEXER;
-  my @tokens = ($rule =~ m/$lexer/og);
-  if (length($name) == 1) {
-    for (@tokens) {
-      print "$name $_\n "  or die "Error writing token: $!";
-    }
-  }
+  my @tokens = ($rule =~ /($ARITH_EXPRESSION_LEXER)/og);
+
   # Go through each token in the meta rule
   foreach my $token (@tokens) {
     # If the token is a syntactically legal rule name, make it zero
-    if ($token =~ /^[_[:alpha:]]\w+\z/s) {
+    if ($token =~ /^${RULENAME_RE}\z/s) {
       $meta .= "0 ";
     }
     # if it is a number or a string of 1 or 2 punctuation characters (i.e. operators) tack it onto the degenerate rule
-    elsif ( $token =~ /^(\d+|[[:punct:]]{1,2})\z/s ) {
+    elsif ($token =~ /^(\d+(?:\.\d+)?|[[:punct:]]{1,2})\z/s) {
       $meta .= "$token ";
     }
-    # WTF is it? Just warn, for now. Bug #7557
+    # Skip anything unknown (Bug #7557)
     else {
-      $self->lint_warn("config: Strange rule token: $token", $name);
-      $meta .= "$token ";
+      $self->lint_warn("config: invalid meta $name token: $token", $name);
+      return 0;    
     }
   }
-  my $evalstr = 'my $x = ' . $meta . '; 1;';
+  $meta = untaint_var($meta); # was carefully checked
+  my $evalstr = 'my $x = '.$meta.'; 1;';
   if (eval $evalstr) {
     return 1;
   }
@@ -1335,94 +1376,21 @@
   return 0;
 }
 
+# Deprecated functions, leave just in case..
 sub is_delimited_regexp_valid {
-  my ($self, $name, $re) = @_;
-
-  if (!$re || $re !~ /^\s*m?(\W).*(?:\1|>|}|\)|\])[a-z]*\s*$/) {
-    $re ||= '';
-    $self->lint_warn("config: invalid regexp for rule $name: $re: missing or invalid delimiters\n", $name);
-    return 0;
-  }
-  return $self->is_regexp_valid($name, $re);
+  my ($self, $rule, $re) = @_;
+  warn "deprecated is_delimited_regexp_valid() called, use compile_regexp()\n";
+  my ($rec, $err) = compile_regexp($re, 1, 1);
+  return $rec;
 }
-
 sub is_regexp_valid {
-  my ($self, $name, $re) = @_;
-
-  # OK, try to remove any normal perl-style regexp delimiters at
-  # the start and end, and modifiers at the end if present,
-  # so we can validate those too.
-  my $origre = $re;
-  my $safere = $re;
-  my $mods = '';
-  local ($1,$2);
-  if ($re =~ s/^m\{//) {
-    $re =~ s/\}([a-z]*)\z//; $mods = $1;
-  }
-  elsif ($re =~ s/^m$//) {
-    $re =~ s/$([a-z]*)\z//; $mods = $1;
-  }
-  elsif ($re =~ s/^m<//) {
-    $re =~ s/>([a-z]*)\z//; $mods = $1;
-  }
-  elsif ($re =~ s/^m(\W)//) {
-    $re =~ s/\Q$1\E([a-z]*)\z//; $mods = $1;
-  }
-  elsif ($re =~ s{^/(.*)/([a-z]*)\z}{$1}) {
-    $mods = $2;
-  }
-  else {
-    $safere = "m#".$re."#";
-  }
-
-  if ($self->{conf}->{lint_rules} ||
-      $self->{conf}->{ignore_always_matching_regexps})
-  {
-    my $msg = $self->is_always_matching_regexp($name, $re);
-
-    if (defined $msg) {
-      if ($self->{conf}->{lint_rules}) {
-        $self->lint_warn($msg, $name);
-      } else {
-        warn $msg;
-        return 0;
-      }
-    }
-  }
-
-  # now prepend the modifiers, in order to check if they're valid
-  if ($mods) {
-    $re = "(?" . $mods . ")" . $re;
-  }
-
-  # note: this MUST use m/...${re}.../ in some form or another, ie.
-  # interpolation of the $re variable into a code regexp, in order to test the
-  # security of the regexp.  simply using ("" =~ $re) will NOT do that, and
-  # will therefore open a hole!
-  { # no re "strict";  # since perl 5.21.8: Ranges of ASCII printables...
-    if (eval { ("" =~ m{$re}); 1; }) { return 1 }
-  }
-  my $err = $@ ne '' ? $@ : "errno=$!";  chomp $err;
-  $err =~ s/ at .*? line \d.*$//;
-  $self->lint_warn("config: invalid regexp for rule $name: $origre: $err\n", $name);
-  return 0;
+  my ($self, $rule, $re) = @_;
+  warn "deprecated is_regexp_valid() called, use compile_regexp()\n";
+  my ($rec, $err) = compile_regexp($re, 1, 1);
+  return $rec;
 }
-
-# check the pattern for some basic errors, and warn if found
 sub is_always_matching_regexp {
-  my ($self, $name, $re) = @_;
-
-  if ($re =~ /(?<!\\)\|\|/) {
-    return "config: regexp for rule $name always matches due to '||'";
-  }
-  elsif ($re =~ /^\|/) {
-    return "config: regexp for rule $name always matches due to " .
-      "pattern starting with '|'";
-  }
-  elsif ($re =~ /\|(?<!\\\|)$/) {
-    return "config: regexp for rule $name always matches due to " .
-      "pattern ending with '|'";
-  }
+  warn "deprecated is_always_matching_regexp() called\n";
   return;
 }
 
--- lib/Mail/SpamAssassin/Conf.pm.orig	2018-09-14 03:27:51.000000000 +0200
+++ lib/Mail/SpamAssassin/Conf.pm	2019-07-24 12:05:22.899738355 +0200
@@ -82,13 +82,12 @@
 # use bytes;
 use re 'taint';
 
-use Mail::SpamAssassin::Util;
 use Mail::SpamAssassin::NetSet;
 use Mail::SpamAssassin::Constants qw(:sa :ip);
 use Mail::SpamAssassin::Conf::Parser;
 use Mail::SpamAssassin::Logger;
 use Mail::SpamAssassin::Util::TieOneStringHash;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var compile_regexp);
 use File::Spec;
 
 our @ISA = qw();
@@ -2734,24 +2733,23 @@
   push (@cmds, {
     setting => 'redirector_pattern',
     is_priv => 1,
+    default => [],
+    type => $CONF_TYPE_STRINGLIST,
     code => sub {
       my ($self, $key, $value, $line) = @_;
+
+      $value =~ s/^\s+//;
       if ($value eq '') {
 	return $MISSING_REQUIRED_VALUE;
       }
-      elsif (!$self->{parser}->is_delimited_regexp_valid("redirector_pattern", $value)) {
+
+      my ($rec, $err) = compile_regexp($value, 1);
+      if (!$rec) {
+        dbg("config: invalid redirector_pattern '$value': $err");
 	return $INVALID_VALUE;
       }
 
-      # convert to qr// while including modifiers
-      local ($1,$2,$3);
-      $value =~ /^m?(\W)(.*)(?:\1|>|}|\)|\])(.*?)$/;
-      my $pattern = $2;
-      $pattern = "(?".$3.")".$pattern if $3;
-      $pattern = qr/$pattern/;
-
-      push @{$self->{main}->{conf}->{redirector_patterns}}, $pattern;
-      # dbg("config: adding redirector regex: " . $value);
+      push @{$self->{main}->{conf}->{redirector_patterns}}, $rec;
     }
   });
 
@@ -2983,11 +2981,9 @@
 Create a sub-test for 'set'.  If you want to look up a multi-meaning zone
 like relays.osirusoft.com, you can then query the results from that zone
 using the zone ID from the original query.  The sub-test may either be an
-IPv4 dotted address for RBLs that return multiple A records or a
+IPv4 dotted address for RBLs that return multiple A records, or a
 non-negative decimal number to specify a bitmask for RBLs that return a
-single A record containing a bitmask of results, a SenderBase test
-beginning with "sb:", or (if none of the preceding options seem to fit) a
-regular expression.
+single A record containing a bitmask of results, or a regular expression.
 
 Note: the set name must be exactly the same for as the main query rule,
 including selections like '-notfirsthop' appearing at the end of the set
@@ -3001,11 +2997,17 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+(?:rbl)?eval:(.*)$/) {
-        my ($rulename, $fn) = ($1, $2);
-        dbg("config: header eval rule name is $rulename function is $fn");
-        if ($fn !~ /^\w+($.*$)?$/) {
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
+        return $MISSING_REQUIRED_VALUE;
+      }
+      if ($value =~ /^(?:rbl)?eval:(.*)$/) {
+        my $fn = $1;
+        if ($fn !~ /^\w+$.*$$/) {
           return $INVALID_VALUE;
         }
         if ($fn =~ /^check_(?:rbl|dns)/) {
@@ -3015,25 +3017,9 @@
           $self->{parser}->add_test ($rulename, $fn, $TYPE_HEAD_EVALS);
         }
       }
-      elsif ($value =~ /^(\S+)\s+exists:(.*)$/) {
-        my ($rulename, $header_name) = ($1, $2);
-        # RFC 5322 section 3.6.8, ftext printable US-ASCII ch not including ":"
-        if ($header_name !~ /\S/) {
-	  return $MISSING_REQUIRED_VALUE;
-      # } elsif ($header_name !~ /^([!-9;-\176]+)$/) {
-        } elsif ($header_name !~ /^([^: \t]+)$/) {  # be generous
-          return $INVALID_HEADER_FIELD_NAME;
-        }
-        $self->{parser}->add_test ($rulename, "defined($header_name)",
-                                   $TYPE_HEAD_TESTS);
-        $self->{descriptions}->{$rulename} = "Found a $header_name header";
-      }
       else {
-	my @values = split(/\s+/, $value, 2);
-	if (@values != 2) {
-	  return $MISSING_REQUIRED_VALUE;
-	}
-        $self->{parser}->add_test (@values, $TYPE_HEAD_TESTS);
+        # Detailed parsing in add_test
+        $self->{parser}->add_test ($rulename, $value, $TYPE_HEAD_TESTS);
       }
     }
   });
@@ -3063,22 +3049,22 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+eval:(.*)$/) {
-        my ($rulename, $fn) = ($1, $2);
-        dbg("config: body eval rule name is $rulename function is $fn");
-
-        if ($fn !~ /^\w+($.*$)?$/) {
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
+        return $MISSING_REQUIRED_VALUE;
+      }
+      if ($value =~ /^eval:(.*)$/) {
+        my $fn = $1;
+        if ($fn !~ /^\w+$.*$$/) {
           return $INVALID_VALUE;
         }
         $self->{parser}->add_test ($rulename, $fn, $TYPE_BODY_EVALS);
-      }
-      else {
-	my @values = split(/\s+/, $value, 2);
-	if (@values != 2) {
-	  return $MISSING_REQUIRED_VALUE;
-	}
-        $self->{parser}->add_test (@values, $TYPE_BODY_TESTS);
+      } else {
+        $self->{parser}->add_test ($rulename, $value, $TYPE_BODY_TESTS);
       }
     }
   });
@@ -3107,11 +3093,15 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      my @values = split(/\s+/, $value, 2);
-      if (@values != 2) {
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
         return $MISSING_REQUIRED_VALUE;
       }
-      $self->{parser}->add_test (@values, $TYPE_URI_TESTS);
+      $self->{parser}->add_test ($rulename, $value, $TYPE_URI_TESTS);
     }
   });
 
@@ -3138,15 +3128,22 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+eval:(.*)$/) {
-        $self->{parser}->add_test ($1, $2, $TYPE_RAWBODY_EVALS);
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
+        return $MISSING_REQUIRED_VALUE;
+      }
+      if ($value =~ /^eval:(.*)$/) {
+        my $fn = $1;
+        if ($fn !~ /^\w+$.*$$/) {
+          return $INVALID_VALUE;
+        }
+        $self->{parser}->add_test ($rulename, $fn, $TYPE_RAWBODY_EVALS);
       } else {
-	my @values = split(/\s+/, $value, 2);
-	if (@values != 2) {
-	  return $MISSING_REQUIRED_VALUE;
-	}
-        $self->{parser}->add_test (@values, $TYPE_RAWBODY_TESTS);
+        $self->{parser}->add_test ($rulename, $value, $TYPE_RAWBODY_TESTS);
       }
     }
   });
@@ -3172,15 +3169,22 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+eval:(.*)$/) {
-        $self->{parser}->add_test ($1, $2, $TYPE_FULL_EVALS);
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
+        return $MISSING_REQUIRED_VALUE;
+      }
+      if ($value =~ /^eval:(.*)$/) {
+        my $fn = $1;
+        if ($fn !~ /^\w+$.*$$/) {
+          return $INVALID_VALUE;
+        }
+        $self->{parser}->add_test ($rulename, $fn, $TYPE_FULL_EVALS);
       } else {
-	my @values = split(/\s+/, $value, 2);
-	if (@values != 2) {
-	  return $MISSING_REQUIRED_VALUE;
-	}
-        $self->{parser}->add_test (@values, $TYPE_FULL_TESTS);
+        $self->{parser}->add_test ($rulename, $value, $TYPE_FULL_TESTS);
       }
     }
   });
@@ -3225,15 +3229,19 @@
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      my @values = split(/\s+/, $value, 2);
-      if (@values != 2) {
+      local($1);
+      if ($value !~ s/^(\S+)\s+//) {
+        return $INVALID_VALUE;
+      }
+      my $rulename = $1;
+      if ($value eq '') {
         return $MISSING_REQUIRED_VALUE;
       }
-      if ($values[1] =~ /\*\s*\*/) {
+      if ($value =~ /\*\s*\*/) {
 	info("config: found invalid '**' or '* *' operator in meta command");
         return $INVALID_VALUE;
       }
-      $self->{parser}->add_test (@values, $TYPE_META_TESTS);
+      $self->{parser}->add_test ($rulename, $value, $TYPE_META_TESTS);
     }
   });
 
@@ -4171,12 +4179,15 @@
     type => $CONF_TYPE_BOOL,
   });
 
-=item loadplugin PluginModuleName [/path/module.pm]
+=item loadplugin [Mail::SpamAssassin::Plugin::]ModuleName [/path/module.pm]
 
-Load a SpamAssassin plugin module.  The C<PluginModuleName> is the perl module
+Load a SpamAssassin plugin module.  The C<ModuleName> is the perl module
 name, used to create the plugin object itself.
 
-C</path/to/module.pm> is the file to load, containing the module's perl code;
+Module naming is strict, name must only contain alphanumeric characters or
+underscores.  File must have .pm extension.
+
+C</path/module.pm> is the file to load, containing the module's perl code;
 if it's specified as a relative path, it's considered to be relative to the
 current configuration file.  If it is omitted, the module will be loaded
 using perl's search path (the C<@INC> array).
@@ -4195,20 +4206,16 @@
       }
       my ($package, $path);
       local ($1,$2);
-      if ($value =~ /^(\S+)\s+(\S+)$/) {
+      if ($value =~ /^((?:\w+::){0,10}\w+)(?:\s+(\S+\.pm))?$/i) {
         ($package, $path) = ($1, $2);
-      } elsif ($value =~ /^\S+$/) {
-        ($package, $path) = ($value, undef);
       } else {
 	return $INVALID_VALUE;
       }
-      # is blindly untainting safe?  it is no worse than before
-      $_ = untaint_var($_)  for ($package,$path);
       $self->load_plugin ($package, $path);
     }
   });
 
-=item tryplugin PluginModuleName [/path/module.pm]
+=item tryplugin ModuleName [/path/module.pm]
 
 Same as C<loadplugin>, but silently ignored if the .pm file cannot be found in
 the filesystem.
@@ -4225,15 +4232,11 @@
       }
       my ($package, $path);
       local ($1,$2);
-      if ($value =~ /^(\S+)\s+(\S+)$/) {
+      if ($value =~ /^((?:\w+::){0,10}\w+)(?:\s+(\S+\.pm))?$/i) {
         ($package, $path) = ($1, $2);
-      } elsif ($value =~ /^\S+$/) {
-        ($package, $path) = ($value, undef);
       } else {
 	return $INVALID_VALUE;
       }
-      # is blindly untainting safe?  it is no worse than before
-      $_ = untaint_var($_)  for ($package,$path);
       $self->load_plugin ($package, $path, 1);
     }
   });
@@ -5011,12 +5014,7 @@
 
 sub load_plugin {
   my ($self, $package, $path, $silent) = @_;
-  if ($path) {
-    $path = $self->{parser}->fix_path_relative_to_current_file($path);
-  }
-  # it wouldn't hurt to do some checking on validity of $package
-  # and $path before untainting them
-  $self->{main}->{plugins}->load_plugin(untaint_var($package), $path, $silent);
+  $self->{main}->{plugins}->load_plugin($package, $path, $silent);
 }
 
 sub load_plugin_succeeded {
@@ -5197,6 +5195,7 @@
 sub feature_edns { 1 }  # supports 'dns_options edns' config option
 sub feature_dns_query_restriction { 1 }  # supported config option
 sub feature_registryboundaries { 1 } # replaces deprecated registrarboundaries
+sub feature_compile_regexp { 1 } # Util::compile_regexp
 sub perl_min_version_5010000 { return $] >= 5.010000 }  # perl version check ("perl_version" not neatly backwards-compatible)
 
 ###########################################################################
--- lib/Mail/SpamAssassin/Constants.pm.orig	2019-07-24 12:19:20.602810193 +0200
+++ lib/Mail/SpamAssassin/Constants.pm	2019-07-24 12:25:19.303749044 +0200
@@ -32,7 +32,7 @@
 
 # NOTE: Unless you need these to be available at BEGIN time, you're better with this out of a BEGIN block with a simple our statement.
 BEGIN { 
-    @IP_VARS = qw(
+  @IP_VARS = qw(
 	IP_IN_RESERVED_RANGE IP_PRIVATE LOCALHOST IPV4_ADDRESS IP_ADDRESS
   );
   @BAYES_VARS = qw(
@@ -43,7 +43,7 @@
 	HARVEST_DNSBL_PRIORITY MBX_SEPARATOR
 	MAX_BODY_LINE_LENGTH MAX_HEADER_KEY_LENGTH MAX_HEADER_VALUE_LENGTH
 	MAX_HEADER_LENGTH ARITH_EXPRESSION_LEXER AI_TIME_UNKNOWN
-	CHARSETS_LIKELY_TO_FP_AS_CAPS MAX_URI_LENGTH
+	CHARSETS_LIKELY_TO_FP_AS_CAPS MAX_URI_LENGTH RULENAME_RE
   );
 
   %EXPORT_TAGS = (
@@ -402,4 +402,7 @@
 	  koi|jp|jis|euc|gb|big5|isoir|cp1251|windows-1251|georgianps|pt154|tis
 	)[-_a-z0-9]*}ix;
 
+# Allowed rulename format
+use constant RULENAME_RE => qr([_a-zA-Z][_a-zA-Z0-9]{0,127});
+
 1;
--- lib/Mail/SpamAssassin/Dns.pm        (revision 1848547)
+++ lib/Mail/SpamAssassin/Dns.pm        (working copy)
@@ -139,6 +139,12 @@ 
 # TODO: these are constant so they should only be added once at startup
 sub register_rbl_subtest {
   my ($self, $rule, $set, $subtest) = @_;
+
+  if ($subtest =~ /^sb:/) {
+    warn("dns: ignored $rule, SenderBase rules are deprecated\n");
+    return 0;
+  }
+
   $self->{dnspost}->{$set}->{$subtest} = $rule;
 }

--- lib/Mail/SpamAssassin/Logger.pm     (revision 1848547)
+++ lib/Mail/SpamAssassin/Logger.pm     (working copy)
@@ -265,6 +265,8 @@ 
   my $name = lc($params{method});
   my $class = ucfirst($name);

+  return 0 if $class !~ /^\w+$/; # be paranoid
+
   eval 'use Mail::SpamAssassin::Logger::'.$class.'; 1'
   or do {
     my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
--- lib/Mail/SpamAssassin/PerMsgStatus.pm       (revision 1848547)
+++ lib/Mail/SpamAssassin/PerMsgStatus.pm       (working copy)
@@ -269,7 +269,6 @@ 
     'master_deadline'   => $msg->{master_deadline},  # dflt inherited from msg
     'deadline_exceeded' => 0,  # time limit exceeded, skipping further tests
   };
-  #$self->{main}->{use_rule_subs} = 1;

dbg("check: pms new, time limit in %.3f s",
       $self->{master_deadline} - time)  if $self->{master_deadline};
--- lib/Mail/SpamAssassin/Plugin/Bayes.pm       (revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/Bayes.pm       (working copy)
@@ -1645,8 +1645,14 @@ 
   my ($self) = @_;

my $store;
-  my $module = untaint_var($self->{conf}->{bayes_store_module});
-  $module = 'Mail::SpamAssassin::BayesStore::DBM'  if !$module;
+  my $module = $self->{conf}->{bayes_store_module};
+  if (!$module) {
+    $module = 'Mail::SpamAssassin::BayesStore::DBM';
+  } elsif ($module =~ /^([_A-Za-z0-9:]+)$/) {
+    $module = untaint_var($module);
+  } else {
+    die "bayes: invalid module: $module\n";
+  }

dbg("bayes: learner_new self=%s, bayes_store_module=%s", $self,$module);
   undef $self->{store};  # DESTROYs previous object, if any
--- lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm       (revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm       (working copy)
@@ -29,7 +29,7 @@

use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var qr_to_string);
 use Mail::SpamAssassin::Util::Progress;

use Errno qw(ENOENT EACCES EEXIST);
@@ -152,8 +152,12 @@ 
   foreach my $name (keys %{$rules}) {
     $self->{show_progress} and $progress and $progress->update(++$count);

-    my $rule = $rules->{$name};
-    my $cachekey = join "#", $name, $rule;
+    #my $rule = $rules->{$name};
+    my $rule = qr_to_string($conf->{test_qrs}->{$name});
+    if (!defined $rule) {
+      die "zoom: error: regexp for $rule not found\n";
+    }
+    my $cachekey = $name.'#'.$rule;

my $cent = $cached->{rule_bases}->{$cachekey};
     if (defined $cent) {
@@ -177,7 +181,7 @@ 
     }

# ignore ReplaceTags rules
-    my $is_a_replacetags_rule = $conf->{rules_to_replace}->{$name};
+    my $is_a_replacetags_rule = $conf->{replace_rules}->{$name};
     my ($minlen, $lossy, @bases);

if (!$is_a_replacetags_rule) {
@@ -407,12 +411,15 @@ 
   my $rule = shift;

my $main = $self->{main};
-  $rule = Mail::SpamAssassin::Util::regexp_remove_delimiters($rule);

-  # remove the regexp modifiers, keep for later
+
   my $mods = '';
-  while ($rule =~ s/^$\?([a-z]*)$//) { $mods .= $1; }

+  # remove the regexp modifiers, keep for later
+  while ($rule =~ s/^$\?([a-z]*)$//) {
+    $mods .= $1;
+  }
+
   # modifier removal
   while ($rule =~ s/^$\?-([a-z]*)$//) {
     foreach my $modchar (split '', $mods) {
@@ -685,7 +692,7 @@ 
     $add_candidate->();

if (!$longestexact) {
-      die "no long-enough string found in $rawrule";
+      die "no long-enough string found in $rawrule\n";
       # all unrolled versions must have a long string, otherwise
       # we cannot reliably match all variants of the rule
     } else {
--- lib/Mail/SpamAssassin/Plugin/Check.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/Check.pm	(working copy)
@@ -28,6 +28,9 @@ 
 
 our @ISA = qw(Mail::SpamAssassin::Plugin);
 
+my $ARITH_EXPRESSION_LEXER = ARITH_EXPRESSION_LEXER;
+my $RULENAME_RE = RULENAME_RE;
+
 # methods defined by the compiled ruleset; deleted in finish_tests()
 our @TEMPORARY_METHODS;
 
@@ -263,11 +266,15 @@ 
 
     %{$pms->{test_log_msgs}} = ();        # clear test state
 
-    my ($function, @args) = @{$test};
+    my $function = $test->[0];
+    if (!exists $pms->{conf}->{eval_plugins}->{$function}) {
+      warn("rules: unknown eval '$function' for $rulename, ignoring RBL eval\n");
+      return 0;
+    }
 
     my $result;
     eval {
-      $result = $pms->$function($rulename, @args);  1;
+      $result = $pms->$function($rulename, @{$test->[1]});  1;
     } or do {
       my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
       die "rules: $eval_stat\n"  if $eval_stat =~ /__alarm__ignore__/;
@@ -334,6 +341,7 @@ 
     $self->push_evalstr_prefix($pms, '
         # start_rules_plugin_code '.$ruletype.' '.$priority.'
         my $scoresptr = $self->{conf}->{scores};
+        my $qrptr = $self->{conf}->{test_qrs};
     ');
     if (defined $opts{pre_loop_body}) {
       $opts{pre_loop_body}->($self, $pms, $conf, %nopts);
@@ -529,11 +537,9 @@ 
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
-    $rule = untaint_var($rule);  # presumably checked
 
     # Lex the rule into tokens using a rather simple RE method ...
-    my $lexer = ARITH_EXPRESSION_LEXER;
-    my @tokens = ($rule =~ m/$lexer/og);
+    my @tokens = ($rule =~ /$ARITH_EXPRESSION_LEXER/og);
 
     # Set the rule blank to start
     $meta{$rulename} = "";
@@ -544,15 +550,12 @@ 
     # Go through each token in the meta rule
     foreach my $token (@tokens) {
 
-      # Numbers can't be rule names
-      if ($token =~ tr{A-Za-z0-9_}{}c || substr($token,0,1) =~ tr{A-Za-z_}{}c) {
-        $meta{$rulename} .= "$token ";
-      }
-      else {  # token is a rule name
+      # ... rulename?
+      if ($token =~ /^${RULENAME_RE}\z/) {
         # the " || 0" formulation is to avoid "use of uninitialized value"
         # warnings; this is better than adding a 0 to a hash for every
         # rule referred to in a meta...
-        $meta{$rulename} .= "(\$h->{'$token'} || 0) ";
+        $meta{$rulename} .= "(\$h->{'$token'}||0) ";
       
         if (!exists $conf->{scores}->{$token}) {
           dbg("rules: meta test $rulename has undefined dependency '$token'");
@@ -571,6 +574,9 @@ 
         # If the token is another meta rule, add it as a dependency
         push (@{ $rule_deps{$rulename} }, $token)
           if (exists $conf->{meta_tests}->{$opts{priority}}->{$token});
+      } else {
+        # ... number or operator
+        $meta{$rulename} .= "$token ";
       }
     }
   },
@@ -666,66 +672,30 @@ 
     args => [ ],
     loop_body => sub
   {
-    my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
-    my $def;
-    $rule = untaint_var($rule);  # presumably checked
-    my ($hdrname, $op, $op_infix, $pat);
-    if ($rule =~ /^\s* (\S+) \s* ([=!]~) \s* (\S .*? \S) \s*$/x) {
-      ($hdrname, $op, $pat) = ($1,$2,$3);  # e.g.: Subject =~ /patt/
-      $op_infix = 1;
-      if (!defined $pat) {
-        warn "rules: invalid rule: $rulename\n";
-        $pms->{rule_errors}++;
-        next;
+    my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
+    my ($op, $op_infix);
+    my $hdrname = $conf->{test_opt_header}->{$rulename};
+    if (exists $conf->{test_opt_exists}->{$rulename}) {
+      $op_infix = 0;
+      if (exists $conf->{test_opt_neg}->{$rulename}) {
+        $op = '!defined';
+      } else {
+        $op = 'defined';
       }
-      if ($pat =~ s/\s+\[if-unset:\s+(.+)\]\s*$//) { $def = $1 }
-    } elsif ($rule =~ /^\s* (\S+) \s* $ \s* (\S+) \s* $ \s*$/x) {
-      # implements exists:name_of_header (and similar function or prefix ops)
-      ($hdrname, $op) = ($2,$1);  # e.g.: !defined(Subject)
-      $op_infix = 0;
-    } else {
-      warn "rules: unrecognized rule: $rulename\n";
-      $pms->{rule_errors}++;
-      next;
     }
+    else {
+      $op_infix = 1;
+      $op = $conf->{test_opt_neg}->{$rulename} ? '!~' : '=~';
+    }
 
+    my $def = $conf->{test_opt_unset}->{$rulename};
     push(@{ $ordered{$hdrname . (!defined $def ? '' : "\t".$def)} },
          $rulename);
 
-    next if ($opts{doing_user_rules} &&
+    return if ($opts{doing_user_rules} &&
             !$self->is_user_rule_sub($rulename.'_head_test'));
 
-    # caller can set this member of the Mail::SpamAssassin object to
-    # override this; useful for profiling rule runtimes, although I think
-    # the HitFreqsRuleTiming.pm plugin is probably better nowadays anyway
-    if ($self->{main}->{use_rule_subs}) {
-      my $matching_string_unavailable = 0;
-      my $expr;
-      if ($op =~ /^!?[A-Za-z_]+$/) {  # function or its negation
-        $expr = $op . '($text)';
-        $matching_string_unavailable = 1;
-      } else {  # infix operator
-        $expr = '$text ' . $op . ' ' . $pat;
-        if ($op eq '=~' || $op eq '!~') {
-          $expr .= 'g';
-        } else {
-          $matching_string_unavailable = 1;
-        }
-      }
-      $self->add_temporary_method ($rulename.'_head_test', '{
-          my($self,$text) = @_;
-          '.$self->hash_line_for_rule($pms, $rulename).'
-	    while ('.$expr.') {
-            $self->got_hit(q{'.$rulename.'}, "", ruletype => "header");
-            '. $self->hit_rule_plugin_code($pms, $rulename, "header", "last",
-                                           $matching_string_unavailable) . '
-            }
-        }');
-    }
-    else {
-      # store for use below
-      $testcode{$rulename} = [$op_infix, $op, $pat];
-    }
+    $testcode{$rulename} = [$op_infix, $op, $pat];
   },
     pre_loop_body => sub
   {
@@ -746,15 +716,6 @@ 
                            (!defined($def) ? 'undef' : 'q{'.$def.'}') . ');
       ');
       foreach my $rulename (@{$v}) {
-        if ($self->{main}->{use_rule_subs}) {
-          $self->add_evalstr($pms, '
-            if ($scoresptr->{q{'.$rulename.'}}) {
-              '.$rulename.'_head_test($self, $hval);
-              '.$self->ran_rule_plugin_code($rulename, "header").'
-            }
-          ');
-        }
-        else {
           my $tc_ref = $testcode{$rulename};
           my ($op_infix, $op, $pat);
           ($op_infix, $op, $pat) = @$tc_ref  if defined $tc_ref;
@@ -772,9 +733,7 @@ 
             $matching_string_unavailable = 1;
           }
           else {  # infix operator
-            if (! ($op eq '=~' || $op eq '!~') ) { # not a pattern matching op.
-              $matching_string_unavailable = 1;
-            } elsif ( ($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/ ) {
+            if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/) {
               $posline = 'pos $hval = 0; $hits = 0;';
               $ifwhile = 'while';
               $hitdone = 'last';
@@ -783,7 +742,11 @@ 
               $max = untaint_var($max);
               $whlimit = ' && $hits++ < '.$max if $max;
             }
-            $expr = '$hval ' . $op . ' ' . $pat . $matchg;
+            if ($matchg) {
+              $expr = '$hval '.$op.' /$qrptr->{q{'.$rulename.'}}/g';
+            } else {
+              $expr = '$hval '.$op.' $qrptr->{q{'.$rulename.'}}';
+            }
           }
 
           $self->add_evalstr($pms, '
@@ -798,7 +761,6 @@ 
             '.$self->ran_rule_plugin_code($rulename, "header").'
           }
           ');
-        }
       }
       $self->pop_evalstr_prefix();
     }
@@ -820,7 +782,6 @@ 
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my $sub = '';
     if (would_log('dbg', 'rules-all') == 2) {
       $sub .= '
@@ -838,7 +799,7 @@ 
       body_'.$loopid.': foreach my $l (@_) {
         pos $l = 0;
         '.$self->hash_line_for_rule($pms, $rulename).'
-        while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') { 
+        while ($l =~ /$qrptr->{q{'.$rulename.'}}/g'. ($max? ' && $hits++ < '.$max:'') .') { 
           $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body"); 
           '. $self->hit_rule_plugin_code($pms, $rulename, 'body',
 					 "last body_".$loopid) . '
@@ -853,7 +814,7 @@ 
       $sub .= '
       foreach my $l (@_) {
         '.$self->hash_line_for_rule($pms, $rulename).'
-        if ($l =~ '.$pat.') { 
+        if ($l =~ $qrptr->{q{'.$rulename.'}}) { 
           $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body"); 
           '. $self->hit_rule_plugin_code($pms, $rulename, "body", "last") .'
         }
@@ -861,30 +822,15 @@ 
       ';
     }
 
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-          '.$rulename.'_body_test($self,@_); 
-          '.$self->ran_rule_plugin_code($rulename, "body").'
-        }
-      ');
-    }
-    else {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-          '.$sub.'
-          '.$self->ran_rule_plugin_code($rulename, "body").'
-        }
-      ');
-    }
+    $self->add_evalstr($pms, '
+      if ($scoresptr->{q{'.$rulename.'}}) {
+        '.$sub.'
+        '.$self->ran_rule_plugin_code($rulename, "body").'
+      }
+    ');
 
-    next if ($opts{doing_user_rules} &&
+    return if ($opts{doing_user_rules} &&
             !$self->is_user_rule_sub($rulename.'_body_test'));
-
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_temporary_method ($rulename.'_body_test',
-        '{ my $self = shift; '.$sub.' }');
-    }
   }
   );
 }
@@ -902,7 +848,6 @@ 
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my $sub = '';
     if (would_log('dbg', 'rules-all') == 2) {
       $sub .= '
@@ -918,7 +863,7 @@ 
       uri_'.$loopid.': foreach my $l (@_) {
         pos $l = 0;
         '.$self->hash_line_for_rule($pms, $rulename).'
-        while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') { 
+        while ($l =~ /$qrptr->{q{'.$rulename.'}}/g'. ($max? ' && $hits++ < '.$max:'') .') { 
            $self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
            '. $self->hit_rule_plugin_code($pms, $rulename, "uri",
 					  "last uri_".$loopid) . '
@@ -930,7 +875,7 @@ 
       $sub .= '
       foreach my $l (@_) {
         '.$self->hash_line_for_rule($pms, $rulename).'
-        if ($l =~ '.$pat.') { 
+        if ($l =~ $qrptr->{q{'.$rulename.'}}) { 
            $self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
            '. $self->hit_rule_plugin_code($pms, $rulename, "uri", "last") .'
         }
@@ -938,30 +883,15 @@ 
       ';
     }
 
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-          '.$rulename.'_uri_test($self, @_);
-          '.$self->ran_rule_plugin_code($rulename, "uri").'
-        }
-      ');
-    }
-    else {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-          '.$sub.'
-          '.$self->ran_rule_plugin_code($rulename, "uri").'
-        }
-      ');
-    }
+    $self->add_evalstr($pms, '
+      if ($scoresptr->{q{'.$rulename.'}}) {
+        '.$sub.'
+        '.$self->ran_rule_plugin_code($rulename, "uri").'
+      }
+    ');
 
-    next if ($opts{doing_user_rules} &&
+    return if ($opts{doing_user_rules} &&
             !$self->is_user_rule_sub($rulename.'_uri_test'));
-
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_temporary_method ($rulename.'_uri_test',
-        '{ my $self = shift; '.$sub.' }');
-    }
   }
   );
 }
@@ -979,7 +909,6 @@ 
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my $sub = '';
     if (would_log('dbg', 'rules-all') == 2) {
       $sub .= '
@@ -997,7 +926,7 @@ 
       rawbody_'.$loopid.': foreach my $l (@_) {
         pos $l = 0;
         '.$self->hash_line_for_rule($pms, $rulename).'
-        while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') { 
+        while ($l =~ /$qrptr->{q{'.$rulename.'}}/g'. ($max? ' && $hits++ < '.$max:'') .') { 
            $self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
            '. $self->hit_rule_plugin_code($pms, $rulename, "rawbody",
 					  "last rawbody_".$loopid) . '
@@ -1010,7 +939,7 @@ 
       $sub .= '
       foreach my $l (@_) {
         '.$self->hash_line_for_rule($pms, $rulename).'
-        if ($l =~ '.$pat.') { 
+        if ($l =~ $qrptr->{q{'.$rulename.'}}) { 
            $self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
            '. $self->hit_rule_plugin_code($pms, $rulename, "rawbody", "last") . '
         }
@@ -1018,30 +947,15 @@ 
       ';
     }
 
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-           '.$rulename.'_rawbody_test($self, @_);
-           '.$self->ran_rule_plugin_code($rulename, "rawbody").'
-        }
-      ');
-    }
-    else {
-      $self->add_evalstr($pms, '
-        if ($scoresptr->{q{'.$rulename.'}}) {
-          '.$sub.'
-          '.$self->ran_rule_plugin_code($rulename, "rawbody").'
-        }
-      ');
-    }
+    $self->add_evalstr($pms, '
+      if ($scoresptr->{q{'.$rulename.'}}) {
+        '.$sub.'
+        '.$self->ran_rule_plugin_code($rulename, "rawbody").'
+      }
+    ');
 
-    next if ($opts{doing_user_rules} &&
+    return if ($opts{doing_user_rules} &&
             !$self->is_user_rule_sub($rulename.'_rawbody_test'));
-
-    if ($self->{main}->{use_rule_subs}) {
-      $self->add_temporary_method ($rulename.'_rawbody_test',
-        '{ my $self = shift; '.$sub.' }');
-    }
   }
   );
 }
@@ -1066,7 +980,6 @@ 
                 loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
     $max = untaint_var($max);
     $self->add_evalstr($pms, '
@@ -1075,7 +988,7 @@ 
         '.$self->hash_line_for_rule($pms, $rulename).'
         dbg("rules-all: running full rule %s", q{'.$rulename.'});
         $hits = 0;
-        while ($$fullmsgref =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') {
+        while ($$fullmsgref =~ /$qrptr->{q{'.$rulename.'}}/g'. ($max? ' && $hits++ < '.$max:'') .') {
           $self->got_hit(q{'.$rulename.'}, "FULL: ", ruletype => "full");
           '. $self->hit_rule_plugin_code($pms, $rulename, "full", "last") . '
         }
@@ -1093,7 +1006,7 @@ 
   return unless (defined($pms->{conf}->{head_evals}->{$priority}));
   dbg("rules: running head_eval tests; score so far=".$pms->{score});
   $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS,
-			 $pms->{conf}->{head_evals}->{$priority}, '', $priority);
+			 'head_evals', '', $priority);
 }
 
 sub do_body_eval_tests {
@@ -1101,8 +1014,7 @@ 
   return unless (defined($pms->{conf}->{body_evals}->{$priority}));
   dbg("rules: running body_eval tests; score so far=".$pms->{score});
   $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS,
-			 $pms->{conf}->{body_evals}->{$priority}, 'BODY: ',
-			 $priority, $bodystring);
+			 'body_evals', 'BODY: ', $priority, $bodystring);
 }
 
 sub do_rawbody_eval_tests {
@@ -1110,8 +1022,7 @@ 
   return unless (defined($pms->{conf}->{rawbody_evals}->{$priority}));
   dbg("rules: running rawbody_eval tests; score so far=".$pms->{score});
   $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_RAWBODY_EVALS,
-			 $pms->{conf}->{rawbody_evals}->{$priority}, 'RAW: ',
-			 $priority, $bodystring);
+			 'rawbody_evals', 'RAW: ', $priority, $bodystring);
 }
 
 sub do_full_eval_tests {
@@ -1119,12 +1030,11 @@ 
   return unless (defined($pms->{conf}->{full_evals}->{$priority}));
   dbg("rules: running full_eval tests; score so far=".$pms->{score});
   $self->run_eval_tests($pms, $Mail::SpamAssassin::Conf::TYPE_FULL_EVALS,
-			$pms->{conf}->{full_evals}->{$priority}, '',
-			$priority, $fullmsgref);
+			'full_evals', '', $priority, $fullmsgref);
 }
 
 sub run_eval_tests {
-  my ($self, $pms, $testtype, $evalhash, $prepend2desc, $priority, @extraevalargs) = @_;
+  my ($self, $pms, $testtype, $evalname, $prepend2desc, $priority, @extraevalargs) = @_;
  
   my $master_deadline = $pms->{master_deadline};
   if ($pms->{deadline_exceeded}) {
@@ -1159,7 +1069,7 @@ 
       && !$doing_user_rules)
   {
     my $method = "${package_name}::${methodname}";
-  # dbg("rules: run_eval_tests - calling previously compiled %s", $method);
+    #dbg("rules: run_eval_tests - calling previously compiled %s", $method);
     my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });
     my $err = $t->run(sub {
       no strict "refs";
@@ -1173,24 +1083,23 @@ 
   }
 
   # look these up once in advance to save repeated lookups in loop below
+  my $evalhash = $conf->{$evalname}->{$priority};
   my $tflagsref = $conf->{tflags};
+  my $scoresref = $conf->{scores};
   my $eval_pluginsref = $conf->{eval_plugins};
   my $have_start_rules = $self->{main}->have_plugin("start_rules");
   my $have_ran_rule = $self->{main}->have_plugin("ran_rule");
 
   # the buffer for the evaluated code 
-  my $evalstr = q{ };
-  $evalstr .= q{ my $function; };
- 
+  my $evalstr = '';
+
   # conditionally include the dbg in the eval str
-  my $dbgstr = q{ };
+  my $dbgstr = '';
   if (would_log('dbg')) {
-    $dbgstr = q{
-      dbg("rules: ran eval rule $rulename ======> got hit ($result)");
-    };
+    $dbgstr = 'dbg("rules: ran eval rule $rulename ======> got hit ($result)");';
   }
 
-  while (my ($rulename, $test) = each %{$evalhash})  { 
+  while (my ($rulename, $test) = each %{$evalhash}) {
     if ($tflagsref->{$rulename}) {
       # If the rule is a net rule, and we are in a non-net scoreset, skip it.
       if ($tflagsref->{$rulename} =~ /\bnet\b/) {
@@ -1201,23 +1110,26 @@ 
         next if (($scoreset & 2) == 0);
       }
     }
+
+    # skip if score zeroed
+    next if !$scoresref->{$rulename};
  
-    $test = untaint_var($test);  # presumably checked
-    my ($function, $argstr) = ($test,'');
-    if ($test =~ s/^([^,]+)(,.*)$//gs) {
-      ($function, $argstr) = ($1,$2);
+    my $function = untaint_var($test->[0]); # was validated with \w+
+    if (!$function) {
+      warn "rules: error: no eval function defined for $rulename";
+      next;
     }
 
-    if (!$function) {
-      warn "rules: error: no function defined for $rulename";
+    if (!exists $conf->{eval_plugins}->{$function}) {
+      warn("rules: error: unknown eval '$function' for $rulename\n");
       next;
     }
- 
+
     $evalstr .= '
-    if ($scoresptr->{q#'.$rulename.'#}) {
+    {
       $rulename = q#'.$rulename.'#;
       %{$self->{test_log_msgs}} = ();
-    ';
+';
  
     # only need to set current_rule_name for plugin evals
     if ($eval_pluginsref->{$function}) {
@@ -1224,11 +1136,9 @@ 
       # let plugins get the name of the rule that is currently being run,
       # and ensure their eval functions exist
       $evalstr .= '
-
-        $self->{current_rule_name} = $rulename;
-        $self->register_plugin_eval_glue(q#'.$function.'#);
-
-      ';
+      $self->{current_rule_name} = $rulename;
+      $self->register_plugin_eval_glue(q#'.$function.'#);
+';
     }
 
     # this stuff is quite slow, and totally superfluous if
@@ -1236,7 +1146,6 @@ 
     if ($have_start_rules) {
       # XXX - should we use helper function here?
       $evalstr .= '
-
         $self->{main}->call_plugins("start_rules", {
                 permsgstatus => $self,
                 ruletype => "eval",
@@ -1243,40 +1152,35 @@ 
                 priority => '.$priority.'
               });
 
-      ';
+';
     }
- 
+
     $evalstr .= '
-
       eval {
-        $result = $self->' . $function . ' (@extraevalargs '. $argstr .' );  1;
+        $result = $self->'.$function.'(@extraevalargs, @{$testptr->{q#'.$rulename.'#}->[1]}); 1;
       } or do {
         $result = 0;
         die "rules: $@\n"  if $@ =~ /__alarm__ignore__/;
         $self->handle_eval_rule_errors($rulename);
       };
+';
 
-    ';
-
     if ($have_ran_rule) {
       # XXX - should we use helper function here?
       $evalstr .= '
-
         $self->{main}->call_plugins("ran_rule", {
             permsgstatus => $self, ruletype => "eval", rulename => $rulename
           });
-
-      ';
+';
     }
 
     $evalstr .= '
-
       if ($result) {
         $self->got_hit($rulename, $prepend2desc, ruletype => "eval", value => $result);
         '.$dbgstr.'
       }
     }
-    ';
+';
   }
 
   # don't free the eval ruleset here -- we need it in the compiled code!
@@ -1288,17 +1192,16 @@ 
 {
   package $package_name;
 
-    sub ${methodname} {
-      my (\$self, \@extraevalargs) = \@_;
+  sub ${methodname} {
+    my (\$self, \@extraevalargs) = \@_;
 
-      my \$scoresptr = \$self->{conf}->{scores};
-      my \$prepend2desc = q#$prepend2desc#;
-      my \$rulename;
-      my \$result;
+    my \$testptr = \$self->{conf}->{$evalname}->{$priority};
+    my \$prepend2desc = q#$prepend2desc#;
+    my \$rulename;
+    my \$result;
+    $evalstr
+  }
 
-      $evalstr
-    }
-
   1;
 }
 EOT
--- lib/Mail/SpamAssassin/Plugin/HTMLEval.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/HTMLEval.pm	(working copy)
@@ -24,7 +24,7 @@ 
 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Locales;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var compile_regexp);
 
 our @ISA = qw(Mail::SpamAssassin::Plugin);
 
@@ -57,13 +57,18 @@ 
 
 sub html_tag_balance {
   my ($self, $pms, undef, $rawtag, $rawexpr) = @_;
-  $rawtag =~ /^([a-zA-Z0-9]+)$/; my $tag = $1;
-  $rawexpr =~ /^([\<\>\=\!\-\+ 0-9]+)$/; my $expr = $1;
 
+  return 0 if $rawtag !~ /^([a-zA-Z0-9]+)$/;
+  my $tag = $1;
+
   return 0 unless exists $pms->{html}{inside}{$tag};
 
+  return 0 if $rawexpr !~ /^([\<\>\=\!\-\+ 0-9]+)$/;
+  my $expr = untaint_var($1);
+
   $pms->{html}{inside}{$tag} =~ /^([\<\>\=\!\-\+ 0-9]+)$/;
-  my $val = $1;
+  my $val = untaint_var($1);
+
   return eval "\$val $expr";
 }
 
@@ -119,14 +124,14 @@ 
 
 sub html_eval {
   my ($self, $pms, undef, $test, $rawexpr) = @_;
-  my $expr;
-  if ($rawexpr =~ /^[\<\>\=\!\-\+ 0-9]+$/) {
-    $expr = untaint_var($rawexpr);
-  }
+
+  return 0 if $rawexpr !~ /^([\<\>\=\!\-\+ 0-9]+)$/;
+  my $expr = untaint_var($1);
+
   # workaround bug 3320: wierd perl bug where additional, very explicit
   # untainting into a new var is required.
   my $tainted = $pms->{html}{$test};
-  return unless defined($tainted);
+  return 0 unless defined($tainted);
   my $val = $tainted;
 
   # just use the value in $val, don't copy it needlessly
@@ -135,8 +140,14 @@ 
 
 sub html_text_match {
   my ($self, $pms, undef, $text, $regexp) = @_;
-  for my $string (@{ $pms->{html}{$text} }) {
-    if (defined $string && $string =~ /${regexp}/) {
+  my ($rec, $err) = compile_regexp($regexp, 0);
+  if (!$rec) {
+    warn "htmleval: html_text_match invalid regexp '$regexp': $err";
+    return 0;
+  }
+  foreach my $string (@{$pms->{html}{$text}}) {
+    next unless defined $string;
+    if ($string =~ $rec) {
       return 1;
     }
   }
--- lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm	(working copy)
@@ -65,12 +65,15 @@ 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Conf;
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var compile_regexp);
+use Mail::SpamAssassin::Constants qw(:sa);
 
 our @ISA = qw(Mail::SpamAssassin::Plugin);
 
 our @TEMPORARY_METHODS;
 
+my $RULENAME_RE = RULENAME_RE;
+
 # ---------------------------------------------------------------------------
 
 # constructor
@@ -101,27 +104,37 @@ 
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2,$3,$4);
-      if ($value !~ /^(\S+)\s+(\S+)\s*([\=\!]\~)\s*(.+)$/) {
+      local ($1,$2,$3);
+      if ($value !~ s/^(${RULENAME_RE})\s+//) {
         return $Mail::SpamAssassin::Conf::INVALID_VALUE;
       }
-
-      # provide stricter syntax for rule name!?
       my $rulename = untaint_var($1);
-      my $hdrname = $2;
-      my $negated = ($3 eq '!~') ? 1 : 0;
-      my $pattern = $4;
+      if ($value eq '') {
+        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
+      }
+      # Take :raw to hdrname!
+      if ($value !~ /^([^:\s]+(?:\:(?:raw)?)?)\s*([=!]~)\s*(.+)$/) {
+        return $Mail::SpamAssassin::Conf::INVALID_VALUE;
+      }
+      my $hdrname = $1;
+      my $negated = $2 eq '!~' ? 1 : 0;
+      my $pattern = $3;
+      $hdrname =~ s/:$//;
+      my $if_unset = '';
+      if ($pattern =~ s/\s+\[if-unset:\s+(.+)\]$//) {
+         $if_unset = $1;
+      }
+      my ($rec, $err) = compile_regexp($pattern, 1);
+      if (!$rec) {
+        info("mimeheader: invalid regexp for $rulename '$pattern': $err");
+        return $Mail::SpamAssassin::Conf::INVALID_VALUE;
+      }
 
-      return unless $self->{parser}->is_delimited_regexp_valid($rulename, $pattern);
-
-      $pattern = Mail::SpamAssassin::Util::make_qr($pattern);
-      return $Mail::SpamAssassin::Conf::INVALID_VALUE unless $pattern;
-
       $self->{mimeheader_tests}->{$rulename} = {
         hdr => $hdrname,
         negated => $negated,
-        if_unset => '',             # TODO!
-        pattern => $pattern
+        if_unset => $if_unset,
+        pattern => $rec
       };
 
       # now here's a hack; generate a fake eval rule function to
@@ -129,7 +142,6 @@ 
       # TODO: we should have a more elegant way for new rule types to
       # be defined
       my $evalfn = "_mimeheader_eval_$rulename";
-      $evalfn =~ s/[^a-zA-Z0-9_]/_/gs;
 
       # don't redefine the subroutine if it already exists!
       # this causes lots of annoying warnings and such during things like
@@ -139,6 +151,7 @@ 
       $self->{parser}->add_test($rulename, $evalfn."()",
                 $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
 
+      # evalfn/rulename safe, sanitized by $RULENAME_RE
       my $evalcode = '
         sub Mail::SpamAssassin::Plugin::MIMEHeader::'.$evalfn.' {
           $_[0]->eval_hook_called($_[1], q{'.$rulename.'});
@@ -175,7 +188,7 @@ 
 
 
   my $getraw;
-  if ($hdr =~ s/:raw$//i) {
+  if ($hdr =~ s/:raw$//) {
     $getraw = 1;
   } else {
     $getraw = 0;
@@ -188,9 +201,9 @@ 
     } else {
       $val = $p->get_header($hdr);
     }
-    $val ||= $if_unset;
+    $val = $if_unset if !defined $val;
 
-    if ($val =~ ${pattern}) {
+    if ($val =~ $pattern) {
       return ($negated ? 0 : 1);
     }
   }
--- lib/Mail/SpamAssassin/Plugin/PDFInfo.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/PDFInfo.pm	(working copy)
@@ -142,7 +142,7 @@ 
 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util;
+use Mail::SpamAssassin::Util qw(compile_regexp);
 use strict;
 use warnings;
 # use bytes;
@@ -471,16 +471,15 @@ 
   return 0 if (exists $pms->{'pdfinfo'}->{'no_parts'});
   return 0 unless (exists $pms->{'pdfinfo'}->{"names_pdf"});
 
+  my ($rec, $err) = compile_regexp($re, 2);
+  if (!$rec) {
+    info("pdfinfo: invalid regexp '$re': $err");
+    return 0;
+  }
+
   my $hit = 0;
   foreach my $name (keys %{$pms->{'pdfinfo'}->{"names_pdf"}}) {
-    eval {
-        my $regex = Mail::SpamAssassin::Util::make_qr($re);
-        if ( $name =~ m/$regex/ ) {
-            $hit = 1;
-        }
-    };
-    dbg("pdfinfo: error in regex $re - $@") if $@;
-    if ($hit) {
+    if ($name =~ $rec) {
       dbg("pdfinfo: pdf_name_regex hit on $name");
       return 1;
     }
@@ -722,15 +721,13 @@ 
   my $check_value = $pms->{pdfinfo}->{details}->{$detail};
   return unless $check_value;
 
-  my $hit = 0;
-  eval {
-      my $re = Mail::SpamAssassin::Util::make_qr($regex);
-      if ( $check_value =~ m/$re/ ) {
-          $hit = 1;
-      }
-  };
-  dbg("pdfinfo: error in regex $regex - $@") if $@;
-  if ($hit) {
+  my ($rec, $err) = compile_regexp($regex, 2);
+  if (!$rec) {
+    info("pdfinfo: invalid regexp '$regex': $err");
+    return 0;
+  }
+
+  if ($check_value =~ $rec) {
     dbg("pdfinfo: pdf_match_details $detail $regex matches $check_value");
     return 1;
   }
--- lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm	(working copy)
@@ -52,6 +52,7 @@ 
 use Mail::SpamAssassin;
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
+use Mail::SpamAssassin::Util qw(compile_regexp qr_to_string);
 
 use strict;
 use warnings;
@@ -73,6 +74,16 @@ 
   return $self;
 }
 
+sub finish_parsing_start {
+  my ($self, $opts) = @_;
+
+  # keeps track of replaced rules
+  # don't have $pms in finish_parsing_end() so init this..
+  $self->{replace_rules_done} = {};
+
+  return 1;
+}
+
 sub finish_parsing_end {
   my ($self, $opts) = @_;
 
@@ -82,94 +93,96 @@ 
   my $start = $conf->{replace_start};
   my $end = $conf->{replace_end};
 
-  # this is the version-specific code
-  for my $type (qw|body_tests rawbody_tests head_tests full_tests uri_tests|) {
-    for my $priority (keys %{$conf->{$type}}) {
-      while (my ($rule, $re) = each %{$conf->{$type}->{$priority}}) {
-        # skip if not listed by replace_rules
-        next unless $conf->{rules_to_replace}{$rule};
+  foreach my $rule (keys %{$conf->{replace_rules}}) {
+    # process rules only once, mark to replace_rules_done,
+    # do NOT delete $conf->{replace_rules}, it's used by BodyRuleExtractor
+    next if exists $self->{replace_rules_done}->{$rule};
+    $self->{replace_rules_done}->{$rule} = 1;
 
-        if (would_log('dbg', 'replacetags') > 1) {
-          dbg("replacetags: replacing $rule: $re");
-        }
+    if (!exists $conf->{test_qrs}->{$rule}) {
+      dbg("replacetags: replace requested for non-existing rule: $rule\n");
+      next;
+    }
 
-        my $passes = 0;
-        my $doagain;
+    my $re = qr_to_string($conf->{test_qrs}->{$rule});
+    next unless defined $re;
+    my $origre = $re;
 
-        do {
-          my $pre_name;
-          my $post_name;
-          my $inter_name;
-          $doagain = 0;
+    my $passes = 0;
+    my $doagain;
 
-          # get modifier tags
-          if ($re =~ s/${start}pre (.+?)${end}//) {
-            $pre_name = $1;
-          }
-          if ($re =~ s/${start}post (.+?)${end}//) {
-            $post_name = $1;
-          }
-          if ($re =~ s/${start}inter (.+?)${end}//) {
-            $inter_name = $1;
-          }
+    do {
+      my $pre_name;
+      my $post_name;
+      my $inter_name;
+      $doagain = 0;
 
-          # this will produce an array of tags to be replaced
-          # for two adjacent tags, an element of "" will be between the two
-          my @re = split(/(<[^<>]+>)/, $re);
+      # get modifier tags
+      if ($re =~ s/${start}pre (.+?)${end}//) {
+        $pre_name = $1;
+      }
+      if ($re =~ s/${start}post (.+?)${end}//) {
+        $post_name = $1;
+      }
+      if ($re =~ s/${start}inter (.+?)${end}//) {
+        $inter_name = $1;
+      }
 
-          if ($pre_name) {
-            my $pre = $conf->{replace_pre}->{$pre_name};
-            if ($pre) {
-              s{($start.+?$end)}{$pre$1}  for @re;
+      # this will produce an array of tags to be replaced
+      # for two adjacent tags, an element of "" will be between the two
+      my @re = split(/(<[^<>]+>)/, $re);
+
+      if ($pre_name) {
+        my $pre = $conf->{replace_pre}->{$pre_name};
+        if ($pre) {
+          s{($start.+?$end)}{$pre$1}  for @re;
+         }
+      }
+      if ($post_name) {
+        my $post = $conf->{replace_post}->{$post_name};
+        if ($post) {
+          s{($start.+?$end)}{$1$post}g  for @re;
+        }
+      }
+      if ($inter_name) {
+        my $inter = $conf->{replace_inter}->{$inter_name};
+        if ($inter) {
+          s{^$}{$inter}  for @re;
+        }
+      }
+      for (my $i = 0; $i < @re; $i++) {
+        if ($re[$i] =~ m|$start(.+?)$end|g) {
+          my $tag_name = $1;
+          # if the tag exists, replace it with the corresponding phrase
+          if ($tag_name) {
+            my $replacement = $conf->{replace_tag}->{$tag_name};
+            if ($replacement) {
+              $re[$i] =~ s|$start$tag_name$end|$replacement|g;
+              $doagain = 1 if !$doagain && $replacement =~ /<[^>]+>/;
             }
           }
-          if ($post_name) {
-            my $post = $conf->{replace_post}->{$post_name};
-            if ($post) {
-              s{($start.+?$end)}{$1$post}g  for @re;
-            }
-          }
-          if ($inter_name) {
-            my $inter = $conf->{replace_inter}->{$inter_name};
-            if ($inter) {
-              s{^$}{$inter}  for @re;
-            }
-          }
-          for (my $i = 0; $i < @re; $i++) {
-            if ($re[$i] =~ m|$start(.+?)$end|g) {
-              my $tag_name = $1;
-              # if the tag exists, replace it with the corresponding phrase
-              if ($tag_name) {
-                my $replacement = $conf->{replace_tag}->{$tag_name};
-                if ($replacement) {
-                  $re[$i] =~ s|$start$tag_name$end|$replacement|g;
-                  $doagain = 1 if !$doagain && $replacement =~ /<[^>]+>/;
-                }
-              }
-            }
-          }
+        }
+      }
 
-          $re = join('', @re);
+      $re = join('', @re);
 
-          # do the actual replacement
-          $conf->{$type}->{$priority}->{$rule} = $re;
+      $passes++;
+    } while $doagain && $passes <= 5;
 
-          if (would_log('dbg', 'replacetags') > 1) {
-            dbg("replacetags: replaced $rule: $re");
-          }
-
-          $passes++;
-        } while $doagain && $passes <= 5;
+    if ($re ne $origre) {
+      # do the actual replacement
+      my ($rec, $err) = compile_regexp($re, 0);
+      if (!$rec) {
+        info("replacetags: regexp compilation failed '$re': $err");
+        next;
       }
+      $conf->{test_qrs}->{$rule} = $rec;
+      #dbg("replacetags: replaced $rule: '$origre' => '$re'");
+      dbg("replacetags: replaced $rule");
+    } else {
+      dbg("replacetags: nothing was replaced in $rule");
     }
   }
-
-  # free this up, if possible
-  if (!$conf->{allow_user_rules}) {
-    delete $conf->{rules_to_replace};
-  }
-
-  dbg("replacetags: done replacing tags");
 }
 
 sub user_conf_parsing_end {
@@ -250,6 +263,7 @@ 
   push(@cmds, {
     setting => 'replace_rules',
     is_priv => 1,
+    default => {},
     type => $Mail::SpamAssassin::Conf::CONF_TYPE_HASH_KEY_VALUE,
     code => sub {
       my ($self, $key, $value, $line) = @_;
@@ -259,8 +273,8 @@ 
       unless ($value =~ /\S+/) {
         return $Mail::SpamAssassin::Conf::INVALID_VALUE;
       }
-      foreach my $rule (split(' ', $value)) {
-        $conf->{rules_to_replace}->{$rule} = 1;
+      foreach my $rule (split(/\s+/, $value)) {
+        $self->{replace_rules}->{$rule} = 1;
       }
     }
   });
--- lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm	(working copy)
@@ -38,6 +38,7 @@ 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
 use Mail::SpamAssassin::Plugin::OneLineBodyRuleType;
+use Mail::SpamAssassin::Util qw(qr_to_string);
 
 use strict;
 use warnings;
@@ -120,17 +121,18 @@ 
 
   my $found = 0;
   foreach my $name (keys %{$rules}) {
-    my $rule = $rules->{$name};
+    #my $rule = $rules->{$name};
+    my $rule = qr_to_string($conf->{test_qrs}->{$name});
     my $comprule = $hasrules->{$longname{$name} || ''};
     $rule =~ s/\#/\[hash\]/gs;
 
-    if (!$comprule) { 
+    if (!$comprule) {
       # this is pretty common, based on rule complexity; don't warn
       # dbg "zoom: skipping rule $name, not in compiled ruleset";
       next;
     }
     if ($comprule ne $rule) {
-      dbg "zoom: skipping rule $name, code differs in compiled ruleset";
+      dbg "zoom: skipping rule $name, code differs in compiled ruleset '$comprule' '$rule'";
       next;
     }
 
@@ -137,7 +139,7 @@ 
     # ignore rules marked for ReplaceTags work!
     # TODO: we should be able to order the 'finish_parsing_end'
     # plugin calls to do this.
-    if ($conf->{rules_to_replace}->{$name}) {
+    if ($conf->{replace_rules}->{$name}) {
       dbg "zoom: skipping rule $name, ReplaceTags";
       next;
     }
--- lib/Mail/SpamAssassin/Plugin/URIDetail.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/Plugin/URIDetail.pm	(working copy)
@@ -68,7 +68,7 @@ 
 package Mail::SpamAssassin::Plugin::URIDetail;
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var compile_regexp);
 
 use strict;
 use warnings;
@@ -122,22 +122,23 @@ 
 	if ($target !~ /^(?:raw|type|cleaned|text|domain)$/) {
 	    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
 	}
-	if ($conf->{parser}->is_delimited_regexp_valid($name, $pattern)) {
-	    $pattern = $pluginobj->make_qr($pattern);
+
+	my ($rec, $err) = compile_regexp($pattern, 1);
+	if (!$rec) {
+	  dbg("config: uri_detail invalid regexp '$pattern': $err");
+	  return $Mail::SpamAssassin::Conf::INVALID_VALUE;
 	}
-	else {
-	    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
-	}
 
-	dbg("config: uri_detail adding ($target $op /$pattern/) to $name");
+	dbg("config: uri_detail adding ($target $op /$rec/) to $name");
         $conf->{parser}->{conf}->{uri_detail}->{$name}->{$target} =
-          [$op, $pattern];
+          [$op, $rec];
 	$added_criteria = 1;
       }
 
       if ($added_criteria) {
 	dbg("config: uri_detail added $name\n");
-	$conf->{parser}->add_test($name, 'check_uri_detail()', $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
+	$conf->{parser}->add_test($name, 'check_uri_detail()',
+	  $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
       } 
       else {
 	warn "config: failed to add invalid rule $name";
@@ -163,8 +164,8 @@ 
 
     if (exists $rule->{raw}) {
       my($op,$patt) = @{$rule->{raw}};
-      if ( ($op eq '=~' && $raw =~ /$patt/) ||
-           ($op eq '!~' && $raw !~ /$patt/) ) {
+      if ( ($op eq '=~' && $raw =~ $patt) ||
+           ($op eq '!~' && $raw !~ $patt) ) {
         dbg("uri: raw matched: '%s' %s /%s/", $raw,$op,$patt);
       } else {
         next;
@@ -176,8 +177,8 @@ 
       my($op,$patt) = @{$rule->{type}};
       my $match;
       for my $text (keys %{ $info->{types} }) {
-        if ( ($op eq '=~' && $text =~ /$patt/) ||
-             ($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
+        if ( ($op eq '=~' && $text =~ $patt) ||
+             ($op eq '!~' && $text !~ $patt) ) { $match = $text; last }
       }
       next unless defined $match;
       dbg("uri: type matched: '%s' %s /%s/", $match,$op,$patt);
@@ -188,8 +189,8 @@ 
       my($op,$patt) = @{$rule->{cleaned}};
       my $match;
       for my $text (@{ $info->{cleaned} }) {
-        if ( ($op eq '=~' && $text =~ /$patt/) ||
-             ($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
+        if ( ($op eq '=~' && $text =~ $patt) ||
+             ($op eq '!~' && $text !~ $patt) ) { $match = $text; last }
       }
       next unless defined $match;
       dbg("uri: cleaned matched: '%s' %s /%s/", $match,$op,$patt);
@@ -200,8 +201,8 @@ 
       my($op,$patt) = @{$rule->{text}};
       my $match;
       for my $text (@{ $info->{anchor_text} }) {
-        if ( ($op eq '=~' && $text =~ /$patt/) ||
-             ($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
+        if ( ($op eq '=~' && $text =~ $patt) ||
+             ($op eq '!~' && $text !~ $patt) ) { $match = $text; last }
       }
       next unless defined $match;
       dbg("uri: text matched: '%s' %s /%s/", $match,$op,$patt);
@@ -212,8 +213,8 @@ 
       my($op,$patt) = @{$rule->{domain}};
       my $match;
       for my $text (keys %{ $info->{domains} }) {
-        if ( ($op eq '=~' && $text =~ /$patt/) ||
-             ($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
+        if ( ($op eq '=~' && $text =~ $patt) ||
+             ($op eq '!~' && $text !~ $patt) ) { $match = $text; last }
       }
       next unless defined $match;
       dbg("uri: domain matched: '%s' %s /%s/", $match,$op,$patt);
@@ -236,28 +237,4 @@ 
 
 # ---------------------------------------------------------------------------
 
-# turn "/foobar/i" into qr/(?i)foobar/
-sub make_qr {
-  my ($self, $pattern) = @_;
-
-  my $re_delim;
-  if ($pattern =~ s/^m(\W)//) {     # m!foo/bar!
-    $re_delim = $1;
-  } else {                          # /foo\/bar/ or !foo/bar!
-    $pattern =~ s/^(\W)//; $re_delim = $1;
-  }
-  if (!$re_delim) {
-    return;
-  }
-
-  $pattern =~ s/${re_delim}([imsx]*)$//;
-
-  my $mods = $1;
-  if ($mods) { $pattern = "(?".$mods.")".$pattern; }
-
-  return qr/$pattern/;
-}
-
-# ---------------------------------------------------------------------------
-
 1;
--- lib/Mail/SpamAssassin/PluginHandler.pm	(revision 1848547)
+++ lib/Mail/SpamAssassin/PluginHandler.pm	(working copy)
@@ -74,6 +74,13 @@ 
 sub load_plugin {
   my ($self, $package, $path, $silent) = @_;
 
+  # Strict name checking
+  if ($package !~ /^(?:\w+::){0,10}\w+$/) {
+    warn "plugin: illegal plugin name, not loading: $package\n";
+    return;
+  }
+  $package = Mail::SpamAssassin::Util::untaint_var($package);
+
   # Don't load the same plugin twice!
   # Do this *before* calling ->new(), otherwise eval rules will be
   # registered on a nonexistent object
@@ -86,6 +93,13 @@ 
 
   my $ret;
   if ($path) {
+    if ($path !~ /^\S+\.pm/i) {
+      warn "plugin: illegal plugin filename, not loading: $path";
+      return;
+    }
+
+    $path = $self->{main}->{conf}->{parser}->fix_path_relative_to_current_file($path);
+
     # bug 3717:
     # At least Perl 5.8.0 seems to confuse $cwd internally at some point -- we
     # need to use an absolute path here else we get a "File not found" error.
--- lib/Mail/SpamAssassin/Util.pm.orig	2018-09-14 03:27:51.000000000 +0200
+++ lib/Mail/SpamAssassin/Util.pm	2019-07-24 12:31:17.556884027 +0200
@@ -57,7 +57,8 @@
                   &exit_status_str &proc_status_ok &am_running_on_windows
                   &reverse_ip_address &decode_dns_question_entry
                   &get_my_locales &parse_rfc822_date &get_user_groups
-                  &secure_tmpfile &secure_tmpdir &uri_list_canonicalize);
+                  &secure_tmpfile &secure_tmpdir &uri_list_canonicalize
+		  &compile_regexp &qr_to_string);
 
 our $AM_TAINTED;
 
@@ -1097,7 +1098,8 @@
 sub first_available_module {
   my (@packages) = @_;
   foreach my $mod (@packages) {
-    if (eval 'require '.$mod.'; 1; ') {
+    next if $mod !~ /^[\w:]+$/; # be paranoid
+    if (eval 'require '.$mod.'; 1;') {
       return $mod;
     }
   }
@@ -1228,6 +1230,8 @@
 ## Replaced with Mail::SpamAssassin::RegistryBoundaries::uri_to_domain.
 ##
 
+###########################################################################
+
 *uri_list_canonify = \&uri_list_canonicalize;  # compatibility alias
 sub uri_list_canonicalize {
   my($redirector_patterns, @uris) = @_;
@@ -1690,6 +1694,157 @@
 
 ###########################################################################
 
+# returns ($compiled_re, $error)
+# if any errors, $compiled_re = undef, $error has string
+# args:
+# - regexp
+# - strip_delimiters (default: 1) (value 2 means, try strip, but don't error)
+# - ignore_always_matching (default: 0)
+sub compile_regexp {
+  my ($re, $strip_delimiters, $ignore_always_matching) = @_;
+  local($1);
+
+  # Do not allow already compiled regexes or other funky refs
+  if (ref($re)) {
+    return (undef, 'ref passed');
+  }
+
+  # try stripping by default
+  $strip_delimiters = 1 if !defined $strip_delimiters;
+
+  # OK, try to remove any normal perl-style regexp delimiters at
+  # the start and end, and modifiers at the end if present,
+  # so we can validate those too.
+  my $origre = $re;
+  my $delim_end = '';
+
+  if ($strip_delimiters >= 1) {
+    # most common delimiter
+    if ($re =~ s{^/}{}) {
+      $delim_end = '/';
+    }
+    # symmetric delimiters
+    elsif ($re =~ s/^(?:m|qr)([\{$\<\[])//) {
+      ($delim_end = $1) =~ tr/\{\(\<\[/\}$\>\]/;
+    }
+    # any non-wordchar delimiter, but let's ignore backslash..
+    elsif ($re =~ s/^(?:m|qr)(\W)//) {
+      $delim_end = $1;
+      if ($delim_end eq '\\') {
+        return (undef, 'backslash delimiter not allowed');
+      }
+    }
+    elsif ($strip_delimiters != 2) {
+      return (undef, 'missing regexp delimiters');
+    }
+  }
+
+  # cut end delimiter, mods
+  my $mods;
+  if ($delim_end) {
+    # Ignore e because paranoid
+    if ($re =~ s/\Q${delim_end}\E([a-df-z]*)\z//) {
+      $mods = $1;
+    } else {
+      return (undef, 'invalid end delimiter/mods');
+    }
+  }
+
+  # paranoid check for eval exec (?{foo}), in case someone
+  # actually put "use re 'eval'" somewhere..
+  if ($re =~ /$\?\??\{/) {
+    return (undef, 'eval (?{}) found');
+  }
+
+  # check unescaped delimiter, but only if it's not symmetric,
+  # those will fp on .{0,10} [xyz] etc, no need for so strict checks
+  # since these regexes don't end up in eval strings anyway
+  if ($delim_end && $delim_end !~ tr/\}$\]//) {
+    # first we remove all escaped backslashes "\\"
+    my $dbs_stripped = $re;
+    $dbs_stripped =~ s/\\\\//g;
+    # now we can properly check if something is unescaped
+    if ($dbs_stripped =~ /(?<!\\)\Q${delim_end}\E/) {
+      return (undef, "unquoted delimiter '$delim_end' found");
+    }
+  }
+
+  if ($ignore_always_matching) {
+    if (my $err = is_always_matching_regexp($re)) {
+      return (undef, "always matching regexp: $err");
+    }
+  }
+
+  # now prepend the modifiers, in order to check if they're valid
+  if ($mods) {
+    $re = '(?'.$mods.')'.$re;
+  }
+
+  # no re "strict";  # since perl 5.21.8: Ranges of ASCII printables...
+  my $compiled_re;
+  $re = untaint_var($re);
+  my $ok = eval {
+    # don't dump deprecated warnings to user STDERR
+    # but die on any other warning for safety?
+    local $SIG{__WARN__} = sub {
+      if ($_[0] !~ /deprecated/i) {
+        die "$_[0]\n";
+      }
+    };
+    $compiled_re = qr/$re/; 1;
+  };
+  if ($ok && ref($compiled_re) eq 'Regexp') {
+    #$origre = untaint_var($origre);
+    #dbg("config: accepted regex '%s' => '%s'", $origre, $compiled_re);
+    return ($compiled_re, '');
+  } else {
+    my $err = $@ ne '' ? $@ : "errno=$!"; chomp $err;
+    $err =~ s/ at .*? line \d.*$//;
+    return (undef, $err);
+  }
+}
+
+sub is_always_matching_regexp {
+  my ($re) = @_;
+
+  if ($re eq '') {
+    return "empty";
+  }
+  elsif ($re =~ /(?<!\\)\|\|/) {
+    return "contains '||'";
+  }
+  elsif ($re =~ /^\|/) {
+    return "starts with '|'";
+  }
+  elsif ($re =~ /\|(?<!\\\|)$/) {
+    return "ends with '|'";
+  }
+
+  return undef;
+}
+
+# convert compiled regexp (?^i:foo) to string (?i)foo
+sub qr_to_string {
+  my ($re) = @_;
+
+  return undef unless ref($re) eq 'Regexp';
+  $re = "".$re; # stringify
+
+  local($1);
+  $re =~ s/^$\?\^([a-z]*)://;
+  my $mods = $1;
+  $re =~ s/$\z//;
+
+  return ($mods ? "(?$mods)$re" : $re);
+}
+
+###########################################################################
+
+###
+### regexp_remove_delimiters and make_qr DEPRECATED, to be removed
+### compile_regexp() should be used everywhere
+###
+
 # Removes any normal perl-style regexp delimiters at
 # the start and end, and modifiers at the end (if present).
 # If modifiers are found, they are inserted into the pattern using
@@ -1698,27 +1853,33 @@
 sub regexp_remove_delimiters {
   my ($re) = @_;
 
+  warn("deprecated Util regexp_remove_delimiters() called\n");
+
   my $delim;
   if (!defined $re || $re eq '') {
-    warn "cannot remove delimiters from null regexp";
-    return;  # invalid
+    return undef;
   }
-  elsif ($re =~ s/^m\{//) {             # m{foo/bar}
+  elsif ($re =~ s/^m?\{//) {             # m{foo/bar}
     $delim = '}';
   }
-  elsif ($re =~ s/^m\(//) {             # m(foo/bar)
+  elsif ($re =~ s/^m?\[//) {             # m[foo/bar]
+    $delim = ']';
+  }
+  elsif ($re =~ s/^m?\(//) {             # m(foo/bar)
     $delim = ')';
   }
-  elsif ($re =~ s/^m<//) {              # m<foo/bar>
+  elsif ($re =~ s/^m?<//) {              # m<foo/bar>
     $delim = '>';
   }
-  elsif ($re =~ s/^m(\W)//) {           # m#foo/bar#
+  elsif ($re =~ s/^m?(\W)//) {           # m#foo/bar#
     $delim = $1;
   } else {                              # /foo\/bar/ or !foo/bar!
-    $re =~ s/^(\W)//; $delim = $1;
+    return undef; # invalid    
   }
 
-  $re =~ s/\Q${delim}\E([imsx]*)$// or warn "unbalanced re: $re";
+  if ($re !~ s/\Q${delim}\E([imsx]*)$//) {
+    return undef;
+  }
 
   my $mods = $1;
   if ($mods) {
@@ -1732,8 +1893,17 @@
 
 sub make_qr {
   my ($re) = @_;
+
+  warn("deprecated Util make_qr() called\n");
+
   $re = regexp_remove_delimiters($re);
-  return qr/$re/;
+  return undef if !defined $re || $re eq '';
+  my $compiled_re;
+  if (eval { $compiled_re = qr/$re/; 1; } && ref($compiled_re) eq 'Regexp') {
+    return $compiled_re;
+  } else {
+    return undef;
+  }
 }
 
 ###########################################################################
--- t/dnsbl.t	(revision 1848547)
+++ t/dnsbl.t	(working copy)
@@ -7,7 +7,7 @@ 
 plan skip_all => "Long running tests disabled" unless conf_bool('run_long_tests');
 plan skip_all => "Net tests disabled" unless conf_bool('run_net_tests');
 plan skip_all => "Can't use Net::DNS Safely" unless can_use_net_dns_safely();
-plan tests => 23;
+plan tests => 17;
 
 # ---------------------------------------------------------------------------
 # bind configuration currently used to support this test
@@ -54,7 +54,6 @@ 
  q{ <dns:14.35.17.212.dnsbltest.spamassassin.org> [127.0.0.1] } => 'P_4',
  q{ <dns:226.149.120.193.dnsbltest.spamassassin.org> [127.0.0.1] } => 'P_5',
  q{ <dns:example.com.dnsbltest.spamassassin.org> [127.0.0.2] } => 'P_6',
- q{ <dns:134.88.73.210.sb.dnsbltest.spamassassin.org?type=TXT> } => 'P_7',
  q{,DNSBL_TEST_TOP,} => 'P_8',
  q{,DNSBL_TEST_WHITELIST,} => 'P_9',
  q{,DNSBL_TEST_DYNAMIC,} => 'P_10',
@@ -63,16 +62,11 @@ 
  q{,DNSBL_TXT_TOP,} => 'P_13',
  q{,DNSBL_TXT_RE,} => 'P_14',
  q{,DNSBL_RHS,} => 'P_15',
- q{,DNSBL_SB_TIME,} => 'P_16',
- q{,DNSBL_SB_FLOAT,} => 'P_17',
- q{,DNSBL_SB_STR,} => 'P_18',
 );
 
 %anti_patterns = (
  q{,DNSBL_TEST_MISS,} => 'P_19',
  q{,DNSBL_TXT_MISS,} => 'P_20',
- q{,DNSBL_SB_UNDEF,} => 'P_21',
- q{,DNSBL_SB_MISS,} => 'P_22',
  q{ launching DNS A query for 14.35.17.212.untrusted.dnsbltest.spamassassin.org. } => 'untrusted',
 );
 
@@ -136,28 +130,6 @@ 
 describe DNSBL_RHS	DNSBL RHS match
 tflags DNSBL_RHS	net
 
-header __TEST_SENDERBASE	eval:check_rbl_txt('sb', 'sb.dnsbltest.spamassassin.org.')
-tflags __TEST_SENDERBASE	net
-
-header DNSBL_SB_TIME	eval:check_rbl_sub('sb', 'sb:S6 == 1060085863 && S6 < time')
-describe DNSBL_SB_TIME	DNSBL SenderBase time
-tflags DNSBL_SB_TIME	net
-
-header DNSBL_SB_FLOAT	eval:check_rbl_sub('sb', 'sb:S3 > 7.0 && S3 < 7.2')
-describe DNSBL_SB_FLOAT	DNSBL SenderBase floating point
-tflags DNSBL_SB_FLOAT	net
-
-header DNSBL_SB_STR	eval:check_rbl_sub('sb', 'sb:S1 eq \"Spammer Networks\" && S49 !~ /Y/ && index(S21, \".com\") > 0')
-describe DNSBL_SB_STR	DNSBL SenderBase strings
-tflags DNSBL_SB_STR	net
-
-header DNSBL_SB_UNDEF	eval:check_rbl_sub('sb', 'sb:S98 =~ /foo/ && S99 > 10')
-describe DNSBL_SB_UNDEF	DNSBL SenderBase undefined
-tflags DNSBL_SB_UNDEF	net
-
-header DNSBL_SB_MISS	eval:check_rbl_sub('sb', 'sb:S2 < 3.0')
-describe DNSBL_SB_MISS	DNSBL SenderBase miss
-tflags DNSBL_SB_MISS	net
 ");
 
 # The -D clobbers test performance but some patterns & antipatterns depend on debug output
--- t/if_can.t	(revision 1848547)
+++ t/if_can.t	(working copy)
@@ -2,7 +2,7 @@ 
 
 use lib '.'; use lib 't';
 use SATest; sa_t_init("if_can");
-use Test::More tests => 13;
+use Test::More tests => 16;
 
 # ---------------------------------------------------------------------------
 
@@ -16,6 +16,9 @@ 
         q{ SHOULD_BE_CALLED5 }, 'should_be_called5',
         q{ SHOULD_BE_CALLED6 }, 'should_be_called6',
         q{ SHOULD_BE_CALLED7 }, 'should_be_called7',
+        q{ SHOULD_BE_CALLED8 }, 'should_be_called8',
+        q{ SHOULD_BE_CALLED9 }, 'should_be_called9',
+        q{ SHOULD_BE_CALLED10 }, 'should_be_called10',
 
 );
 %anti_patterns = (
@@ -51,6 +54,15 @@ 
         if (!can(Mail::SpamAssassin::Plugin::Test::test_feature_xxxx_nosuch))
           body SHOULD_BE_CALLED7 /./
         endif
+        if can(Mail::SpamAssassin::Plugin::Test::test_feature_xxxx_true) && version > 0.00000
+          body SHOULD_BE_CALLED8 /./
+        endif
+        if !can(Mail::SpamAssassin::Plugin::Test::test_feature_xxxx_false  ) && !(! version > 0.00000)
+          body SHOULD_BE_CALLED9 /./
+        endif
+        if has(Mail::SpamAssassin::Plugin::Test::test_feature_xxxx_true) && (!can(Mail::SpamAssassin::Plugin::Test::test_feature_xxxx_nosuch))
+          body SHOULD_BE_CALLED10 /./
+        endif
 
         if !has(Mail::SpamAssassin::Plugin::Test::check_test_plugin)
           body SHOULD_NOT_BE_CALLED1 /./
--- t/mimeheader.t	(revision 1848547)
+++ t/mimeheader.t	(working copy)
@@ -2,7 +2,7 @@ 
 
 use lib '.'; use lib 't';
 use SATest; sa_t_init("mimeheader");
-use Test::More tests => 4;
+use Test::More tests => 6;
 
 $ENV{'LANGUAGE'} = $ENV{'LC_ALL'} = 'C';             # a cheat, but we need the patterns to work
 
@@ -14,12 +14,24 @@ 
   q{ MIMEHEADER_TEST2 }, q{ test2 },
   q{ MATCH_NL_NONRAW }, q{ match_nl_nonraw },
   q{ MATCH_NL_RAW }, q{ match_nl_raw },
+  q{ MIMEHEADER_FOUND }, q{ unset_found },
 
 );
 
+%anti_patterns = (
+
+  q{ MIMEHEADER_NOTFOUND }, q{ unset_notfound },
+
+);
+
+tstpre(q{
+
+  loadplugin Mail::SpamAssassin::Plugin::MIMEHeader
+
+});
+
 tstprefs (q{
 
-  # loadplugin Mail::SpamAssassin::Plugin::MIMEHeader
   mimeheader MIMEHEADER_TEST1 content-type =~ /application\/msword/
   mimeheader MIMEHEADER_TEST2 content-type =~ m!APPLICATION/MSWORD!i
 
@@ -26,6 +38,9 @@ 
   mimeheader MATCH_NL_NONRAW       Content-Type =~ /msword; name/
   mimeheader MATCH_NL_RAW   Content-Type:raw =~ /msword;\n\tname/
 
+  mimeheader MIMEHEADER_NOTFOUND xyzzy =~ /foobar/
+  mimeheader MIMEHEADER_FOUND xyzzy =~ /foobar/ [if-unset: xyzfoobarxyz]
+
 	});
 
 sarun ("-L -t < data/nice/004", \&patterns_run_cb);
--- t/regexp_valid.t	(revision 1848547)
+++ t/regexp_valid.t	(working copy)
@@ -18,55 +18,34 @@ 
 use strict;
 use lib '.'; use lib 't';
 use SATest; sa_t_init("regexp_valid");
+use Mail::SpamAssassin::Util qw(compile_regexp);
 
-use Test::More tests => 24;
+use Test::More tests => 41;
 
-# initialize SpamAssassin
-use Mail::SpamAssassin;
-my $sa = create_saobj({'dont_copy_prefs' => 1});
-$sa->init(0); # parse rules
-
-
-# make a _copy_ of the STDERR file descriptor
-# (so we can restore it after redirecting it)
-open(OLDERR, ">&STDERR") || die "Cannot copy STDERR file handle";
-
-# create a file descriptior for logging STDERR
-# (we do not want warnings for regexps we know are invalid)
-my $fh = IO::File->new_tmpfile();
-open(LOGERR, ">&".fileno($fh)) || die "Cannot create LOGERR temp file";
-
-# quiet "used only once" warnings
-1 if *OLDERR;
-1 if *LOGERR;
-
-
+my $showerr;
 sub tryone {
-  my $re = shift;
-  return $sa->{conf}->{parser}->is_regexp_valid('test', $re);
+  my ($re, $strip) = @_;
+  $strip = 1 if !defined $strip;
+  my ($rec, $err) = compile_regexp($re, $strip, 1);
+  if (!$rec && $showerr) { print STDERR "invalid regex '$re': $err\n"; }
+  return $rec;
 }
 
 # test valid regexps with this sub
 sub goodone {
-  my $re = shift;
-  open(STDERR, ">&=OLDERR") || die "Cannot reopen STDERR";
-  return tryone $re;
+  my ($re, $strip) = @_;
+  $showerr = 1;
+  return tryone($re, $strip);
 }
 
 # test invalid regexps with this sub
 sub badone {
-  my $re = shift;
-  open(STDERR, ">&=LOGERR") || die "Cannot reopen STDERR (for logging)";
-  return !tryone $re;
+  my ($re, $strip) = @_;
+  $showerr = 0;
+  return !tryone($re, $strip);
 }
 
 
-ok goodone qr/foo bar/;
-ok goodone qr/foo bar/i;
-ok goodone qr/foo bar/is;
-ok goodone qr/foo bar/im;
-ok goodone qr!foo bar!im;
-
 ok goodone 'qr/foo bar/';
 ok goodone 'qr/foo bar/im';
 ok goodone 'qr!foo bar!';
@@ -80,14 +59,38 @@ 
 ok goodone 'm(foo bar)is';
 
 ok goodone 'm<foo bar>is';
-ok goodone 'foo bar';
-ok goodone 'foo/bar';
-ok badone 'foo(bar';
+ok goodone 'foo bar', 0;
+ok goodone 'foo/bar', 0;
+ok badone 'foo(bar', 0;
+
 ok badone 'foo(?{1})bar';
-
+ok badone 'foo(??{1})bar';
 ok badone '/foo(?{1})bar/';
+ok badone '/foo(??{1})bar/';
 ok badone 'm!foo(?{1})bar!';
-# ok badone '/test//';          # removed for bug 4700
-ok goodone '.*';
+
+ok goodone '/test\//';
+ok badone '/test//';  # removed for bug 4700 - and back from 7648
+ok badone 'm!test!xyz!i';
+ok badone '//';
+ok badone 'm!|foo!';
+ok goodone 'm!\|foo!';
+ok badone 'm{bar||y}';
+
+ok goodone 'm{test}}'; # it's actually bad, but no way to parse this with simple code
+ok goodone 'm}test}}'; # it's actually bad, but no way to parse this with simple code
+ok goodone 'm{test{}'; # it's good even though perl warns unescaped { is deprecated
+ok goodone 'm}test{}';
+ok goodone 'm{test.{0,10}}';
+ok goodone 'm}test.{0,10}}';
+ok goodone 'm[foo[bar]]';
+ok badone 'm[foo[bar\]]';
+ok goodone 'm(foo(?:bar)x)';
+ok badone 'm(foo\(?:bar)x)';
+ok goodone 'm/test # comment/x';
+ok badone 'm/test # comm/ent/x'; # well you shouldn't use comments anyway
+ok goodone 'm[test # \] foo []x';
+
+ok goodone '.*', 0;
 ok goodone 'm*<a[^<]{0,60} onMouseMove=(?:3D)?"window.status=(?:3D)?\'https?://*';
 
--- t/stop_always_matching_regexps.t	(revision 1848547)
+++ t/stop_always_matching_regexps.t	(working copy)
@@ -13,20 +13,18 @@ 
 
 use lib '.'; use lib 't';
 use SATest; sa_t_init("stop_always_matching_regexps");
-use Test::More tests => 13;
+use Test::More tests => 12;
 
 # ---------------------------------------------------------------------------
 
 use strict;
 require Mail::SpamAssassin;
+use Mail::SpamAssassin::Util qw(compile_regexp);
 
-my $sa = create_saobj({'dont_copy_prefs' => 1});
-$sa->init(0);
-ok($sa);
-
 sub is_caught {
   my ($re) = @_;
-  return $sa->{conf}->{parser}->is_always_matching_regexp($re, $re);
+  my ($rec, $err) = compile_regexp($re, 0, 1);
+  return !$rec;
 }
 
 ok !is_caught 'foo|bar';

Places

File CVE-Level-issue-with-Rule-Files.patch of Package spamassassin (Revision c7b73556a0153bcce4a627d6612a6a0c)

Places