view release on metacpan or  search on metacpan

lib/Mail/SpamAssassin/Conf/Parser.pm  view on Meta::CPAN

      # Strictly controlled form:
      if ($token =~ /^(?:\w+::){0,10}\w+$/) {
        # trunk Dmarc.pm was renamed to DMARC.pm
        # (same check also in Conf.pm loadplugin)
        if ($token eq 'Mail::SpamAssassin::Plugin::Dmarc') {
          $token = 'Mail::SpamAssassin::Plugin::DMARC';
        }
        # backwards compatible - removed in 4.1
        # (same check also in Conf.pm loadplugin)
        elsif ($token eq 'Mail::SpamAssassin::Plugin::WhiteListSubject') {
          $token = 'Mail::SpamAssassin::Plugin::WelcomeListSubject';
        }
        my $u = untaint_var($token);
        $eval .= "'$u'";
      } else {
        my $msg = "config: not allowed value '$token' ".
            "in $self->{currentfile} (line $self->{linenum}{$self->{currentfile}})";
        $self->lint_warn($msg, undef);
        return;
      }
    }
    else {
      my $msg = "config: unparseable value '$token' ".
          "in $self->{currentfile} (line $self->{linenum}{$self->{currentfile}})";
      $self->lint_warn($msg, undef);
      return;
    }
  }

  push (@{$if_stack_ref}, {
      'type' => $key,
      'conditional' => $value,
      'skip_parsing' => $$skip_parsing_ref,
      'linenum' => $self->{linenum}{$self->{currentfile}}
    });

  if (eval $eval) {
    $self->{cond_cache}{"$key $value"} = 1;
    # leave $skip_parsing as-is; we may not be parsing anyway in this block.
    # in other words, support nested 'if's and 'require_version's
  } else {
    if ($@) {
      my $msg = "config: error parsing conditional ".
          "in $self->{currentfile} (line $self->{linenum}{$self->{currentfile}}): $eval ($@)";
      warn $msg;
      $self->lint_warn($msg, undef, 0); # not fatal?
    }
    $self->{cond_cache}{"$key $value"} = 0;
    $$skip_parsing_ref = 1;
  }
}

# functions supported in the "if" eval:
sub cond_clause_plugin_loaded {
  return 1 if $_[1] eq 'Mail::SpamAssassin::Plugin::RaciallyCharged'; # removed in 4.1
  return $_[0]->{conf}->{plugins_loaded}->{$_[1]};
}

sub cond_clause_can {
  my ($self, $method) = @_;
  if ($self->{currentfile} =~ q!\buser_prefs$! ) {
    warn "config: 'if can $method' not available in user_prefs";
    return 0
  }
  $self->cond_clause_can_or_has('can', $method);
}

sub cond_clause_has {
  my ($self, $method) = @_;
  $self->cond_clause_can_or_has('has', $method);
}

sub cond_clause_can_or_has {
  my ($self, $fn_name, $method) = @_;

  local($1,$2);
  if (!defined $method) {
    my $msg = "config: bad 'if' line, no argument to $fn_name() ".
              "in $self->{currentfile} (line $self->{linenum}{$self->{currentfile}})";
    $self->lint_warn($msg, undef);
  } elsif ($method =~ /^(.*)::([^:]+)$/) {
    no strict "refs";
    my($module, $meth) = ($1, $2);
    return 1  if $module->can($meth) &&
                 ( $fn_name eq 'has' || &{$method}() );
  } else {
    my $msg = "config: bad 'if' line, cannot find '::' in $fn_name($method) ".
              "in $self->{currentfile} (line $self->{linenum}{$self->{currentfile}})";
    $self->lint_warn($msg, undef);
  }
  return;
}

# Let's do some linting here ...
# This is called from _parse(), BTW, so we can check for $conf->{tests}
# easily before finish_parsing() is called and deletes it.
#
sub lint_check {
  my ($self) = @_;
  my $conf = $self->{conf};

  if ($conf->{lint_rules}) {
    # Check for description and score issues in lint fashion
    while ( my $k = each %{$conf->{descriptions}} ) {
      if (!exists $conf->{tests}->{$k}) {
        dbg("config: description exists for non-existent rule $k");
      }
    }

    while ( my($sk) = each %{$conf->{scores}} ) {
      if (!exists $conf->{tests}->{$sk}) {
        # bug 5514: not a lint warning any more
        dbg("config: score set for non-existent rule $sk");
      }
    }
  }
}

# Iterate through tests and check/fix things
sub fix_tests {
  my ($self) = @_;

lib/Mail/SpamAssassin/Conf/Parser.pm  view on Meta::CPAN

        $self->lint_warn("config: invalid head test $name: $text");
        return;
      }
      my ($hdr, $op, $pat) = ($1, $2, $3);
      $hdr =~ s/:$//;
      if ($hdr =~ /:(?!(?:raw|addr|name|host|domain|ip|revip|first|last)\b)/i) {
        $self->lint_warn("config: invalid header modifier for $name: $hdr", $name);
        return;
      }
      if ($pat =~ s/\s+\[if-unset:\s+(.+)\]$//) {
        $conf->{test_opt_unset}->{$name} = $1;
      }
      $self->parse_captures($name, \$pat);
      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)
  {
    if ($self->is_meta_valid($name, $text)) {
      # Untaint now once and not repeatedly later
      $text = untaint_var($text);
    } else {
      return;
    }
  }
  elsif (($type & 1) == 1) { # *_EVALS
    # create eval_to_rule mappings
    if (my ($function) = ($text =~ m/(.*?)\s*\(.*?\)\s*$/)) {
      push @{$conf->{eval_to_rule}->{$function}}, $name;
    }
  }

  $conf->{tests}->{$name} = $text;
  $conf->{test_types}->{$name} = $type;

  if ($name =~ /^AUTOLEARNTEST/) {
     dbg("config: auto-learn: $name has type $type = $conf->{test_types}->{$name} during add_test\n");
  }

  $conf->{priority}->{$name} ||= 0;

  if ($conf->{main}->{keep_config_parsing_metadata}) {
    # {source_file} eats lots of memory and is unused unless
    # keep_config_parsing_metadata is set (ruleqa stuff)
    $conf->{source_file}->{$name} = $self->{currentfile};

    $conf->{if_stack}->{$name} = $self->get_if_stack_as_string();

    if ($self->{file_scoped_attrs}->{testrules}) {
      $conf->{testrules}->{$name} = 1;   # used in build/mkupdates/listpromotable
    }
  }

  # if we found this rule in a user_prefs file, it's a user rule -- note that
  # we may need to recompile the rule code for this type (if they've already
  # been compiled, e.g. in spamd).
  #
  # Note: the want_rebuild_for_type 'flag' is actually a counter; it is decremented
  # after each scan.  This ensures that we always recompile at least once more;
  # once to *define* the rule, and once afterwards to *undefine* the rule in the
  # compiled ruleset again.
  #
  # If two consecutive scans use user rules, that's ok -- the second one will
  # reset the counter, and we'll still recompile just once afterwards to undefine
  # the rule again.
  #
  if ($self->{scoresonly}) {
    $conf->{want_rebuild_for_type}->{$type} = 2;
    $conf->{user_defined_rules}->{$name} = 1;
  }
}

sub add_regression_test {
  my ($self, $name, $ok_or_fail, $string) = @_;
  my $conf = $self->{conf};

  if ($conf->{regression_tests}->{$name}) {
    push @{$conf->{regression_tests}->{$name}}, [$ok_or_fail, $string];
  }
  else {
    # initialize the array, and create one element
    $conf->{regression_tests}->{$name} = [ [$ok_or_fail, $string] ];
  }
}

sub is_meta_valid {
  my ($self, $name, $rule) = @_;

  # $meta is a degenerate translation of the rule, replacing all variables (i.e. rule names) with 0. 
  my $meta = '';

  # Paranoid check (Bug #7557)
  if ($rule =~ /(?:\:\:|->|[\$\@\%\;\{\}])/) {
    warn("config: invalid meta $name rule: $rule\n");
    return 0;
  }

  # Process expandable functions before lexing
  $rule =~ s/${META_RULES_MATCHING_RE}/ 0 /g;

  # Lex the rule into tokens using a rather simple RE method ...
  my @tokens = ($rule =~ /($ARITH_EXPRESSION_LEXER)/og);
  if (length($name) == 1) {
    for (@tokens) {
      print "$name $_\n "  or die "Error writing token: $!";
    }
  }

  # Go through each token in the meta rule
  foreach my $token (@tokens) {
    # If the token is a syntactically legal rule name, make it zero
    if ($token =~ IS_RULENAME) {
      $meta .= "0 ";
    }