You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by he...@apache.org on 2019/07/10 19:16:11 UTC
svn commit: r1862893 - in /spamassassin/trunk: UPGRADE
lib/Mail/SpamAssassin/Conf.pm lib/Mail/SpamAssassin/PerMsgStatus.pm
lib/Mail/SpamAssassin/Plugin/AskDNS.pm
Author: hege
Date: Wed Jul 10 19:16:11 2019
New Revision: 1862893
URL: http://svn.apache.org/viewvc?rev=1862893&view=rev
Log:
Bug 7734 - implement AskDNS _HEADER()_ and header :host :domain :ip :revip modifiers
Modified:
spamassassin/trunk/UPGRADE
spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
Modified: spamassassin/trunk/UPGRADE
URL: http://svn.apache.org/viewvc/spamassassin/trunk/UPGRADE?rev=1862893&r1=1862892&r2=1862893&view=diff
==============================================================================
--- spamassassin/trunk/UPGRADE (original)
+++ spamassassin/trunk/UPGRADE Wed Jul 10 19:16:11 2019
@@ -2,6 +2,11 @@
Note for Users Upgrading to SpamAssassin 4.0.0
----------------------------------------------
+- Header names support new :host :domain :ip :revip modifiers
+
+- AskDNS: tag HEADER(hdrname) supported to query any header content
+ similarly to header rules
+
- Due to the dangerous nature of sa-update --allowplugins option, it
now prints a warning that --reallyallowplugins is required to use it.
This is to make sure all the legacy installations and wiki guides etc
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm?rev=1862893&r1=1862892&r2=1862893&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm Wed Jul 10 19:16:11 2019
@@ -5259,6 +5259,7 @@ sub feature_geodb { 1 } # if needed for
sub feature_dns_block_rule { 1 } # supports 'dns_block_rule' config option
sub feature_compile_regexp { 1 } # Util::compile_regexp
sub feature_meta_rules_matching { 1 } # meta rules_matching() expression
+sub feature_get_host { 1 } # $pms->get() :host :domain :ip :revip # was implemented together with AskDNS::has_tag_header # Bug 7734
sub perl_min_version_5010000 { return $] >= 5.010000 } # perl version check ("perl_version" not neatly backwards-compatible)
###########################################################################
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm?rev=1862893&r1=1862892&r2=1862893&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm Wed Jul 10 19:16:11 2019
@@ -57,11 +57,11 @@ use Errno qw(ENOENT);
use Time::HiRes qw(time);
use Encode;
-use Mail::SpamAssassin::Constants qw(:sa);
+use Mail::SpamAssassin::Constants qw(:sa :ip);
use Mail::SpamAssassin::AsyncLoop;
use Mail::SpamAssassin::Conf;
use Mail::SpamAssassin::Util qw(untaint_var base64_encode idn_to_ascii
- uri_list_canonicalize);
+ uri_list_canonicalize reverse_ip_address);
use Mail::SpamAssassin::Timeout;
use Mail::SpamAssassin::Logger;
@@ -246,6 +246,8 @@ BEGIN {
);
}
+my $IP_ADDRESS = IP_ADDRESS;
+
sub new {
my $class = shift;
$class = ref($class) || $class;
@@ -1430,31 +1432,43 @@ sub action_depends_on_tags {
or die "action_depends_on_tags: argument must be a subroutine ref";
# tag names on which the given action depends
- my @dep_tags = !ref $tags ? uc $tags : map(uc($_),@$tags);
+ my @dep_tags = !ref $tags ? $tags : @$tags;
- # @{$self->{tagrun_subs}} list of all submitted subroutines
- # @{$self->{tagrun_actions}{$tag}} bitmask of action indices blocked by tag
- # $self->{tagrun_tagscnt}[$action_ind] count of tags still pending
+ # uppercase tag, but not args, f.e. HEADER(foo)
+ local($1,$2);
+ foreach (@dep_tags) {
+ if (/^ ([^\(]+) (\(.*)? $/x) {
+ $_ = uc($1).(defined $2 ? $2 : '');
+ }
+ }
- # store action details, obtain its index
- push(@{$self->{tagrun_subs}}, [$code,@args]);
- my $action_ind = $#{$self->{tagrun_subs}};
+ # list dependency tag names which are not already satisfied
+ my @blocking_tags;
+ foreach (@dep_tags) {
+ my $data = $self->get_tag($_);
+ if (!defined $data || $data eq '') {
+ push @blocking_tags, $_;
+ }
+ }
- # list dependency tag names which are not already satistied
- my @blocking_tags =
- grep(!defined $self->{tag_data}{$_} || $self->{tag_data}{$_} eq '',
- @dep_tags);
+ if (!@blocking_tags) {
+ dbg("check: tagrun - tag %s was ready, runnable immediately: %s",
+ join(', ',@dep_tags), join(', ',$code,@args));
+ &$code($self, @args);
+ } else {
+ # @{$self->{tagrun_subs}} list of all submitted subroutines
+ # @{$self->{tagrun_actions}{$tag}} bitmask of action indices blocked by tag
+ # $self->{tagrun_tagscnt}[$action_ind] count of tags still pending
+
+ # store action details, obtain its index
+ push(@{$self->{tagrun_subs}}, [$code,@args]);
+ my $action_ind = $#{$self->{tagrun_subs}};
- $self->{tagrun_tagscnt}[$action_ind] = scalar @blocking_tags;
- $self->{tagrun_actions}{$_}[$action_ind] = 1 for @blocking_tags;
+ $self->{tagrun_tagscnt}[$action_ind] = scalar @blocking_tags;
+ $self->{tagrun_actions}{$_}[$action_ind] = 1 for @blocking_tags;
- if (@blocking_tags) {
dbg("check: tagrun - action %s blocking on tags %s",
$action_ind, join(', ',@blocking_tags));
- } else {
- dbg("check: tagrun - tag %s was ready, action %s runnable immediately: %s",
- join(', ',@dep_tags), $action_ind, join(', ',$code,@args));
- &$code($self, @args);
}
}
@@ -1473,7 +1487,7 @@ sub tag_is_ready {
$tag = uc $tag;
if (would_log('dbg', 'check')) {
- my $tag_val = $self->{tag_data}{$tag};
+ my $tag_val = $self->{tag_data}->{$tag};
dbg("check: tagrun - tag %s is now ready, value: %s",
$tag, !defined $tag_val ? '<UNDEF>'
: ref $tag_val ne 'ARRAY' ? $tag_val
@@ -1571,7 +1585,14 @@ sub get_tag {
my($self, $tag, @args) = @_;
return if !defined $tag;
+
+ # handle atleast HEADER(arg)
+ local($1);
+ if ($tag =~ s/\(([a-zA-Z0-9:-]+)\)$//) {
+ @args = ($1);
+ }
$tag = uc $tag;
+
my $data;
if (exists $common_tags{$tag}) {
# tag data from traditional pre-defined tag subroutines
@@ -1600,6 +1621,13 @@ sub get_tag_raw {
my($self, $tag, @args) = @_;
return if !defined $tag;
+
+ # handle atleast HEADER(arg)
+ local($1);
+ if ($tag =~ s/\(([a-zA-Z0-9:-]+)\)$//) {
+ @args = ($1);
+ }
+
my $data;
if (exists $common_tags{$tag}) {
# tag data from traditional pre-defined tag subroutines
@@ -1902,6 +1930,23 @@ single quotes is stripped too, as it is
=back
+Appending a modifier C<:host> to a header field name will return the first
+hostname-looking string that ends with a valid TLD. First it tries to find a
+match after @ character (possible email), then from any part of the header.
+Normal use of this would be for example 'From:addr:host' to return the
+hostname portion of a From-address.
+
+Appending a modifier C<:domain> to a header field name implies C<:host>,
+but will return only domain part of the hostname, as returned by
+RegistryBoundaries::trim_domain.
+
+Appending a modifier C<:ip> to a header field name, will return the first
+IPv4 or IPv6 address string found. Could be used for example as
+'X-Originating-IP:ip'.
+
+Appending a modifier C<:revip> to a header field name implies C<:ip>,
+but will return the found IP in reverse (usually for DNSBL usage).
+
There are several special pseudo-headers that can be specified:
=over 4
@@ -1954,14 +1999,22 @@ sub _get {
my $getaddr = 0;
my $getname = 0;
my $getraw = 0;
+ my $gethost = 0;
+ my $getdomain = 0;
+ my $getip = 0;
+ my $getrevip = 0;
# special queries - process and strip modifiers
if (index($request,':') >= 0) { # triage
local $1;
while ($request =~ s/:([^:]*)//) {
- if ($1 eq 'raw') { $getraw = 1 }
- elsif ($1 eq 'addr') { $getaddr = $getraw = 1 }
- elsif ($1 eq 'name') { $getname = 1 }
+ if ($1 eq 'raw') { $getraw = 1 }
+ elsif ($1 eq 'addr') { $getaddr = $getraw = 1 }
+ elsif ($1 eq 'name') { $getname = 1 }
+ elsif ($1 eq 'host') { $gethost = 1 }
+ elsif ($1 eq 'domain') { $gethost = $getdomain = 1 }
+ elsif ($1 eq 'ip') { $getip = 1 }
+ elsif ($1 eq 'revip') { $getip = $getrevip = 1 }
}
}
my $request_lc = lc $request;
@@ -2115,6 +2168,27 @@ sub _get {
$result =~ s/^ \s* ' \s* (.*?) \s* ' \s* \z/$1/sx;
}
}
+
+ # special host/domain
+ if (defined $result && ($gethost || $getdomain || $getip)) {
+ my $host;
+ if ($gethost) {
+ my $tldsRE = $self->{main}->{registryboundaries}->{valid_tlds_re};
+ my $hostRE = qr/(?<![._-])\b([a-z\d][a-z\d._-]{0,251}\.${tldsRE})\b(?![._-])/i;
+ # try grabbing email domain first, otherwise try anything looking host
+ if ($result =~ /(?:.*\@)?${hostRE}/i) {
+ $host = $getdomain ? $self->{main}->{registryboundaries}->trim_domain($1)
+ : $1;
+ }
+ } else {
+ my $ipRE = qr/(?<!\.)\b(${IP_ADDRESS})\b(?!\.)/;
+ if ($result =~ $ipRE) {
+ $host = $getrevip ? reverse_ip_address($1) : $1;
+ }
+ }
+ $result = $host;
+ }
+
return $result;
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm?rev=1862893&r1=1862892&r2=1862893&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm Wed Jul 10 19:16:11 2019
@@ -64,10 +64,16 @@ for querying DNS, which ignores any 'sea
Domain names in DNS queries are case-insensitive.
A tag name is a string of capital letters, preceded and followed by an
-underscore character. This syntax mirrors the add_header setting, except that
-tags cannot have parameters in parenthesis when used in askdns templates.
-Tag names may appear anywhere in the template - each queried DNS zone
-prescribes how a query should be formed.
+underscore character. This syntax mirrors the add_header setting, except
+that tags cannot have parameters in parenthesis when used in askdns
+templates (exceptions found below). Tag names may appear anywhere in the
+template - each queried DNS zone prescribes how a query should be formed.
+
+Special supported tag HEADER() can be used to query any header content,
+using same header names/modifiers that as header rules support. For example
+_HEADER(Reply-To:addr:domain)_ can be used to query the trimmed domain part
+of Reply-To address. See Mail::SpamAssassin::Conf documentation about
+header rules.
A query template may contain any number of tag names including none,
although in the most common anticipated scenario exactly one tag name would
@@ -191,6 +197,7 @@ use re 'taint';
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Util qw(decode_dns_question_entry idn_to_ascii compile_regexp);
use Mail::SpamAssassin::Logger;
+use Mail::SpamAssassin::Constants qw(:ip);
use version 0.77;
our @ISA = qw(Mail::SpamAssassin::Plugin);
@@ -204,6 +211,8 @@ our %rcode_value = ( # https://www.iana
our $txtdata_can_provide_a_list;
+my $IP_ADDRESS = IP_ADDRESS;
+
sub new {
my($class,$sa_main) = @_;
@@ -328,25 +337,19 @@ sub set_config {
$subtest = parse_and_canonicalize_subtest($subtest);
defined $subtest or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
}
- # collect tag names as used in each query template
- my @tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/g;
- my %seen; @tags = grep(!$seen{$_}++, @tags); # filter out duplicates
-
- # group rules by tag names used in them (to be used as a hash key)
- my $depends_on_tags = !@tags ? '' : join(',',@tags);
- # subgroup rules by a DNS RR type and a nonexpanded query template
- my $query_template_key = $query_type . ':' . $query_template;
+ # initialize rule structure
+ $self->{askdns}{$rulename}{query} = $query_template;
+ $self->{askdns}{$rulename}{q_type} = $query_type;
+ $self->{askdns}{$rulename}{a_types} = \@answer_types;
+ $self->{askdns}{$rulename}{subtest} = $subtest;
+ $self->{askdns}{$rulename}{tags} = ();
- $self->{askdns}{$depends_on_tags}{$query_template_key} ||=
- { query => $query_template, rules => {}, q_type => $query_type,
- a_types => # optimization: undef means "same as q_type"
- @answer_types == 1 && $answer_types[0] eq $query_type ? undef
- : \@answer_types };
- $self->{askdns}{$depends_on_tags}{$query_template_key}{rules}{$rulename}
- = $subtest;
- # dbg("askdns: rule: %s, config dep: %s, domkey: %s, subtest: %s",
- # $rulename, $depends_on_tags, $query_template_key, $subtest);
+ # collect tag names as used in each query template
+ # also support common HEADER(arg) tag which does $pms->get(arg)
+ my @tags = $query_template =~ /_([A-Z][A-Z0-9]*|HEADER\([a-zA-Z0-9:-]+\))_/g;
+ # save rule to tag dependencies
+ $self->{askdns}{$rulename}{tags}{$_} = 1 foreach (@tags);
# just define the test so that scores and lint works
$self->{parser}->add_test($rulename, undef,
@@ -361,152 +364,93 @@ sub set_config {
# run as early as possible, launching DNS queries as soon as their
# dependencies are fulfilled
#
-sub extract_metadata {
+sub check_dnsbl {
my($self, $opts) = @_;
+
my $pms = $opts->{permsgstatus};
my $conf = $pms->{conf};
return if !$pms->is_dns_available();
- $pms->{askdns_map_dnskey_to_rules} = {};
# walk through all collected askdns rules, obtain tag values whenever
# they may become available, and launch DNS queries right after
- #
- for my $depends_on_tags (keys %{$conf->{askdns}}) {
- my @tags;
- @tags = split(/,/, $depends_on_tags) if $depends_on_tags ne '';
-
- if (would_log("dbg","askdns")) {
- while ( my($query_template_key, $struct) =
- each %{$conf->{askdns}{$depends_on_tags}} ) {
- my($query_template, $query_type, $answer_types_ref, $rules) =
- @$struct{qw(query q_type a_types rules)};
- dbg("askdns: depend on tags %s, rules: %s ",
- $depends_on_tags, join(', ', keys %$rules));
- }
+ foreach my $rulename (keys %{$conf->{askdns}}) {
+ if (!$conf->{scores}->{$rulename}) {
+ dbg("askdns: skipping disabled rule $rulename");
+ next;
}
-
- if (!@tags) {
- # no dependencies on tags, just call directly
- $self->launch_queries($pms,$depends_on_tags);
- } else {
- # enqueue callback for tags needed
+ my @tags = sort keys %{$conf->{askdns}{$rulename}{tags}};
+ if (@tags) {
+ dbg("askdns: rule %s depends on tags: %s", $rulename,
+ join(', ', @tags));
$pms->action_depends_on_tags(@tags == 1 ? $tags[0] : \@tags,
- sub { my($pms,@args) = @_;
- $self->launch_queries($pms,$depends_on_tags) }
+ sub { my($pms,@args) = @_;
+ $self->launch_queries($pms,$rulename,\@tags) }
);
+ } else {
+ # no dependencies on tags, just call directly
+ $self->launch_queries($pms,$rulename,[]);
}
}
}
-# generate DNS queries - called for each set of rules
-# when their tag dependencies are met
+# generate DNS queries - called for each rule when it's tag dependencies
+# are met
#
sub launch_queries {
- my($self, $pms, $depends_on_tags) = @_;
- my $conf = $pms->{conf};
-
- my %tags;
- # obtain tag/value pairs of tags we depend upon in this set of rules
- if ($depends_on_tags ne '') {
- %tags = map( ($_,$pms->get_tag($_)), split(/,/,$depends_on_tags) );
- }
- dbg("askdns: preparing queries which depend on tags: %s",
- join(', ', map($_.' => '.$tags{$_}, keys %tags)));
-
- # replace tag names in a query template with actual tag values
- # and launch DNS queries
- while ( my($query_template_key, $struct) =
- each %{$conf->{askdns}{$depends_on_tags}} ) {
- my($query_template, $query_type, $answer_types_ref, $rules) =
- @$struct{qw(query q_type a_types rules)};
-
- my @rulenames = keys %$rules;
- if (grep($conf->{scores}->{$_}, @rulenames)) {
- dbg("askdns: query template %s, type %s, rules: %s",
- $query_template,
- !$answer_types_ref ? $query_type
- : $query_type.'/'.join(',',@$answer_types_ref),
- join(', ', @rulenames));
- } else {
- dbg("askdns: query template %s, type %s, all rules disabled: %s",
- $query_template, $query_type, join(', ', @rulenames));
- next;
- }
-
- # collect all tag names from a template, each may occur more than once
- my @templ_tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/gs;
+ my($self, $pms, $rulename, $tags) = @_;
- # filter out duplicate tag names, and tags with undefined or empty value
- my %seen;
- @templ_tags = grep(!$seen{$_}++ && defined $tags{$_} && $tags{$_} ne '',
- @templ_tags);
-
- my %templ_vals; # values that each tag takes
- for my $t (@templ_tags) {
- my %seen;
- # a tag value may be a space-separated list,
- # store it as an arrayref, removing duplicate values
- $templ_vals{$t} = [ grep(!$seen{$_}++, split(' ',$tags{$t})) ];
- }
-
- # count through all tag value tuples
- my @digit = (0) x @templ_tags; # counting accumulator
-OUTER:
- for (;;) {
- my %current_tag_val; # maps a tag name to its current iteration value
- for my $j (0 .. $#templ_tags) {
- my $t = $templ_tags[$j];
- $current_tag_val{$t} = $templ_vals{$t}[$digit[$j]];
- }
- local $1;
- my $query_domain = $query_template;
- $query_domain =~ s{_([A-Z][A-Z0-9]*)_}
- { defined $current_tag_val{$1} ? $current_tag_val{$1}
- : '' }ge;
- $query_domain = idn_to_ascii($query_domain);
- # used by process_response_packet
- my $dnskey = "askdns:$query_type:$query_domain";
- dbg("askdns: expanded query %s, dns key %s", $query_domain, $dnskey);
-
- if ($query_domain eq '') {
- # ignore, just in case
- } else {
- if (!exists $pms->{askdns_map_dnskey_to_rules}{$dnskey}) {
- $pms->{askdns_map_dnskey_to_rules}{$dnskey} =
- [ [$query_type, $answer_types_ref, $rules] ];
- } else {
- push(@{$pms->{askdns_map_dnskey_to_rules}{$dnskey}},
- [$query_type, $answer_types_ref, $rules] );
+ my $arule = $pms->{conf}->{askdns}{$rulename};
+ my $query_tmpl = $arule->{query};
+ my $queries;
+ if (@$tags) {
+ if (!exists $pms->{askdns_qtmpl_cache}{$query_tmpl}) {
+ # replace tags in query template
+ # iterate through each tag, replacing list of strings as we go
+ my %q_iter = ( "$query_tmpl" => 1 );
+ foreach my $tag (@$tags) {
+ # cache tag values locally
+ if (!exists $pms->{askdns_tag_cache}{$tag}) {
+ $pms->{askdns_tag_cache}{$tag} = $pms->get_tag($tag);
}
- # lauch a new DNS query for $query_type and $query_domain
- $pms->{async}->bgsend_and_start_lookup(
- $query_domain, $query_type, undef,
- { rulename => \@rulenames, type => 'AskDNS' },
- sub { my ($ent,$pkt) = @_;
- $self->process_response_packet($pms, $ent, $pkt, $dnskey) },
- master_deadline => $pms->{master_deadline}
- );
+ my %q_iter_new;
+ foreach my $q (keys %q_iter) {
+ # handle space separated multi-valued tags
+ foreach my $val (split(' ', $pms->{askdns_tag_cache}{$tag})) {
+ my $qtmp = $q;
+ $qtmp =~ s/\Q_${tag}_\E/${val}/g;
+ $q_iter_new{$qtmp} = 1;
+ }
+ }
+ %q_iter = %q_iter_new;
}
+ # cache idn'd queries
+ my @q_arr;
+ push @q_arr, idn_to_ascii($_) foreach (keys %q_iter);
+ $pms->{askdns_qtmpl_cache}{$query_tmpl} = \@q_arr;
+ }
+ $queries = $pms->{askdns_qtmpl_cache}{$query_tmpl};
+ } else {
+ push @$queries, idn_to_ascii($query_tmpl);
+ }
- last if !@templ_tags;
- # increment accumulator, little-endian
- for (my $j = 0; ; $j++) {
- last if ++$digit[$j] <= $#{$templ_vals{$templ_tags[$j]}};
- $digit[$j] = 0; # and carry
- last OUTER if $j >= $#templ_tags;
- }
- }
+ foreach my $query (@$queries) {
+ dbg("askdns: launching query (%s): $query", $rulename);
+ $pms->{async}->bgsend_and_start_lookup(
+ $query, $arule->{q_type}, undef,
+ { rulename => $rulename, type => 'AskDNS' },
+ sub { my ($ent,$pkt) = @_;
+ $self->process_response_packet($pms, $ent, $pkt, $rulename) },
+ master_deadline => $pms->{master_deadline}
+ );
}
}
sub process_response_packet {
- my($self, $pms, $ent, $pkt, $dnskey) = @_;
+ my($self, $pms, $ent, $pkt, $rulename) = @_;
my $conf = $pms->{conf};
-
- # map a dnskey back to info on queries which caused this DNS lookup
- my $queries_ref = $pms->{askdns_map_dnskey_to_rules}{$dnskey};
+ my $arule = $conf->{askdns}{$rulename};
my($header, @question, @answer, $qtype, $rcode);
# NOTE: $pkt will be undef if the DNS query was aborted (e.g. timed out)
@@ -518,8 +462,8 @@ sub process_response_packet {
$rcode = uc $header->rcode if $header; # 'NOERROR', 'NXDOMAIN', ...
# NOTE: qname is encoded in RFC 1035 zone format, decode it
- dbg("askdns: answer received, rcode %s, query %s, answer has %d records",
- $rcode,
+ dbg("askdns: answer received (%s), rcode %s, query %s, answer has %d records",
+ $rulename, $rcode,
join(', ', map(join('/', decode_dns_question_entry($_)), @question)),
scalar @answer);
@@ -594,51 +538,45 @@ sub process_response_packet {
: $rr->rdatastr;
utf8::encode($rr_rdatastr) if utf8::is_utf8($rr_rdatastr);
}
- # dbg("askdns: received rr type %s, data: %s", $rr_type, $rr_rdatastr);
+ # dbg("askdns: received rr type %s, data: %s", $rr_type, $rr_rdatastr);
}
- my $j = 0;
- for my $q_tuple (!ref $queries_ref ? () : @$queries_ref) {
- next if !$q_tuple;
- my($query_type, $answer_types_ref, $rules) = @$q_tuple;
-
- next if !defined $qtype || $query_type ne $qtype;
- $answer_types_ref = [$query_type] if !defined $answer_types_ref;
-
- # mark rule as done
- $pms->{askdns_map_dnskey_to_rules}{$dnskey}[$j++] = undef;
-
- while (my($rulename,$subtest) = each %$rules) {
- my $match;
- local($1,$2,$3);
- if (ref $subtest eq 'HASH') { # a list of DNS rcodes (as hash keys)
- $match = 1 if $subtest->{$rcode};
- } elsif ($rcode != 0) {
- # skip remaining tests on DNS error
- } elsif (!defined($rr_type) ||
- !grep($_ eq 'ANY' || $_ eq $rr_type, @$answer_types_ref) ) {
- # skip remaining tests on wrong RR type
- } elsif (!defined $subtest) {
- $match = 1; # any valid response of the requested RR type matches
- } elsif (ref $subtest eq 'Regexp') { # a regular expression
- $match = 1 if $rr_rdatastr =~ $subtest;
- } elsif ($rr_rdatastr eq $subtest) { # exact equality
- $match = 1;
- } elsif (defined $rdatanum &&
- $subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) {
- my($n1,$delim,$n2) = ($1,$2,$3);
- $match =
- !defined $n2 ? ($rdatanum & $n1) && # mask only
- (($rdatanum & 0xff000000) == 0x7f000000) # 127/8
- : $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range
- : $delim eq '/' ? ($rdatanum & $n2) == (int($n1) & $n2) # value/mask
- : 0; # notice int($n1) to fix perl ~5.14 taint bug (Bug 7725)
- }
- if ($match) {
- $self->askdns_hit($pms, $ent->{query_domain}, $qtype,
- $rr_rdatastr, $rulename);
- }
- }
+ my $query_type = $arule->{q_type};
+ return if !defined $qtype || $query_type ne $qtype;
+
+ my $answer_types_ref = $arule->{a_types};
+ $answer_types_ref = [$query_type] if !@$answer_types_ref;
+
+ my $subtest = $arule->{subtest};
+
+ my $match;
+ local($1,$2,$3);
+ if (ref $subtest eq 'HASH') { # a list of DNS rcodes (as hash keys)
+ $match = 1 if $subtest->{$rcode};
+ } elsif ($rcode != 0) {
+ # skip remaining tests on DNS error
+ } elsif (!defined($rr_type) ||
+ !grep($_ eq 'ANY' || $_ eq $rr_type, @$answer_types_ref) ) {
+ # skip remaining tests on wrong RR type
+ } elsif (!defined $subtest) {
+ $match = 1; # any valid response of the requested RR type matches
+ } elsif (ref $subtest eq 'Regexp') { # a regular expression
+ $match = 1 if $rr_rdatastr =~ $subtest;
+ } elsif ($rr_rdatastr eq $subtest) { # exact equality
+ $match = 1;
+ } elsif (defined $rdatanum &&
+ $subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) {
+ my($n1,$delim,$n2) = ($1,$2,$3);
+ $match =
+ !defined $n2 ? ($rdatanum & $n1) && # mask only
+ (($rdatanum & 0xff000000) == 0x7f000000) # 127/8
+ : $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range
+ : $delim eq '/' ? ($rdatanum & $n2) == (int($n1) & $n2) # value/mask
+ : 0; # notice int($n1) to fix perl ~5.14 taint bug (Bug 7725)
+ }
+ if ($match) {
+ $self->askdns_hit($pms, $ent->{query_domain}, $qtype,
+ $rr_rdatastr, $rulename);
}
}
}
@@ -657,4 +595,7 @@ sub askdns_hit {
$pms->got_hit($rulename, 'ASKDNS: ', ruletype => 'askdns'); # score=>$score
}
+# Version features
+sub has_tag_header { 1 } # HEADER() was implemented together with Conf::feature_get_host # Bug 7734
+
1;