spamassassin-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From kmcgr...@apache.org
Subject svn commit: r1859130 [1/2] - in /spamassassin/trunk: lib/Mail/SpamAssassin/ lib/Mail/SpamAssassin/Conf/ lib/Mail/SpamAssassin/Plugin/ t/
Date Sun, 12 May 2019 05:42:40 GMT
Author: kmcgrail
Date: Sun May 12 05:42:40 2019
New Revision: 1859130

URL: http://svn.apache.org/viewvc?rev=1859130&view=rev
Log:
Work on improving evaluation rules for bug 7648

Modified:
    spamassassin/trunk/lib/Mail/SpamAssassin/AutoWhitelist.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Constants.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Logger.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Check.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/P595Body.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TxRep.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDetail.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/PluginHandler.pm
    spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm
    spamassassin/trunk/t/dnsbl.t
    spamassassin/trunk/t/mimeheader.t
    spamassassin/trunk/t/regexp_valid.t
    spamassassin/trunk/t/stop_always_matching_regexps.t

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/AutoWhitelist.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/AutoWhitelist.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/AutoWhitelist.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/AutoWhitelist.pm Sun May 12 05:42:40 2019
@@ -78,11 +78,10 @@ sub new {
     if ($type =~ /^([_A-Za-z0-9:]+)$/) {
       $type = untaint_var($type);
       eval '
-  	    require '.$type.';
-            $factory = '.$type.'->new();
-            1;
-           '
-      or do {
+  	require '.$type.';
+        $factory = '.$type.'->new();
+        1;
+      ' or do {
 	my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
 	warn "auto-whitelist: $eval_stat\n";
 	undef $factory;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm Sun May 12 05:42:40 2019
@@ -86,7 +86,7 @@ use Mail::SpamAssassin::NetSet;
 use Mail::SpamAssassin::Constants qw(:sa :ip);
 use Mail::SpamAssassin::Conf::Parser;
 use Mail::SpamAssassin::Logger;
-use Mail::SpamAssassin::Util qw(untaint_var idn_to_ascii);
+use Mail::SpamAssassin::Util qw(untaint_var idn_to_ascii compile_regexp);
 use File::Spec;
 
 our @ISA = qw();
@@ -2815,24 +2815,20 @@ Example: http://chkpt.zdnet.com/chkpt/wh
   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;
     }
   });
 
@@ -3065,11 +3061,9 @@ why the IP is listed, typically a hyperl
 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
@@ -3082,10 +3076,17 @@ name.
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+(?:rbl)?eval:(.*)$/) {
-        my ($rulename, $fn) = ($1, $2);
-        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)/) {
@@ -3095,25 +3096,9 @@ name.
           $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);
       }
     }
   });
@@ -3142,20 +3127,22 @@ Define a body eval test.  See above.
     is_priv => 1,
     code => sub {
       my ($self, $key, $value, $line) = @_;
-      local ($1,$2);
-      if ($value =~ /^(\S+)\s+eval:(.*)$/) {
-        my ($rulename, $fn) = ($1, $2);
-        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);
       }
     }
   });
@@ -3184,11 +3171,15 @@ points of the URI, and will also be fast
     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);
     }
   });
 
@@ -3214,15 +3205,22 @@ Define a raw-body eval test.  See above.
     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);
       }
     }
   });
@@ -3248,15 +3246,22 @@ Define a full message eval test.  See ab
     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);
       }
     }
   });
@@ -3300,15 +3305,19 @@ ignore these for scoring.
     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);
     }
   });
 
@@ -4016,12 +4025,15 @@ from SQL or LDAP, instead of passing the
     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).
@@ -4040,20 +4052,16 @@ See C<Mail::SpamAssassin::Plugin> for mo
       }
       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.
@@ -4070,15 +4078,11 @@ the filesystem.
       }
       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);
     }
   });
@@ -5048,12 +5052,7 @@ sub maybe_body_only {
 
 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 {
@@ -5236,6 +5235,7 @@ sub feature_dns_query_restriction { 1 }
 sub feature_registryboundaries { 1 } # replaces deprecated registrarboundaries
 sub feature_geodb { 1 } # if needed for some reason
 sub feature_dns_block_rule { 1 } # supports 'dns_block_rule' config option
+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)
 
 ###########################################################################

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm Sun May 12 05:42:40 2019
@@ -132,7 +132,7 @@ package Mail::SpamAssassin::Conf::Parser
 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;
@@ -142,6 +142,7 @@ use re 'taint';
 
 our @ISA = qw();
 
+my $RULENAME_RE = RULENAME_RE;
 my $ARITH_EXPRESSION_LEXER = ARITH_EXPRESSION_LEXER;
 
 ###########################################################################
@@ -513,10 +514,6 @@ sub handle_conditional {
       # replace with a method call
       $eval .= '$self->cond_clause_plugin_loaded';
     }
-    elsif ($token =~ /^Mail::SpamAssassin::\w[\w\:]+$/) { # class name
-      my $u = untaint_var($token);
-      $eval .= '"' . $u . '" ';
-    }
     elsif ($token eq 'can') {
       # replace with a method call
       $eval .= '$self->cond_clause_can';
@@ -531,23 +528,31 @@ sub handle_conditional {
     elsif ($token eq 'perl_version') {
       $eval .= $]." ";
     }
-    elsif ($token =~ /^(?:\W+|[+-]?\d+(?:\.\d+)?)$/) {
+    elsif ($token =~ /^(?:\W{1,5}|[+-]?\d+(?:\.\d+)?)$/) {
       # using tainted subr. argument may taint the whole expression, avoid
       my $u = untaint_var($token);
       $eval .= $u . " ";
     }
     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;
   }
 
@@ -575,7 +580,7 @@ sub cond_clause_plugin_loaded {
 
 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
   }
@@ -592,7 +597,7 @@ sub cond_clause_can_or_has {
 
   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";
@@ -600,7 +605,7 @@ sub cond_clause_can_or_has {
     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;
@@ -875,39 +880,40 @@ sub finish_parsing {
 
     # 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
@@ -934,6 +940,7 @@ sub finish_parsing {
       }
       else {
         $self->lint_warn("unknown type $type for $name: $text", $name);
+        next;
       }
     }
   }
@@ -1084,40 +1091,36 @@ sub find_dup_rules {
   }
 }
 
+# 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;
 }
 
 ###########################################################################
@@ -1179,7 +1182,7 @@ sub add_test {
   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;
@@ -1202,29 +1205,68 @@ sub add_test {
     }
   }
 
+  # 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_URI_TESTS ||
       $type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS ||
       $type == $Mail::SpamAssassin::Conf::TYPE_FULL_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;
   }
   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;
+    }
   }
   elsif (($type & 1) == 1) { # *_EVALS
     # create eval_to_rule mappings
@@ -1297,10 +1339,10 @@ sub is_meta_valid {
 
   # $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;
   }
 
@@ -1311,24 +1353,27 @@ sub is_meta_valid {
       print "$name $_\n "  or die "Error writing token: $!";
     }
   }
+
   # 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 (decimal) number or a string of 1 or 2 punctuation
     # characters (i.e. operators) tack it onto the degenerate rule
-    elsif ( $token =~ /^(\d+(?:\.\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 $name 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;
   }
@@ -1339,104 +1384,21 @@ sub is_meta_valid {
   return 0;
 }
 
+# Deprecated functions, leave just in case..
 sub is_delimited_regexp_valid {
-  my ($self, $name, $re) = @_;
-
-  local ($1,$2);
-  $re ||= '';
-  # Check most common delimiter format first
-  # Make re/mods args here for is_regexp_valid, so it doesn't need to again
-  if ($re =~ m!^/(.*)/([a-z]*)$!) {
-      return $self->is_regexp_valid($name, $1, $2, $re);
-  }
-  # Check other delimiters
-  if ($re !~ /^m([\W]).*(?:\1|>|}|\)|\])[a-z]*$/) {
-    $self->lint_warn("config: invalid regexp for rule $name: $re: missing or invalid delimiters\n");
-    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, $mods, $origre) = @_;
-
-  # 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.
-  if (!defined $origre) {
-    local ($1,$2);
-    $origre = $re;
-    if ($re =~ s{^/(.*)/([a-z]*)\z}{$1}) {
-      $mods = $2;
-    }
-    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\(// && $re =~ s/\)([a-z]*)\z//) {
-      $mods = $1;
-    }
-    elsif ($re =~ s/^m<// && $re =~ s/>([a-z]*)\z//) {
-      $mods = $1;
-    }
-    elsif ($re =~ s/^m(\W)(.*)\1([a-z]*)\z/$2/) {
-      $mods = $3;
-    }
-  }
-
-  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\n";
-        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 eq '') {
-    return "config: empty regexp for rule $name always matches";
-  }
-  elsif ($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;
 }
 

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Constants.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Constants.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Constants.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Constants.pm Sun May 12 05:42:40 2019
@@ -32,7 +32,7 @@ our(@BAYES_VARS, @IP_VARS, @SA_VARS, %EX
 
 # 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 @@ BEGIN {
 	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 = (
@@ -400,4 +400,7 @@ use constant CHARSETS_LIKELY_TO_FP_AS_CA
 	  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;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm Sun May 12 05:42:40 2019
@@ -275,30 +275,6 @@ sub process_dnsbl_set {
       # test for exact equality, not a regexp (an IPv4 address)
       $self->dnsbl_hit($rule, $question, $answer)  if $subtest eq $rdatastr;
     }
-    # senderbase
-    elsif ($subtest =~ s/^sb://) {
-      # SB rules are not available to users
-      if ($self->{conf}->{user_defined_rules}->{$rule}) {
-        dbg("dns: skipping rule '$rule': not supported when user-defined");
-        next;
-      }
-
-      $rdatastr =~ s/^\d+-//;
-      my %sb = ($rdatastr =~ m/(?:^|\|)(\d+)=([^|]+)/g);
-      my $undef = 0;
-      while ($subtest =~ m/\bS(\d+)\b/g) {
-	if (!defined $sb{$1}) {
-	  $undef = 1;
-	  last;
-	}
-	$subtest =~ s/\bS(\d+)\b/\$sb{$1}/;
-      }
-
-      # untaint. (bug 3325)
-      $subtest = untaint_var($subtest);
-
-      $self->got_hit($rule, "SenderBase: ", ruletype => "dnsbl") if !$undef && eval $subtest;
-    }
     # bitmask
     elsif ($subtest =~ /^\d+$/) {
       # Bug 6803: response should be within 127.0.0.0/8, ignore otherwise
@@ -310,8 +286,11 @@ sub process_dnsbl_set {
     }
     # regular expression
     else {
-      my $test = qr/$subtest/;
-      if ($rdatastr =~ /$test/) {
+      my $test;
+      eval { $test = qr/$subtest/; } or do {
+        dbg("dns: invalid rule $rule subtest regexp '$subtest'");
+      };
+      if ($test && $rdatastr =~ $test) {
 	$self->dnsbl_hit($rule, $question, $answer);
       }
     }
@@ -412,8 +391,13 @@ sub init_rbl_subs {
     foreach my $rule (@{$self->{conf}->{eval_to_rule}->{check_rbl_sub}}) {
       next if !exists $self->{conf}->{rbl_evals}->{$rule};
       next if !$self->{conf}->{scores}->{$rule};
-      (undef, my @args) = @{$self->{conf}->{rbl_evals}->{$rule}};
-      $self->{rbl_subs}{$args[0]}{$args[1]} = $rule;
+      # rbl_evals is [$function,[@args]]
+      my $args = $self->{conf}->{rbl_evals}->{$rule}->[1];
+      if ($args->[1] =~ /^sb:/) {
+        info("dns: ignored $rule, SenderBase rules are deprecated");
+        next;
+      }
+      $self->{rbl_subs}{$args->[0]}{$args->[1]} = $rule;
     }
   }
 }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Logger.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Logger.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Logger.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Logger.pm Sun May 12 05:42:40 2019
@@ -265,6 +265,8 @@ sub add {
   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;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm Sun May 12 05:42:40 2019
@@ -187,14 +187,34 @@ sub new {
     @message = split(/^/m, $message, -1);
   }
 
-  # Pull off mbox and mbx separators
-  # also deal with null messages
+  # Deal with null message
   if (!@message) {
     # bug 4884:
     # if we get here, it means that the input was null, so fake the message
     # content as a single newline...
     @message = ("\n");
-  } elsif ($message[0] =~ /^From\s+(?!:)/) {
+  }
+
+  # Bug 7648:
+  # Make sure the message is tainted. When linting, @testmsg is not, so this
+  # handles that. Perhaps 3rd party tools could call this with untainted
+  # messages? Tainting the message is important because it prevents certain
+  # exploits later.
+  if (Mail::SpamAssassin::Util::am_running_in_taint_mode() &&
+        grep { !Scalar::Util::tainted($_) } @message) {
+    local($_);
+    # To preserve newlines, no joining and splitting here, process each line
+    # directly as is.
+    foreach (@message) {
+      $_ = Mail::SpamAssassin::Util::taint_var($_);
+    }
+    if (grep { !Scalar::Util::tainted($_) } @message) {
+      die "Mail::SpamAssassin::Message failed to enforce message taintness";
+    }
+  }
+
+  # Pull off mbox and mbx separators
+  if ($message[0] =~ /^From\s+(?!:)/) {
     # careful not to confuse with obsolete syntax which allowed WSP before ':'
     # mbox formated mailbox
     $self->{'mbox_sep'} = shift @message;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm Sun May 12 05:42:40 2019
@@ -272,7 +272,6 @@ sub new {
     'deadline_exceeded' => 0,  # time limit exceeded, skipping further tests
     'tmpfiles'          => { },
   };
-  #$self->{main}->{use_rule_subs} = 1;
 
   dbg("check: pms new, time limit in %.3f s",
       $self->{master_deadline} - time)  if $self->{master_deadline};

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm Sun May 12 05:42:40 2019
@@ -1641,8 +1641,14 @@ sub learner_new {
   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

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm Sun May 12 05:42:40 2019
@@ -29,7 +29,7 @@ package Mail::SpamAssassin::Plugin::Body
 
 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);
@@ -162,8 +162,12 @@ NEXT_RULE:
   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) {
@@ -187,7 +191,7 @@ NEXT_RULE:
     }
 
     # 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) {
@@ -424,11 +428,14 @@ sub simplify_and_qr_regexp {
   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]*)\)//) {
@@ -702,7 +709,7 @@ sub extract_hints {
     $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 {

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Check.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Check.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Check.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Check.pm Sun May 12 05:42:40 2019
@@ -28,6 +28,9 @@ use Mail::SpamAssassin::Constants qw(:sa
 
 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 @@ sub run_rbl_eval_tests {
 
     %{$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 index($eval_stat, '__alarm__ignore__') >= 0;
@@ -334,6 +341,7 @@ sub run_generic_tests {
     $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 @@ sub do_meta_tests {
     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 @@ sub do_meta_tests {
     # 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 @@ sub do_meta_tests {
         # 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 @@ sub do_head_tests {
     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;
-      }
-      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)
+    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;
-    } else {
-      warn "rules: unrecognized rule: $rulename\n";
-      $pms->{rule_errors}++;
-      next;
+      if (exists $conf->{test_opt_neg}->{$rulename}) {
+        $op = '!defined';
+      } else {
+        $op = 'defined';
+      }
+    }
+    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 @@ sub do_head_tests {
                            (!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 @@ sub do_head_tests {
             $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 @@ sub do_head_tests {
                 $whlimit = ' && $hits++ < '.untaint_var($1);
               }
             }
-            $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 @@ sub do_head_tests {
             '.$self->ran_rule_plugin_code($rulename, "header").'
           }
           ');
-        }
       }
       $self->pop_evalstr_prefix();
     }
@@ -823,7 +785,6 @@ sub do_body_tests {
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my $sub = '';
     if ($would_log_rules_all) {
       $sub .= '
@@ -841,7 +802,7 @@ sub do_body_tests {
       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) . '
@@ -856,38 +817,20 @@ sub do_body_tests {
       $sub .= '
       foreach my $l (@_) {
         '.$self->hash_line_for_rule($pms, $rulename).'
-        if ($l =~ '.$pat.') { 
-          $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body"); 
+        if ($l =~ $qrptr->{q{'.$rulename.'}}) {
+          $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body");
           '. $self->hit_rule_plugin_code($pms, $rulename, "body", "last") .'
         }
       }
       ';
     }
 
-    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").'
-        }
-      ');
-    }
-
-    next 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.' }');
-    }
+    $self->add_evalstr($pms, '
+      if ($scoresptr->{q{'.$rulename.'}}) {
+        '.$sub.'
+        '.$self->ran_rule_plugin_code($rulename, "body").'
+      }
+    ');
   }
   );
 }
@@ -909,7 +852,6 @@ sub do_uri_tests {
     loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my $sub = '';
     if ($would_log_rules_all) {
       $sub .= '
@@ -925,7 +867,7 @@ sub do_uri_tests {
       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) . '
@@ -937,7 +879,7 @@ sub do_uri_tests {
       $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") .'
         }
@@ -945,30 +887,12 @@ sub do_uri_tests {
       ';
     }
 
-    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").'
-        }
-      ');
-    }
-
-    next 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.' }');
-    }
+    $self->add_evalstr($pms, '
+      if ($scoresptr->{q{'.$rulename.'}}) {
+        '.$sub.'
+        '.$self->ran_rule_plugin_code($rulename, "uri").'
+      }
+    ');
   }
   );
 }
@@ -986,7 +910,6 @@ sub do_rawbody_tests {
     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 .= '
@@ -1004,7 +927,7 @@ sub do_rawbody_tests {
       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) . '
@@ -1017,7 +940,7 @@ sub do_rawbody_tests {
       $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") . '
         }
@@ -1025,30 +948,15 @@ sub do_rawbody_tests {
       ';
     }
 
-    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.' }');
-    }
   }
   );
 }
@@ -1073,7 +981,6 @@ sub do_full_tests {
                 loop_body => sub
   {
     my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
-    $pat = untaint_var($pat);  # presumably checked
     my ($max) = ($conf->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
     $max = untaint_var($max);
     $self->add_evalstr($pms, '
@@ -1082,7 +989,7 @@ sub do_full_tests {
         '.$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") . '
         }
@@ -1100,7 +1007,7 @@ sub do_head_eval_tests {
   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 {
@@ -1108,8 +1015,7 @@ sub do_body_eval_tests {
   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 {
@@ -1117,8 +1023,7 @@ sub do_rawbody_eval_tests {
   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 {
@@ -1126,12 +1031,11 @@ sub do_full_eval_tests {
   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}) {
@@ -1166,7 +1070,7 @@ sub run_eval_tests {
       && !$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";
@@ -1180,24 +1084,23 @@ sub run_eval_tests {
   }
 
   # 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/) {
@@ -1209,33 +1112,34 @@ sub run_eval_tests {
       }
     }
  
-    $test = untaint_var($test);  # presumably checked
-    my ($function, $argstr) = ($test,'');
-    if ($test =~ s/^([^,]+)(,.*)$//gs) {
-      ($function, $argstr) = ($1,$2);
-    }
-
+    # skip if score zeroed
+    next if !$scoresref->{$rulename};
+ 
+    my $function = untaint_var($test->[0]); # was validated with \w+
     if (!$function) {
-      warn "rules: error: no function defined for $rulename";
+      warn "rules: error: no eval function defined for $rulename";
       next;
     }
  
+    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}) {
       # 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
@@ -1243,47 +1147,41 @@ sub run_eval_tests {
     if ($have_start_rules) {
       # XXX - should we use helper function here?
       $evalstr .= '
-
         $self->{main}->call_plugins("start_rules", {
                 permsgstatus => $self,
                 ruletype => "eval",
                 priority => '.$priority.'
               });
 
-      ';
+';
     }
- 
-    $evalstr .= '
 
+    $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 index($@, "__alarm__ignore__") >= 0;
         $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!
@@ -1295,16 +1193,15 @@ sub run_eval_tests {
 {
   package $package_name;
 
-    sub ${methodname} {
-      my (\$self, \@extraevalargs) = \@_;
-
-      my \$scoresptr = \$self->{conf}->{scores};
-      my \$prepend2desc = q#$prepend2desc#;
-      my \$rulename;
-      my \$result;
+  sub ${methodname} {
+    my (\$self, \@extraevalargs) = \@_;
 
-      $evalstr
-    }
+    my \$testptr = \$self->{conf}->{$evalname}->{$priority};
+    my \$prepend2desc = q#$prepend2desc#;
+    my \$rulename;
+    my \$result;
+    $evalstr
+  }
 
   1;
 }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm Sun May 12 05:42:40 2019
@@ -24,7 +24,7 @@ use re 'taint';
 
 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 new {
 
 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_test {
 
 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_eval {
 
 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;
     }
   }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm Sun May 12 05:42:40 2019
@@ -65,12 +65,15 @@ use re 'taint';
 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 @@ sub set_config {
     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;
-
-      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;
+      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;
+      }
 
       $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 @@ sub set_config {
       # 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 @@ sub set_config {
       $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 @@ sub eval_hook_called {
 
 
   my $getraw;
-  if ($hdr =~ s/:raw$//i) {
+  if ($hdr =~ s/:raw$//) {
     $getraw = 1;
   } else {
     $getraw = 0;
@@ -188,9 +201,9 @@ sub eval_hook_called {
     } 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);
     }
   }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/P595Body.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/P595Body.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/P595Body.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/P595Body.pm Sun May 12 05:42:40 2019
@@ -70,10 +70,12 @@ sub setup_test_set_pri {
 
   my $alternates = [];
   while (my ($rule, $pat) = each %{$conf->{body_tests}->{$pri}}) {
-    $pat = Mail::SpamAssassin::Util::regexp_remove_delimiters($pat);
-
     # ignore rules marked for ReplaceTags work!
-    next if ($conf->{rules_to_replace}->{$rule});
+    next if ($conf->{replace_rules}->{$rule});
+
+    #$pat = Mail::SpamAssassin::Util::regexp_remove_delimiters($pat);
+    $pat = qr_to_string($conf->{test_qrs}->{$rule});
+    next unless !$pat;
 
     # use the REGMARK feature:
     # see http://taint.org/2006/11/16/154546a.html#comment-1011

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm Sun May 12 05:42:40 2019
@@ -142,7 +142,7 @@ package Mail::SpamAssassin::Plugin::PDFI
 
 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 @@ sub pdf_name_regex {
   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 @@ sub pdf_match_details {
   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;
   }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm Sun May 12 05:42:40 2019
@@ -51,6 +51,7 @@ package Mail::SpamAssassin::Plugin::Repl
 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
+use Mail::SpamAssassin::Util qw(compile_regexp qr_to_string);
 
 use strict;
 use warnings;
@@ -72,6 +73,16 @@ sub new {
   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) = @_;
 
@@ -81,94 +92,96 @@ sub finish_parsing_end {
   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};
-
-        if (would_log('dbg', 'replacetags') > 1) {
-          dbg("replacetags: replacing $rule: $re");
-        }
-
-        my $passes = 0;
-        my $doagain;
+  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 (!exists $conf->{test_qrs}->{$rule}) {
+      dbg("replacetags: replace requested for non-existing rule: $rule\n");
+      next;
+    }
 
-        do {
-          my $pre_name;
-          my $post_name;
-          my $inter_name;
-          $doagain = 0;
-
-          # 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;
-          }
+    my $re = qr_to_string($conf->{test_qrs}->{$rule});
+    next unless defined $re;
+    my $origre = $re;
+
+    my $passes = 0;
+    my $doagain;
+
+    do {
+      my $pre_name;
+      my $post_name;
+      my $inter_name;
+      $doagain = 0;
+
+      # 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;
+      }
 
-          # 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 =~ /<[^>]+>/;
-                }
-              }
+      # 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 =~ /<[^>]+>/;
             }
           }
+        }
+      }
 
-          $re = join('', @re);
-
-          # do the actual replacement
-          $conf->{$type}->{$priority}->{$rule} = $re;
+      $re = join('', @re);
 
-          if (would_log('dbg', 'replacetags') > 1) {
-            dbg("replacetags: replaced $rule: $re");
-          }
+      $passes++;
+    } while $doagain && $passes <= 5;
 
-          $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 {
@@ -249,6 +262,7 @@ body, header, uri, full, rawbody tests a
   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) = @_;
@@ -258,8 +272,8 @@ body, header, uri, full, rawbody tests a
       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;
       }
     }
   });

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm Sun May 12 05:42:40 2019
@@ -38,6 +38,7 @@ package Mail::SpamAssassin::Plugin::Rule
 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,24 +121,25 @@ sub setup_test_set_pri {
 
   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;
     }
 
     # 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;
     }

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TxRep.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TxRep.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TxRep.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TxRep.pm Sun May 12 05:42:40 2019
@@ -1413,7 +1413,7 @@ sub check_reputation {
   my ($self, $storage, $pms, $key, $id, $ip, $signedby, $msgscore) = @_;
 
   my $delta  = 0;
-  my $weight = ($key eq 'MSG_ID')? 1 : eval('$pms->{main}->{conf}->{txrep_weight_'.lc($key).'}');
+  my $weight = ($key eq 'MSG_ID') ? 1 : $pms->{main}->{conf}->{'txrep_weight_'.lc($key)};
 
 #  {
 #    #Bug 7164, trying to find out reason for these: _WARN: Use of uninitialized value $msgscore in addition (+) at /usr/share/perl5/vendor_perl/Mail/SpamAssassin/Plugin/TxRep.pm line 1415.
@@ -1638,12 +1638,13 @@ sub open_storages {
     $factory = $self->{main}->{pers_addr_list_factory};
   } else {
     my $type = $self->{conf}->{txrep_factory};
-    if ($type =~ /^([_A-Za-z0-9:]+)$/) {
+    if ($type =~ /^[_A-Za-z0-9:]+$/) {
         $type = untaint_var($type);
-        eval 'require    '.$type.';
-            $factory = '.$type.'->new();
-            1;'
-        or do {
+        eval '
+          require '.$type.';
+          $factory = '.$type.'->new();
+          1;
+        ' or do {
             my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
             warn "TxRep: $eval_stat\n";
             undef $factory;

Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDetail.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDetail.pm?rev=1859130&r1=1859129&r2=1859130&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDetail.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDetail.pm Sun May 12 05:42:40 2019
@@ -68,7 +68,7 @@ Regular expressions should be delimited
 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 @@ sub set_config {
 	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);
-	}
-	else {
-	    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
+
+	my ($rec, $err) = compile_regexp($pattern, 1);
+	if (!$rec) {
+	  dbg("config: uri_detail invalid regexp '$pattern': $err");
+	  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 @@ sub check_uri_detail {
 
     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 @@ sub check_uri_detail {
       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 @@ sub check_uri_detail {
       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 @@ sub check_uri_detail {
       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 @@ sub check_uri_detail {
       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);
@@ -235,29 +236,5 @@ sub check_uri_detail {
 }
 
 # ---------------------------------------------------------------------------
-
-# 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;



Mime
View raw message