Version in base suite: 3.4.2-1 Base version: spamassassin_3.4.2-1 Target version: spamassassin_3.4.2-1+deb10u1 Base file: /srv/ftp-master.debian.org/ftp/pool/main/s/spamassassin/spamassassin_3.4.2-1.dsc Target file: /srv/ftp-master.debian.org/policy/pool/main/s/spamassassin/spamassassin_3.4.2-1+deb10u1.dsc changelog | 11 patches/CVE-2018-11805 | 2917 +++++++++++++++++++++++++++++++++++++++++++++++++ patches/CVE-2019-12420 | 31 patches/series | 2 4 files changed, 2961 insertions(+) diff -Nru spamassassin-3.4.2/debian/changelog spamassassin-3.4.2/debian/changelog --- spamassassin-3.4.2/debian/changelog 2018-10-01 06:44:58.000000000 +0000 +++ spamassassin-3.4.2/debian/changelog 2019-12-13 04:26:44.000000000 +0000 @@ -1,3 +1,14 @@ +spamassassin (3.4.2-1+deb10u1) buster-security; urgency=high + + * Security update to address CVE-2018-11805. Malicious rule or configuration + files, possibly downloaded from an updates server, could execute arbitrary + commands under multiple scenarios. (Closes: 946652) + * Security update to address CVE-2019-12420. Messages can be crafted in a + way to use excessive resources, resulting in a denial of service. + (Closes: 946653) + + -- Noah Meyerhans Thu, 12 Dec 2019 20:26:44 -0800 + spamassassin (3.4.2-1) unstable; urgency=medium * New upstream release fixes multiple security vulnerabilities diff -Nru spamassassin-3.4.2/debian/patches/CVE-2018-11805 spamassassin-3.4.2/debian/patches/CVE-2018-11805 --- spamassassin-3.4.2/debian/patches/CVE-2018-11805 1970-01-01 00:00:00.000000000 +0000 +++ spamassassin-3.4.2/debian/patches/CVE-2018-11805 2019-12-13 04:26:44.000000000 +0000 @@ -0,0 +1,2917 @@ +Description: Patch for CVE-2018-11805 + Malicious rules could execute arbitrary commands under multiple circumstances. +Author: Henrik Krohns +Origin: upstream +Bug: https://bz.apache.org/SpamAssassin/show_bug.cgi?id=7648 +--- +This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Conf/Parser.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Conf/Parser.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Conf/Parser.pm +@@ -137,7 +137,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; +@@ -147,6 +147,9 @@ use re 'taint'; + + our @ISA = qw(); + ++my $RULENAME_RE = RULENAME_RE; ++my $ARITH_EXPRESSION_LEXER = ARITH_EXPRESSION_LEXER; ++ + ########################################################################### + + sub new { +@@ -508,13 +511,12 @@ sub handle_conditional { + 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 @@ sub handle_conditional { + $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_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 + } +@@ -591,7 +601,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"; +@@ -599,7 +609,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; +@@ -878,39 +888,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 +@@ -937,6 +948,7 @@ sub finish_parsing { + } + else { + $self->lint_warn("unknown type $type for $name: $text", $name); ++ next; + } + } + } +@@ -988,8 +1000,7 @@ sub _meta_deps_recurse { + 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 @@ 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; + } + + ########################################################################### +@@ -1183,7 +1190,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; +@@ -1206,29 +1213,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_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,37 +1339,33 @@ 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; + } + + # 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 rule token: $token", $name); ++ return 0; + } + } ++ $meta = untaint_var($meta); # was carefully checked + my $evalstr = 'my $x = ' . $meta . '; 1;'; + if (eval $evalstr) { + return 1; +@@ -1335,94 +1377,21 @@ sub is_meta_valid { + 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([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 =~ /(? '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 @@ 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 +@@ -3001,11 +2997,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); +- 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 @@ 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); + } + } + }); +@@ -3063,22 +3049,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); +- 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 @@ 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); + } + }); + +@@ -3138,15 +3128,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); + } + } + }); +@@ -3172,15 +3169,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); + } + } + }); +@@ -3225,15 +3229,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); + } + }); + +@@ -4171,12 +4179,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 is the perl module ++Load a SpamAssassin plugin module. The C is the perl module + name, used to create the plugin object itself. + +-C 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 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 @@ See C 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, but silently ignored if the .pm file cannot be found in + the filesystem. +@@ -4225,15 +4232,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); + } + }); +@@ -5011,12 +5014,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 { +@@ -5197,6 +5195,7 @@ sub feature_bug6558_free { 1 } + 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) + + ########################################################################### +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Constants.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Constants.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Constants.pm +@@ -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 { + 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 @@ 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; +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Dns.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Dns.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Dns.pm +@@ -139,6 +139,12 @@ sub do_rbl_lookup { + # 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; + } + +@@ -307,30 +313,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 +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Logger.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Logger.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Logger.pm +@@ -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; +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Message.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Message.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Message.pm +@@ -188,14 +188,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; +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/PerMsgStatus.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/PerMsgStatus.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/PerMsgStatus.pm +@@ -269,7 +269,6 @@ sub new { + '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}; +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Bayes.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/Bayes.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Bayes.pm +@@ -1644,8 +1644,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 +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm +@@ -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); +@@ -152,8 +152,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) { +@@ -177,7 +181,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) { +@@ -408,11 +412,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]*)\)//) { +@@ -686,7 +693,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 { +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Check.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/Check.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Check.pm +@@ -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 $eval_stat =~ /__alarm__ignore__/; +@@ -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 { + $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 @@ sub do_head_tests { + '.$self->ran_rule_plugin_code($rulename, "header").' + } + '); +- } + } + $self->pop_evalstr_prefix(); + } +@@ -820,7 +782,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('dbg', 'rules-all') == 2) { + $sub .= ' +@@ -838,7 +799,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) . ' +@@ -853,7 +814,7 @@ sub do_body_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.'}, "BODY: ", ruletype => "body"); + '. $self->hit_rule_plugin_code($pms, $rulename, "body", "last") .' + } +@@ -861,30 +822,15 @@ sub do_body_tests { + '; + } + +- 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 @@ 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('dbg', 'rules-all') == 2) { + $sub .= ' +@@ -918,7 +863,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) . ' +@@ -930,7 +875,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") .' + } +@@ -938,30 +883,15 @@ 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").' +- } +- '); +- } ++ $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 @@ 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 .= ' +@@ -997,7 +926,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) . ' +@@ -1010,7 +939,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") . ' + } +@@ -1018,30 +947,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.' }'); +- } + } + ); + } +@@ -1066,7 +980,6 @@ sub do_full_tests { + 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 @@ 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") . ' + } +@@ -1093,7 +1006,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 { +@@ -1101,8 +1014,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 { +@@ -1110,8 +1022,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 { +@@ -1119,12 +1030,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}) { +@@ -1159,7 +1069,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"; +@@ -1173,24 +1083,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/) { +@@ -1201,34 +1110,35 @@ sub run_eval_tests { + 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}) { + # 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,47 +1146,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 $@ =~ /__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,16 +1192,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; + } +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/HTMLEval.pm +@@ -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; + } + } +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/MIMEHeader.pm +@@ -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); + } + } +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/PDFInfo.pm +@@ -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; + } +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/ReplaceTags.pm +@@ -52,6 +52,7 @@ package Mail::SpamAssassin::Plugin::Repl + 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 @@ 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) = @_; + +@@ -82,94 +93,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 { +@@ -250,6 +263,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) = @_; +@@ -259,8 +273,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; + } + } + }); +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/Rule2XSBody.pm +@@ -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; + } +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/URIDetail.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Plugin/URIDetail.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Plugin/URIDetail.pm +@@ -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; +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/PluginHandler.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/PluginHandler.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/PluginHandler.pm +@@ -74,6 +74,13 @@ sub new { + 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 @@ sub load_plugin { + + 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. +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Util.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Util.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Util.pm +@@ -57,7 +57,8 @@ our @EXPORT_OK = qw(&local_tz &base64_de + &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 @@ with Perl. + 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 @@ sub secure_tmpdir { + ## 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 @@ sub trap_sigalrm_fully { + + ########################################################################### + ++# 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 =~ /(? '%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 =~ /(? ++ elsif ($re =~ s/^m? + $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 regexp_remove_delimiters { + + 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; ++ } + } + + ########################################################################### +Index: spamassassin-3.4.2/t/dnsbl.t +=================================================================== +--- spamassassin-3.4.2.orig/t/dnsbl.t ++++ spamassassin-3.4.2/t/dnsbl.t +@@ -7,7 +7,7 @@ use Test::More; + 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,25 +54,19 @@ EOF + q{ [127.0.0.1] } => 'P_4', + q{ [127.0.0.1] } => 'P_5', + q{ [127.0.0.2] } => 'P_6', +- q{ } => 'P_7', +- q{,DNSBL_TEST_TOP,} => 'P_8', +- q{,DNSBL_TEST_WHITELIST,} => 'P_9', +- q{,DNSBL_TEST_DYNAMIC,} => 'P_10', +- q{,DNSBL_TEST_SPAM,} => 'P_11', +- q{,DNSBL_TEST_RELAY,} => 'P_12', +- 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', ++ q{ DNSBL_TEST_TOP } => 'P_8', ++ q{ DNSBL_TEST_WHITELIST } => 'P_9', ++ q{ DNSBL_TEST_DYNAMIC } => 'P_10', ++ q{ DNSBL_TEST_SPAM } => 'P_11', ++ q{ DNSBL_TEST_RELAY } => 'P_12', ++ q{ DNSBL_TXT_TOP } => 'P_13', ++ q{ DNSBL_TXT_RE } => 'P_14', ++ q{ DNSBL_RHS } => 'P_15', + ); + + %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{ DNSBL_TEST_MISS } => 'P_19', ++ q{ DNSBL_TXT_MISS } => 'P_20', + q{ launching DNS A query for 14.35.17.212.untrusted.dnsbltest.spamassassin.org. } => 'untrusted', + ); + +@@ -136,28 +130,6 @@ header DNSBL_RHS eval:check_rbl_from_hos + 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 +Index: spamassassin-3.4.2/t/if_can.t +=================================================================== +--- spamassassin-3.4.2.orig/t/if_can.t ++++ spamassassin-3.4.2/t/if_can.t +@@ -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 @@ use Test::More tests => 13; + 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 @@ tstlocalrules (q{ + 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 /./ +Index: spamassassin-3.4.2/t/mimeheader.t +=================================================================== +--- spamassassin-3.4.2.orig/t/mimeheader.t ++++ spamassassin-3.4.2/t/mimeheader.t +@@ -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,18 +14,33 @@ $ENV{'LANGUAGE'} = $ENV{'LC_ALL'} = 'C'; + 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 + + 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); +Index: spamassassin-3.4.2/t/regexp_valid.t +=================================================================== +--- spamassassin-3.4.2.orig/t/regexp_valid.t ++++ spamassassin-3.4.2/t/regexp_valid.t +@@ -18,55 +18,34 @@ if (-e 'test_dir') { # runnin + 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; +- +-# 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; +- ++use Test::More tests => 41; + ++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 'mis'; +-ok goodone 'foo bar'; +-ok goodone 'foo/bar'; +-ok badone 'foo(bar'; +-ok badone 'foo(?{1})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* 13; ++use Test::More tests => 12; + + # --------------------------------------------------------------------------- + + use strict; + require Mail::SpamAssassin; +- +-my $sa = create_saobj({'dont_copy_prefs' => 1}); +-$sa->init(0); +-ok($sa); ++use Mail::SpamAssassin::Util qw(compile_regexp); + + 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'; diff -Nru spamassassin-3.4.2/debian/patches/CVE-2019-12420 spamassassin-3.4.2/debian/patches/CVE-2019-12420 --- spamassassin-3.4.2/debian/patches/CVE-2019-12420 1970-01-01 00:00:00.000000000 +0000 +++ spamassassin-3.4.2/debian/patches/CVE-2019-12420 2019-12-13 04:26:44.000000000 +0000 @@ -0,0 +1,31 @@ +Description: Limit checked mime parts +Origin: upstream, https://svn.apache.org/viewvc/spamassassin/branches/3.4/lib/Mail/SpamAssassin/Message.pm?r1=1866128&r2=1866127&pathrev=1866128&view=patch +Forwarded: not-needed +--- +This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ +Index: spamassassin-3.4.2/lib/Mail/SpamAssassin/Message.pm +=================================================================== +--- spamassassin-3.4.2.orig/lib/Mail/SpamAssassin/Message.pm ++++ spamassassin-3.4.2/lib/Mail/SpamAssassin/Message.pm +@@ -896,6 +896,7 @@ sub _parse_multipart { + my $header; + my $part_array; + my $found_end_boundary; ++ my $partcnt = 0; + + my $line_count = @{$body}; + foreach ( @{$body} ) { +@@ -968,6 +969,13 @@ sub _parse_multipart { + } + } + ++ # Maximum parts to process ++ if (++$partcnt == 1000) { ++ dbg("message: mimepart limit exceeded, stopping parsing"); ++ $self->{'mimepart_limit_exceeded'} = 1; ++ return; ++ } ++ + # make sure we start with a new clean node + $in_body = 0; + $part_msg = Mail::SpamAssassin::Message::Node->new({ normalize=>$self->{normalize} }); diff -Nru spamassassin-3.4.2/debian/patches/series spamassassin-3.4.2/debian/patches/series --- spamassassin-3.4.2/debian/patches/series 2018-10-01 06:44:58.000000000 +0000 +++ spamassassin-3.4.2/debian/patches/series 2019-12-13 04:26:44.000000000 +0000 @@ -4,3 +4,5 @@ 90_pod_cleanup 98_sa-compile-quiet bug_766718-net-dns-vers +CVE-2018-11805 +CVE-2019-12420