You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by mm...@apache.org on 2013/01/16 21:13:48 UTC
svn commit: r1434360 - in /spamassassin/trunk/lib/Mail/SpamAssassin:
AsyncLoop.pm Conf.pm Dns.pm DnsResolver.pm Plugin/ASN.pm Plugin/AskDNS.pm
Plugin/DNSEval.pm Plugin/URIDNSBL.pm
Author: mmartinec
Date: Wed Jan 16 20:13:47 2013
New Revision: 1434360
URL: http://svn.apache.org/viewvc?rev=1434360&view=rev
Log:
Bug 6884:
- a new subroutine AsyncLoop::bgsend_and_start_lookup() implements a
commonly used idiom of calling bgsend(), followed by start_lookup(),
while implementing a mechanism for grouping equal DNS queries,
simplifying several other code sections;
- rewrite URIDNSBL.pm to put the new mechanism to good use,
fixing the particular Bug 6884 and test 5 in t/uribl.t;
- fix the t/uribl.t, moving X_URIBL_FULL_NS from %patterns
to %anti_patterns;
- add a dns_query_restriction configuration option;
- some cosmetic edits, like renaming some variables for consistency.
PR: 6884
Submitted by: Mark.Martinec@ijs.si
Modified:
spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/AsyncLoop.pm Wed Jan 16 20:13:47 2013
@@ -73,18 +73,45 @@ sub new {
total_queries_completed => 0,
pending_lookups => { },
timing_by_query => { },
+ all_lookups => { }, # keyed by "rr_type/domain"
};
bless ($self, $class);
$self;
}
+# Given a domain name, produces a listref of successively stripped down
+# parent domains, e.g. a domain '2.10.Example.COM' would produce a list:
+# '2.10.example.com', '10.example.com', 'example.com', 'com', ''
+#
+sub domain_to_search_list($) {
+ my ($domain) = @_;
+ $domain =~ s/^\.+//; $domain =~ s/\.+\z//; # strip leading and trailing dots
+ my @search_keys;
+ if ($domain =~ /\[/) { # don't split address literals
+ @search_keys = ( $domain, '' ); # presumably an address literal
+ } else {
+ local $1;
+ $domain = lc $domain;
+ for (;;) {
+ push(@search_keys, $domain);
+ last if $domain eq '';
+ # strip one level
+ $domain = ($domain =~ /^ (?: [^.]* ) \. (.*) \z/xs) ? $1 : '';
+ }
+ if (@search_keys > 20) { # enforce some sanity limit
+ @search_keys = @search_keys[$#search_keys-19 .. $#search_keys];
+ }
+ }
+ return \@search_keys;
+}
+
# ---------------------------------------------------------------------------
-=item $obj = $async->start_lookup($obj)
+=item $ent = $async->start_lookup($ent, $master_deadline)
-Register the start of a long-running asynchronous lookup operation. C<$obj>
-is a hash reference containing the following items:
+Register the start of a long-running asynchronous lookup operation.
+C<$ent> is a hash reference containing the following items:
=over 4
@@ -111,9 +138,9 @@ messages, such as C<DNSBL>, C<MX>, C<TXT
A code reference, which will be called periodically during the
background-processing period. If you will be performing an async lookup on a
non-DNS-based service, you will need to implement this so that it checks for
-new responses and calls C<set_response_packet()> or C<report_id_complete()> as
-appropriate. DNS-based lookups can leave it undefined, since
-DnsResolver::poll_responses() will be called automatically anyway.
+new responses and calls C<set_response_packet()>. DNS-based lookups can leave
+it undefined, since DnsResolver::poll_responses() will be called automatically
+anyway.
The code reference will be called with one argument, the C<$ent> object.
@@ -125,7 +152,7 @@ DNS lookup) is completed, either normall
When a task has been reported as completed via C<set_response_packet()>
the response (as provided to C<set_response_packet()>) is stored in
$ent->{response_packet} (possibly undef, its semantics is defined by the
-caller). When completion is reported via C<report_id_complete()> or a
+caller). When completion is reported via C<set_response_packet()> or a
task was aborted, the $ent->{response_packet} is guaranteed to be undef.
If it is necessary to distinguish between the last two cases, the
$ent->{status} may be examined for a string 'ABORTING' or 'FINISHED'.
@@ -163,7 +190,8 @@ Defaults to 0.2 * timeout_initial.
=back
-C<$obj> is returned by this method.
+C<$ent> is returned by this method, with its contents augmented by additional
+information.
=cut
@@ -190,7 +218,6 @@ sub start_lookup {
for (;;) { # 2.10.example.com, 10.example.com, example.com, com, ''
if (exists $conf_by_zone->{$zone}) {
$settings = $conf_by_zone->{$zone};
- dbg("async: applying by_zone settings for $zone");
last;
} elsif ($zone eq '') {
last;
@@ -201,6 +228,8 @@ sub start_lookup {
}
}
+ dbg("async: applying by_zone settings for %s", $zone) if $settings;
+
my $t_init = $ent->{timeout_initial}; # application-specified has precedence
$t_init = $settings->{rbl_timeout} if $settings && !defined $t_init;
$t_init = $self->{main}->{conf}->{rbl_timeout} if !defined $t_init;
@@ -241,15 +270,112 @@ sub start_lookup {
# ---------------------------------------------------------------------------
-=item $obj = $async->get_lookup($key)
+=item $ent = $async->bgsend_and_start_lookup($domain, $type, $class, $ent, $cb, %options)
+
+A common idiom: calls C<bgsend>, followed by a call to C<start_lookup>,
+returning the argument $ent object as modified by C<start_lookup> and
+filled-in with a query ID.
+
+=cut
+
+sub bgsend_and_start_lookup {
+ my($self, $domain, $type, $class, $ent, $cb, %options) = @_;
+ $ent = {} if !$ent;
+ $ent->{id} = undef;
+ $ent->{query_type} = $type;
+ $ent->{query_domain} = $domain;
+ $ent->{type} = $type if !exists $ent->{type};
+ my $key = $ent->{key} || '';
+
+ my $dnskey = uc($type) . '/' . lc($domain);
+ my $dns_query_info = $self->{all_lookups}{$dnskey};
+
+ if ($dns_query_info) { # DNS query already underway or completed
+ my $id = $ent->{id} = $dns_query_info->{id}; # re-use existing query
+ return if !defined $id; # presumably blocked, or other fatal failure
+ my $id_tail = $id; $id_tail =~ s{^\d+/IN/}{};
+ lc($id_tail) eq lc($dnskey)
+ or warn "async: unmatched id $id, key=$dnskey\n";
+ my $pkt = $dns_query_info->{pkt};
+ if (!$pkt) { # DNS query underway, still waiting for results
+ # just add our query to the existing one
+ push(@{$dns_query_info->{applicants}}, [$ent,$cb]);
+ dbg("async: query %s already underway, adding no.%d %s",
+ $id, scalar @{$dns_query_info->{applicants}},
+ $ent->{rulename} || $key);
+ } else { # DNS query already completed, re-use results
+ # answer already known, just do our callback and be done with it
+ if (!$cb) {
+ dbg("async: query %s already done, re-using for %s", $id, $key);
+ } else {
+ dbg("async: query %s already done, re-using for %s, callback",
+ $id, $key);
+ eval { $cb->($ent, $pkt); 1 }
+ or do { chomp $@;
+ warn sprintf("query %s completed, callback %s failed: %s\n",
+ $id, $key, $@) };
+ }
+ }
+ }
+
+ else { # no existing query, open a new DNS query
+ $dns_query_info = $self->{all_lookups}{$dnskey} = {}; # new query needed
+ my($id, $blocked);
+ my $dns_query_blockages = $self->{main}->{conf}->{dns_query_blocked};
+ if ($dns_query_blockages) {
+ my $search_list = domain_to_search_list($domain);
+ foreach my $parent_domain (@$search_list) {
+ $blocked = $dns_query_blockages->{$parent_domain};
+ last if defined $blocked; # stop at first defined, can be true or false
+ }
+ }
+ if ($blocked) {
+ dbg("async: blocked by dns_query_restriction: %s", $dnskey);
+ } else {
+ dbg("async: launching %s for %s", $dnskey, $key);
+ $id = $self->{main}->{resolver}->bgsend($domain, $type, $class, sub {
+ my($pkt, $pkt_id, $timestamp) = @_;
+ if ($pkt_id ne $id) {
+ warn "async: mismatched dns id: got $pkt_id, expected $id\n";
+ return;
+ }
+ $self->set_response_packet($pkt_id, $pkt, $ent->{key}, $timestamp);
+ $dns_query_info->{pkt} = $pkt;
+ my @cb_displ_names;
+ foreach my $tuple (@{$dns_query_info->{applicants}}) {
+ my($appl_ent, $appl_cb) = @$tuple;
+ if ($appl_cb) {
+ push(@cb_displ_names,
+ $appl_ent->{rulename} || $appl_ent->{key} || '');
+ eval { $appl_cb->($appl_ent, $pkt); 1 }
+ or do { chomp $@;
+ warn sprintf("query %s completed, callback %s failed: %s\n",
+ $id, $appl_ent->{key}, $@) };
+ }
+ }
+ dbg("async: query %s completed, %s", $id,
+ !@cb_displ_names ? 'no callbacks'
+ : 'callbacks: '.join(', ',@cb_displ_names));
+ });
+ }
+ return if !defined $id;
+ $dns_query_info->{id} = $ent->{id} = $id;
+ push(@{$dns_query_info->{applicants}}, [$ent,$cb]);
+ $self->start_lookup($ent, $options{master_deadline});
+ }
+ return $ent;
+}
+
+# ---------------------------------------------------------------------------
+
+=item $ent = $async->get_lookup($key)
Retrieve the pending-lookup object for the given key C<$key>.
If the lookup is complete, this will return C<undef>.
Note that a lookup is still considered "pending" until C<complete_lookups()> is
-called, even if it has been reported as complete via C<set_response_packet()>
-or C<report_id_complete()>.
+called, even if it has been reported as complete via C<set_response_packet()>.
=cut
@@ -265,8 +391,7 @@ sub get_lookup {
Retrieve the lookup objects for all pending lookups.
Note that a lookup is still considered "pending" until C<complete_lookups()> is
-called, even if it has been reported as complete via C<set_response_packet()>
-or C<report_id_complete()>.
+called, even if it has been reported as complete via C<set_response_packet()>.
=cut
@@ -365,7 +490,7 @@ sub complete_lookups {
if (defined $ent->{poll_callback}) { # call a "poll_callback" if exists
# be nice, provide fresh info to a callback routine
$ent->{status} = 'FINISHED' if exists $self->{finished}->{$id};
- # a callback might call set_response_packet() or report_id_complete()
+ # a callback might call set_response_packet()
# dbg("async: calling poll_callback on key $key");
$ent->{poll_callback}->($ent);
}
@@ -482,11 +607,10 @@ packet object for the response. A parame
hash %{$self->{pending_lookups}} where the object which spawned this query can
be found, and through which futher information about the query is accessible.
-If this was called, C<$pkt> will be available in the C<completed_callback>
-function as C<$ent-<gt>{response_packet}>.
-
-One or the other of C<set_response_packet()> or C<report_id_complete()>
-should be called, but not both.
+C<$pkt> may be undef, indicating that no response packet is available, but a
+query has completed (e.g. was aborted or dismissed) and is no longer "pending".
+The C<$pkt> will be available in the C<completed_callback> function as
+C<$ent-<gt>{response_packet}>.
=cut
@@ -522,8 +646,10 @@ sub set_response_packet {
=item $async->report_id_complete($id,$key,$key,$timestamp)
-Register that a query has completed, and is no longer "pending". C<$id> is the
-ID for the query, and must match the C<id> supplied in C<start_lookup()>.
+Legacy. Equivalent to $self->set_response_packet($id,undef,$key,$timestamp),
+i.e. providing undef as a response packet. Register that a query has
+completed, and is no longer "pending". C<$id> is the ID for the query,
+and must match the C<id> supplied in C<start_lookup()>.
One or the other of C<set_response_packet()> or C<report_id_complete()>
should be called, but not both.
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm Wed Jan 16 20:13:47 2013
@@ -1777,6 +1777,75 @@ do not work for no apparent reason.
}
});
+=item dns_query_restriction (allow|deny) domain1 domain2 ...
+
+Option allows disabling of rules which would result in a DNS query to one of
+the listed domains. The first argument must be a literal C<allow> or C<deny>,
+remaining arguments are domains names.
+
+Most DNS queries (with some exceptions) are subject to dns_query_restriction.
+A domain to be queried is successively stripped-off of its leading labels
+(thus yielding a series of its parent domains), and on each iterations a
+check is made against an associative array generated by dns_query_restriction
+options. Search stops at the first match (i.e. a tightest match), and the
+matching entry with its C<allow> or C<deny> value then controls if a DNS query
+is allowed to be launched.
+
+If no match is found an implicit default is to allow all queries. The purpose
+of an explicit C<allow> entry is to be able to override a previously configured
+C<deny> on the same domain or to override an entry (possibly still to be
+configured) on one of its parent domains. Thus an 'allow zen.spamhaus.org'
+with a 'deny spamhaus.org' would permit DNS queries on a specific DNS BL zone
+but deny queries to other zones under the same parent domain 'spamhaus.org'.
+
+Domains are matched case-insensitively, no wildcards are recognized,
+there should be no leading or trailing dot.
+
+Specifying blocked domains has a similar effect as setting a score of such
+rules to zero, and can be a handy alternative to hunting for such rules
+when a site policy does not allow certain DNS block lists to be queried.
+
+Example:
+ dns_query_restriction deny dnswl.org surbl.org
+ dns_query_restriction allow zen.spamhaus.org
+ dns_query_restriction deny spamhaus.org mailspike.net spamcop.net
+
+=cut
+
+ push (@cmds, {
+ setting => 'dns_query_restriction',
+ type => $CONF_TYPE_STRING,
+ code => sub {
+ my ($self, $key, $value, $line) = @_;
+ defined $value && $value =~ s/^(allow|deny)\s+//i
+ or return $INVALID_VALUE;
+ my $blocked = lc($1) eq 'deny' ? 1 : 0;
+ foreach my $domain (split(' ', $value)) {
+ $domain =~ s/^\.//; $domain =~ s/\.\z//; # strip dots
+ $self->{dns_query_blocked}{lc $domain} = $blocked;
+ }
+ }
+ });
+
+=item clear_dns_query_restriction
+
+The option removes any entries entered by previous 'dns_query_restriction'
+options, leaving the list empty, i.e. allowing DNS queries for any domain
+(including any DNS BL zone).
+
+=cut
+
+ push (@cmds, {
+ setting => 'clear_dns_query_restriction',
+ aliases => ['clear_dns_query_restrictions'],
+ type => $CONF_TYPE_NOARGS,
+ code => sub {
+ my ($self, $key, $value, $line) = @_;
+ return $INVALID_VALUE if defined $value && $value ne '';
+ delete $self->{dns_query_blocked};
+ }
+ });
+
=back
=head2 LEARNING OPTIONS
@@ -2643,7 +2712,11 @@ does not affect the score because rules
=item the 'zone' argument
-This is the root zone of the DNSBL, ending in a period.
+This is the root zone of the DNSBL.
+
+The domain name is considered to be a fully qualified domain name
+(i.e. not subject to DNS resolver's search or default domain options).
+No trailing period is needed, and will be removed if specified.
=item the 'sub-test' argument
@@ -3191,7 +3264,7 @@ subdomain of the specified zone.
$self->{rbl_timeout_min} = $2+0 if defined $2;
}
else { # per-zone settings
- $zone =~ s/^\.//; $zone =~ s/\.$//; # strip leading and trailing dot
+ $zone =~ s/^\.//; $zone =~ s/\.\z//; # strip leading and trailing dot
$zone = lc $zone;
$self->{by_zone}{$zone}{rbl_timeout} = $1+0;
$self->{by_zone}{$zone}{rbl_timeout_min} = $2+0 if defined $2;
@@ -4539,7 +4612,8 @@ sub feature_bayes_auto_learn_on_error {
sub feature_uri_host_listed { 1 }
sub feature_yesno_takes_args { 1 }
sub feature_bug6558_free { 1 }
-sub feature_edns { 1 } # supports 'dns_options edns'
+sub feature_edns { 1 } # supports 'dns_options edns' config option
+sub feature_dns_query_restriction { 1 } # supported config option
###########################################################################
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Dns.pm Wed Jan 16 20:13:47 2013
@@ -97,16 +97,15 @@ BEGIN {
###########################################################################
-# TODO: $server is currently unused
sub do_rbl_lookup {
- my ($self, $rule, $set, $type, $server, $host, $subtest) = @_;
+ my ($self, $rule, $set, $type, $host, $subtest) = @_;
+ $host =~ s/\.\z//s; # strip a redundant trailing dot
my $key = "dns:$type:$host";
- my $existing = $self->{async}->get_lookup($key);
+ my $existing_ent = $self->{async}->get_lookup($key);
# only make a specific query once
- if (!$existing) {
-
+ if (!$existing_ent) {
my $ent = {
key => $key,
zone => $host, # serves to fetch other per-zone settings
@@ -115,32 +114,21 @@ sub do_rbl_lookup {
rules => [ ], # filled in below
# id is filled in after we send the query below
};
-
- my $id = $self->{resolver}->bgsend($host, $type, undef, sub {
- my ($pkt, $id, $timestamp) = @_;
- $self->process_dnsbl_result($ent, $pkt);
- $self->{async}->report_id_complete($id,$key,$timestamp);
- });
-
- if (!defined $id) {
- dbg("dns: SKIPPED launching of DNS $type query for $host");
- } else {
- dbg("dns: launched DNS $type query for $host in background");
- $ent->{id} = $id; # tie up the loose end
- $existing =
- $self->{async}->start_lookup($ent, $self->{master_deadline});
- }
+ $existing_ent = $self->{async}->bgsend_and_start_lookup(
+ $host, $type, undef, $ent,
+ sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
+ master_deadline => $self->{master_deadline} );
}
- if ($existing) {
+ if ($existing_ent) {
# always add set
- push @{$existing->{sets}}, $set;
+ push @{$existing_ent->{sets}}, $set;
# sometimes match or always match
if (defined $subtest) {
$self->{dnspost}->{$set}->{$subtest} = $rule;
} else {
- push @{$existing->{rules}}, $rule;
+ push @{$existing_ent->{rules}}, $rule;
}
$self->{rule_to_rblkey}->{$rule} = $key;
@@ -156,6 +144,7 @@ sub register_rbl_subtest {
sub do_dns_lookup {
my ($self, $rule, $type, $host) = @_;
+ $host =~ s/\.\z//s; # strip a redundant trailing dot
my $key = "dns:$type:$host";
# only make a specific query once
@@ -168,20 +157,11 @@ sub do_dns_lookup {
rules => [ $rule ],
# id is filled in after we send the query below
};
-
- my $id = $self->{resolver}->bgsend($host, $type, undef, sub {
- my ($pkt, $id, $timestamp) = @_;
- $self->process_dnsbl_result($ent, $pkt);
- $self->{async}->report_id_complete($id,$key,$timestamp);
- });
-
- if (!defined $id) {
- dbg("dns: SKIPPED launching of DNS $type query for $host");
- } else {
- dbg("dns: launched DNS $type query for $host in background");
- $ent->{id} = $id; # tie up the loose end
- $self->{async}->start_lookup($ent, $self->{master_deadline});
- }
+ $ent = $self->{async}->bgsend_and_start_lookup(
+ $host, $type, undef, $ent,
+ sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) },
+ master_deadline => $self->{master_deadline} );
+ $ent;
}
###########################################################################
@@ -259,19 +239,19 @@ sub dnsbl_uri {
# called as a completion routine to bgsend by DnsResolver::poll_responses;
# returns 1 on successful packet processing
sub process_dnsbl_result {
- my ($self, $query, $packet) = @_;
+ my ($self, $ent, $pkt) = @_;
- my $question = ($packet->question)[0];
+ my $question = ($pkt->question)[0];
return if !defined $question;
- my $sets = $query->{sets} || [];
- my $rules = $query->{rules};
+ my $sets = $ent->{sets} || [];
+ my $rules = $ent->{rules};
# NO_DNS_FOR_FROM
if ($self->{sender_host} &&
$question->qname eq $self->{sender_host} &&
$question->qtype =~ /^(?:A|MX)$/ &&
- $packet->header->rcode =~ /^(?:NXDOMAIN|SERVFAIL)$/ &&
+ $pkt->header->rcode =~ /^(?:NXDOMAIN|SERVFAIL)$/ &&
++$self->{sender_host_fail} == 2)
{
for my $rule (@{$rules}) {
@@ -280,8 +260,8 @@ sub process_dnsbl_result {
}
# DNSBL tests are here
- foreach my $answer ($packet->answer) {
- next if !defined $answer;
+ foreach my $answer ($pkt->answer) {
+ next if !$answer;
# track all responses
$self->dnsbl_uri($question, $answer);
my $answ_type = $answer->type;
@@ -452,7 +432,6 @@ sub rbl_finish {
$self->set_rbl_tag_data();
- delete $self->{dnscache};
delete $self->{dnspost};
delete $self->{dnsuri};
}
@@ -481,163 +460,23 @@ sub lookup_ns {
my $nsrecords;
dbg("dns: looking up NS for '$dom'");
- if (exists $self->{dnscache}->{NS}->{$dom}) {
- $nsrecords = $self->{dnscache}->{NS}->{$dom};
-
- } else {
- eval {
- my $query = $self->{resolver}->send($dom, 'NS');
- my @nses;
- if ($query) {
- foreach my $rr ($query->answer) {
- if ($rr->type eq "NS") { push (@nses, $rr->nsdname); }
- }
- }
- $nsrecords = $self->{dnscache}->{NS}->{$dom} = [ @nses ];
- 1;
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- dbg("dns: NS lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
- return;
- };
- }
-
- $nsrecords;
-}
-
-sub lookup_mx {
- my ($self, $dom) = @_;
-
- return unless $self->load_resolver();
- return if ($self->server_failed_to_respond_for_domain ($dom));
-
- my $mxrecords;
- dbg("dns: looking up MX for '$dom'");
-
- if (exists $self->{dnscache}->{MX}->{$dom}) {
- $mxrecords = $self->{dnscache}->{MX}->{$dom};
-
- } else {
- eval {
- my $query = $self->{resolver}->send($dom, 'MX');
- my @ips;
- if ($query) {
- foreach my $rr ($query->answer) {
- # just keep the IPs, drop the preferences.
- if ($rr->type eq "MX") { push (@ips, $rr->exchange); }
- }
+ eval {
+ my $query = $self->{resolver}->send($dom, 'NS');
+ my @nses;
+ if ($query) {
+ foreach my $rr ($query->answer) {
+ if ($rr->type eq "NS") { push (@nses, $rr->nsdname); }
}
- $mxrecords = $self->{dnscache}->{MX}->{$dom} = [ @ips ];
- 1;
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- dbg("dns: MX lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
- return;
- };
- }
-
- $mxrecords;
-}
-
-sub lookup_mx_exists {
- my ($self, $dom) = @_;
-
- my $ret = 0;
- my $recs = $self->lookup_mx ($dom);
- if (!defined $recs) { return; }
- if (scalar @{$recs}) { $ret = 1; }
-
- dbg("dns: MX for '$dom' exists? $ret");
- return $ret;
-}
-
-sub lookup_ptr {
- my ($self, $dom) = @_;
-
- return unless $self->load_resolver();
- if ($self->{main}->{local_tests_only}) {
- dbg("dns: local tests only, not looking up PTR");
- return;
- }
-
- my $IP_PRIVATE = IP_PRIVATE;
-
- if ($dom =~ /${IP_PRIVATE}/) {
- dbg("dns: IP is private, not looking up PTR: $dom");
- return;
- }
-
- return if ($self->server_failed_to_respond_for_domain ($dom));
-
- dbg("dns: looking up PTR record for '$dom'");
- my $name = '';
-
- if (exists $self->{dnscache}->{PTR}->{$dom}) {
- $name = $self->{dnscache}->{PTR}->{$dom};
-
- } else {
- eval {
- my $query = $self->{resolver}->send($dom);
- if ($query) {
- foreach my $rr ($query->answer) {
- if ($rr->type eq "PTR") {
- $name = $rr->ptrdname; last;
- }
- }
- }
- $name = $self->{dnscache}->{PTR}->{$dom} = $name;
- 1;
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- dbg("dns: PTR lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
- return;
- };
- }
- dbg("dns: PTR for '$dom': '$name'");
-
- # note: undef is never returned, unless DNS is unavailable.
- return $name;
-}
-
-sub lookup_a {
- my ($self, $name) = @_;
-
- return unless $self->load_resolver();
- if ($self->{main}->{local_tests_only}) {
- dbg("dns: local tests only, not looking up A records");
+ }
+ $nsrecords = [ @nses ];
+ 1;
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ dbg("dns: NS lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
return;
- }
-
- return if ($self->server_failed_to_respond_for_domain ($name));
-
- dbg("dns: looking up A records for '$name'");
- my @addrs;
-
- if (exists $self->{dnscache}->{A}->{$name}) {
- my $addrptr = $self->{dnscache}->{A}->{$name};
- @addrs = @{$addrptr};
-
- } else {
- eval {
- my $query = $self->{resolver}->send($name);
- if ($query) {
- foreach my $rr ($query->answer) {
- if ($rr->type eq "A") {
- push (@addrs, $rr->address);
- }
- }
- }
- $self->{dnscache}->{A}->{$name} = [ @addrs ];
- 1;
- } or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- dbg("dns: A lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
- return;
- };
- }
+ };
- dbg("dns: A records for '$name': " . join(' ',@addrs));
- return @addrs;
+ $nsrecords;
}
sub is_dns_available {
@@ -877,8 +716,8 @@ sub is_rule_complete {
return 0; # not yet complete
}
- my $obj = $self->{async}->get_lookup($key);
- if (!defined $obj) {
+ my $ent = $self->{async}->get_lookup($key);
+ if (!defined $ent) {
dbg("dns: $rule lookup complete, $key no longer pending");
return 1;
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm Wed Jan 16 20:13:47 2013
@@ -482,17 +482,17 @@ sub get_sock {
###########################################################################
-=item $packet = new_dns_packet ($host, $type, $class)
+=item $packet = new_dns_packet ($domain, $type, $class)
A wrapper for C<Net::DNS::Packet::new()> which traps a die thrown by it.
To use this, change calls to C<Net::DNS::Resolver::bgsend> from:
- $res->bgsend($hostname, $type);
+ $res->bgsend($domain, $type);
to:
- $res->bgsend(Mail::SpamAssassin::DnsResolver::new_dns_packet($hostname, $type, $class));
+ $res->bgsend(Mail::SpamAssassin::DnsResolver::new_dns_packet($domain, $type, $class));
=cut
@@ -520,15 +520,15 @@ sub dnsext_dns0x20 {
# this subroutine mimics the Net::DNS::Resolver::Base::make_query_packet()
#
sub new_dns_packet {
- my ($self, $host, $type, $class) = @_;
+ my ($self, $domain, $type, $class) = @_;
return if $self->{no_resolver};
# construct a PTR query if it looks like an IPv4 address
if (!defined($type) || $type eq 'PTR') {
local($1,$2,$3,$4);
- if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
- $host = "$4.$3.$2.$1.in-addr.arpa.";
+ if ($domain =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
+ $domain = "$4.$3.$2.$1.in-addr.arpa.";
$type = 'PTR';
}
}
@@ -537,30 +537,33 @@ sub new_dns_packet {
my $packet;
eval {
- $host =~ s/\.*\z/./s;
- if (length($host) > 255) {
+ $domain =~ s/\.*\z/./s;
+ if (length($domain) > 255) {
die "domain name longer than 255 bytes\n";
- } elsif ($host !~ /^ (?: [^.]{1,63} \. )+ \z/sx) {
- if ($host !~ /^ (?: [^.]+ \. )+ \z/sx) {
+ } elsif ($domain !~ /^ (?: [^.]{1,63} \. )+ \z/sx) {
+ if ($domain !~ /^ (?: [^.]+ \. )+ \z/sx) {
die "a domain name contains a null label\n";
} else {
die "a label in a domain name is longer than 63 bytes\n";
}
}
- $host = dnsext_dns0x20($host) if $self->{conf}->{dns_options}->{dns0x20};
- $packet = Net::DNS::Packet->new($host, $type, $class);
+ if ($self->{conf}->{dns_options}->{dns0x20}) {
+ $domain = dnsext_dns0x20($domain);
+ }
+ $packet = Net::DNS::Packet->new($domain, $type, $class);
# a bit noisy, so commented by default...
- #dbg("dns: new DNS packet time=%.3f host=%s type=%s id=%s",
- # time, $host, $type, $packet->id);
+ #dbg("dns: new DNS packet time=%.3f domain=%s type=%s id=%s",
+ # time, $domain, $type, $packet->id);
1;
} or do {
# this can happen if Net::DNS isn't available -- but in this
# case this function should never be called!
# another possible failure reason: "unexpected null domain label"
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- warn sprintf("dns: new_dns_packet (host=%s type=%s class=%s) failed: %s\n",
- $host, $type, $class, $eval_stat);
+ warn sprintf(
+ "dns: new_dns_packet (domain=%s type=%s class=%s) failed: %s\n",
+ $domain, $type, $class, $eval_stat);
};
if ($packet) {
@@ -607,7 +610,7 @@ sub _packet_id {
my $qname = $ques->qname;
$qname =~ s/\\([0-9]{3}|.)/length($1)==1 ? $1 : chr($1)/gse;
$qname = lc $qname if !$self->{conf}->{dns_options}->{dns0x20};
- return join '/', $id, $qname, $ques->qtype, $ques->qclass;
+ return join '/', $id, $ques->qclass, $ques->qtype, $qname;
} else {
# odd. this should not happen, but clearly some DNS servers
@@ -616,13 +619,13 @@ sub _packet_id {
# (safe) ID part, along with a text token indicating that
# the packet had no question part.
#
- return $id . "NO_QUESTION_IN_PACKET";
+ return $id . "/NO_QUESTION_IN_PACKET";
}
}
###########################################################################
-=item $id = $res->bgsend($host, $type, $class, $cb)
+=item $id = $res->bgsend($domain, $type, $class, $cb)
Quite similar to C<Net::DNS::Resolver::bgsend>, except that when a response
packet eventually arrives, and C<poll_responses> is called, the callback
@@ -637,7 +640,7 @@ reply. The third argument is a timestamp
at the time the packet was collected. It is expected that a closure callback
be used, like so:
- my $id = $self->{resolver}->bgsend($host, $type, undef, sub {
+ my $id = $self->{resolver}->bgsend($domain, $type, undef, sub {
my ($reply, $reply_id, $timestamp) = @_;
$self->got_a_reply ($reply, $reply_id);
});
@@ -648,12 +651,12 @@ port if the reply id does not match the
=cut
sub bgsend {
- my ($self, $host, $type, $class, $cb) = @_;
+ my ($self, $domain, $type, $class, $cb) = @_;
return if $self->{no_resolver};
$self->{send_timed_out} = 0;
- my $pkt = $self->new_dns_packet($host, $type, $class);
+ my $pkt = $self->new_dns_packet($domain, $type, $class);
return if !$pkt; # just bail out, new_dns_packet already reported a failure
my @ns_addr_port = $self->available_nameservers();
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/ASN.pm Wed Jan 16 20:13:47 2013
@@ -294,20 +294,13 @@ sub parsed_metadata {
my $zone_index = $index;
my $zone = $reversed_ip . '.' . $entry->{zone};
my $key = "asnlookup-${zone_index}-$entry->{zone}";
- my $id = $pms->{main}->{resolver}->bgsend($zone, 'TXT', undef, sub {
- my ($pkt, $id, $timestamp) = @_;
- $pms->{async}->set_response_packet($id, $pkt, $key, $timestamp);
- $self->process_dns_result($pms, $pkt, $zone_index);
- });
- if (!defined $id) {
- dbg("asn: SKIPPED launching of DNS TXT query for %s.%s",
- $reversed_ip, $entry->{zone});
- } else {
- my $ent = {
- key=>$key, id=>$id, type=>'TXT',
- zone => $zone, # serves to fetch other per-zone settings
- };
- $pms->{async}->start_lookup($ent, $pms->{master_deadline});
+ my $ent = $pms->{async}->bgsend_and_start_lookup(
+ $zone, 'TXT', undef,
+ { key => $key, zone => $zone },
+ sub { my($ent, $pkt) = @_;
+ $self->process_dns_result($pms, $pkt, $zone_index) },
+ master_deadline => $pms->{master_deadline} );
+ if ($ent) {
dbg("asn: launched DNS TXT query for %s.%s in background",
$reversed_ip, $entry->{zone});
$index++;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/AskDNS.pm Wed Jan 16 20:13:47 2013
@@ -369,7 +369,6 @@ sub extract_metadata {
return if !$pms->is_dns_available;
$pms->{askdns_map_dnskey_to_rules} = {};
- $pms->{askdns_dnskey_to_response} = {};
# walk through all collected askdns rules, obtain tag values whenever
# they may become available, and launch DNS queries right after
@@ -462,8 +461,6 @@ OUTER:
if ($query_domain eq '') {
# ignore, just in case
- } elsif ($pms->{async}->get_lookup($dnskey)) { # already underway?
- warn "askdns: such lookup has already been issued: ".$dnskey;
} else {
if (!exists $pms->{askdns_map_dnskey_to_rules}{$dnskey}) {
$pms->{askdns_map_dnskey_to_rules}{$dnskey} =
@@ -472,28 +469,16 @@ OUTER:
push(@{$pms->{askdns_map_dnskey_to_rules}{$dnskey}},
[$query_type, $answer_types_ref, $rules] );
}
- if (exists $pms->{askdns_dnskey_to_response}{$dnskey}) {
- # answer already available by some earlier query, or query underway
- my $packet = $pms->{askdns_dnskey_to_response}{$dnskey};
- if (!defined $packet) {
- dbg("askdns: dns query %s already launched by some previous query",
- $dnskey);
- } else {
- dbg("askdns: dns answer from some earlier query already available");
- $self->process_response_packet($pms, $packet, $dnskey,
- $query_type, $query_domain);
- }
- } else {
- # lauch a new DNS query for $query_type and $query_domain
- $pms->{askdns_dnskey_to_response}{$dnskey} = undef; # exists, undef
- my $ent = $self->start_lookup(
- $pms, $query_type, $query_domain,
- $self->res_bgsend($pms, $query_domain, $query_type, $dnskey),
- $dnskey);
- # these rules are now underway; unless the rule hits, these will
- # not be considered "finished" until harvest_dnsbl_queries() completes
- $pms->register_async_rule_start($dnskey);
- }
+ # lauch a new DNS query for $query_type and $query_domain
+ my $ent = $pms->{async}->bgsend_and_start_lookup(
+ $query_domain, $query_type, undef,
+ { key => $dnskey, zone => $query_domain },
+ sub { my ($ent2,$pkt) = @_;
+ $self->process_response_packet($pms, $ent2, $pkt, $dnskey) },
+ master_deadline => $pms->{master_deadline} );
+ # these rules are now underway; unless the rule hits, these will
+ # not be considered "finished" until harvest_dnsbl_queries() completes
+ $pms->register_async_rule_start($dnskey) if $ent;
}
last if !@templ_tags;
@@ -508,7 +493,8 @@ OUTER:
}
sub process_response_packet {
- my($self, $pms, $packet, $dnskey, $query_type, $query_domain) = @_;
+ my($self, $pms, $ent, $pkt, $dnskey) = @_;
+
my $conf = $pms->{conf};
my %rulenames_hit;
@@ -516,10 +502,10 @@ sub process_response_packet {
my $queries_ref = $pms->{askdns_map_dnskey_to_rules}{$dnskey};
my($header, @question, @answer, $qtype, $rcode);
- if ($packet) {
- @answer = $packet->answer;
- $header = $packet->header;
- @question = $packet->question;
+ if ($pkt) {
+ @answer = $pkt->answer;
+ $header = $pkt->header;
+ @question = $pkt->question;
$qtype = uc $question[0]->qtype if @question;
my $query_str = join(', ',map($_->qtype.' '.$_->qname, @question));
$rcode = uc $header->rcode if $header; # 'NOERROR', 'NXDOMAIN', ...
@@ -617,7 +603,8 @@ sub process_response_packet {
: 0;
}
if ($match) {
- $self->askdns_hit($pms,$query_domain,$qtype,$rr_rdatastr,$rulename);
+ $self->askdns_hit($pms, $ent->{query_domain}, $qtype,
+ $rr_rdatastr, $rulename);
$rulenames_hit{$rulename} = 1;
}
}
@@ -641,40 +628,4 @@ sub askdns_hit {
$pms->got_hit($rulename, 'ASKDNS: ', ruletype => 'askdns'); # score=>$score
}
-sub start_lookup {
- my($self, $pms, $query_type, $query_domain, $id, $dnskey) = @_;
-
- return if !defined $id;
- my $ent = {
- key => $dnskey,
- domain => $query_domain, # used for logging and reporting
- zone => $query_domain, # serves to fetch per-zone settings
- type => 'ASKDNS-' . $query_type,
- id => $id,
- completed_callback => sub {
- my $ent = shift;
- my $packet = $ent->{response_packet};
- if (defined $packet) { # not aborted or empty
- my $dnskey = $ent->{key};
- # save the response, in case a later generated query would want
- # to make the same lookup
- $pms->{askdns_dnskey_to_response}{$dnskey} = $packet;
- $self->process_response_packet($pms, $packet, $dnskey,
- $query_type, $query_domain);
- }
- }
- };
- $pms->{async}->start_lookup($ent, $pms->{master_deadline});
- return $ent;
-}
-
-sub res_bgsend {
- my($self, $pms, $query_domain, $query_type, $dnskey) = @_;
-
- return $self->{main}->{resolver}->bgsend($query_domain, $query_type, undef,
- sub { my($pkt, $id, $timestamp) = @_;
- $pms->{async}->set_response_packet($id, $pkt, $dnskey, $timestamp);
- });
-}
-
1;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DNSEval.pm Wed Jan 16 20:13:47 2013
@@ -268,7 +268,7 @@ sub check_rbl_backend {
eval {
foreach my $ip (@ips) {
my $revip = reverse_ip_address($ip);
- $pms->do_rbl_lookup($rule, $set, $type, $rbl_server,
+ $pms->do_rbl_lookup($rule, $set, $type,
$revip.'.'.$rbl_server, $subtest) if defined $revip;
}
};
@@ -344,7 +344,7 @@ sub _check_rbl_addresses {
dbg("dns: _check_rbl_addresses RBL $rbl_server, set $set");
for my $host (keys %hosts) {
- $pms->do_rbl_lookup($rule, $set, 'A', $rbl_server, "$host.$rbl_server");
+ $pms->do_rbl_lookup($rule, $set, 'A', "$host.$rbl_server");
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm?rev=1434360&r1=1434359&r2=1434360&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm Wed Jan 16 20:13:47 2013
@@ -338,12 +338,12 @@ sub check_uridnsbl {
# the lookups here!
sub parsed_metadata {
my ($self, $opts) = @_;
- my $scanner = $opts->{permsgstatus};
- my $conf = $scanner->{conf};
+ my $pms = $opts->{permsgstatus};
+ my $conf = $pms->{conf};
return 0 if $conf->{skip_uribl_checks};
- if (!$scanner->is_dns_available()) {
+ if (!$pms->is_dns_available()) {
$self->{dns_not_available} = 1;
return 0;
} else {
@@ -352,18 +352,18 @@ sub parsed_metadata {
$self->{dns_not_available} = 0;
}
- $scanner->{'uridnsbl_activerules'} = { };
- $scanner->{'uridnsbl_hits'} = { };
- $scanner->{'uridnsbl_seen_lookups'} = { };
+ $pms->{'uridnsbl_activerules'} = { };
+ $pms->{'uridnsbl_hits'} = { };
+ $pms->{'uridnsbl_seen_lookups'} = { };
# only hit DNSBLs for active rules (defined and score != 0)
- $scanner->{'uridnsbl_active_rules_rhsbl'} = { };
- $scanner->{'uridnsbl_active_rules_rhsbl_ipsonly'} = { };
- $scanner->{'uridnsbl_active_rules_rhsbl_domsonly'} = { };
- $scanner->{'uridnsbl_active_rules_nsrhsbl'} = { };
- $scanner->{'uridnsbl_active_rules_fullnsrhsbl'} = { };
- $scanner->{'uridnsbl_active_rules_nsrevipbl'} = { };
- $scanner->{'uridnsbl_active_rules_arevipbl'} = { };
+ $pms->{'uridnsbl_active_rules_rhsbl'} = { };
+ $pms->{'uridnsbl_active_rules_rhsbl_ipsonly'} = { };
+ $pms->{'uridnsbl_active_rules_rhsbl_domsonly'} = { };
+ $pms->{'uridnsbl_active_rules_nsrhsbl'} = { };
+ $pms->{'uridnsbl_active_rules_fullnsrhsbl'} = { };
+ $pms->{'uridnsbl_active_rules_nsrevipbl'} = { };
+ $pms->{'uridnsbl_active_rules_arevipbl'} = { };
foreach my $rulename (keys %{$conf->{uridnsbls}}) {
next unless ($conf->is_rule_active('body_evals',$rulename));
@@ -375,21 +375,21 @@ sub parsed_metadata {
my $is_rhsbl = $rulecf->{is_rhsbl};
if ( $is_rhsbl && $tfl{'ips_only'}) {
- $scanner->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename} = 1;
} elsif ($is_rhsbl && $tfl{'domains_only'}) {
- $scanner->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename} = 1;
} elsif ($is_rhsbl) {
- $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
} elsif ($rulecf->{is_fullnsrhsbl}) {
- $scanner->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename} = 1;
} elsif ($rulecf->{is_nsrhsbl}) {
- $scanner->{uridnsbl_active_rules_nsrhsbl}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename} = 1;
} else { # just a plain dnsbl rule (IP based), not a RHS rule (name-based)
if ($tfl{'a'}) { # tflag 'a' explicitly
- $scanner->{uridnsbl_active_rules_arevipbl}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_arevipbl}->{$rulename} = 1;
}
if ($tfl{'ns'} || !$tfl{'a'}) { # tflag 'ns' explicitly, or default
- $scanner->{uridnsbl_active_rules_nsrevipbl}->{$rulename} = 1;
+ $pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename} = 1;
}
}
}
@@ -404,7 +404,7 @@ sub parsed_metadata {
my @uri_ordered;
# Generate the full list of html-parsed domains.
- my $uris = $scanner->get_uri_detail_list();
+ my $uris = $pms->get_uri_detail_list();
# go from uri => info to uri_ordered
# 0: a
@@ -485,14 +485,14 @@ sub parsed_metadata {
}
my @hnames = keys %hostlist;
- $scanner->set_tag('URIHOSTS',
- @hnames == 1 ? $hnames[0] : \@hnames) if @hnames;
+ $pms->set_tag('URIHOSTS',
+ @hnames == 1 ? $hnames[0] : \@hnames) if @hnames;
my @dnames = values %hostlist;
- $scanner->set_tag('URIDOMAINS',
- @dnames == 1 ? $dnames[0] : \@dnames) if @dnames;
+ $pms->set_tag('URIDOMAINS',
+ @dnames == 1 ? $dnames[0] : \@dnames) if @dnames;
# and query
- $self->query_hosts_or_domains($scanner, \%hostlist);
+ $self->query_hosts_or_domains($pms, \%hostlist);
return 1;
}
@@ -567,6 +567,7 @@ sub set_config {
my $rulename = $1;
my $zone = $2;
my $type = $3;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
is_rhsbl => 0
@@ -592,15 +593,13 @@ sub set_config {
my $zone = $2;
my $type = $3;
my $subrule = $4;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
+ $subrule = parse_and_canonicalize_subtest($subrule);
+ defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
- is_rhsbl => 0, is_subrule => 1
+ is_rhsbl => 0, subtest => $subrule,
};
- $self->{uridnsbl_subs}->{$zone} ||= { };
- $subrule = parse_and_canonicalize_subtest($subrule);
- defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
- push(@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}},
- $rulename);
}
elsif ($value =~ /^$/) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
@@ -621,6 +620,7 @@ sub set_config {
my $rulename = $1;
my $zone = $2;
my $type = $3;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
is_rhsbl => 1
@@ -646,15 +646,13 @@ sub set_config {
my $zone = $2;
my $type = $3;
my $subrule = $4;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
+ $subrule = parse_and_canonicalize_subtest($subrule);
+ defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
- is_rhsbl => 1, is_subrule => 1
+ is_rhsbl => 1, subtest => $subrule,
};
- $self->{uridnsbl_subs}->{$zone} ||= { };
- $subrule = parse_and_canonicalize_subtest($subrule);
- defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
- push(@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}},
- $rulename);
}
elsif ($value =~ /^$/) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
@@ -675,6 +673,7 @@ sub set_config {
my $rulename = $1;
my $zone = $2;
my $type = $3;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
is_nsrhsbl => 1
@@ -700,15 +699,13 @@ sub set_config {
my $zone = $2;
my $type = $3;
my $subrule = $4;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
+ $subrule = parse_and_canonicalize_subtest($subrule);
+ defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
- is_nsrhsbl => 1, is_subrule => 1
+ is_nsrhsbl => 1, subtest => $subrule,
};
- $self->{uridnsbl_subs}->{$zone} ||= { };
- $subrule = parse_and_canonicalize_subtest($subrule);
- defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
- push(@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}},
- $rulename);
}
elsif ($value =~ /^$/) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
@@ -729,6 +726,7 @@ sub set_config {
my $rulename = $1;
my $zone = $2;
my $type = $3;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
is_fullnsrhsbl => 1
@@ -754,15 +752,13 @@ sub set_config {
my $zone = $2;
my $type = $3;
my $subrule = $4;
+ $zone =~ s/\.\z//; # strip a redundant trailing dot
+ $subrule = parse_and_canonicalize_subtest($subrule);
+ defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
$self->{uridnsbls}->{$rulename} = {
zone => $zone, type => $type,
- is_fullnsrhsbl => 1, is_subrule => 1
+ is_fullnsrhsbl => 1, subtest => $subrule,
};
- $self->{uridnsbl_subs}->{$zone} ||= { };
- $subrule = parse_and_canonicalize_subtest($subrule);
- defined $subrule or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
- push(@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}},
- $rulename);
}
elsif ($value =~ /^$/) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
@@ -821,17 +817,17 @@ sub set_config {
# ---------------------------------------------------------------------------
sub query_hosts_or_domains {
- my ($self, $scanner, $hosthash_ref) = @_;
- my $conf = $scanner->{conf};
- my $seen_lookups = $scanner->{'uridnsbl_seen_lookups'};
-
- my $rhsblrules = $scanner->{uridnsbl_active_rules_rhsbl};
- my $rhsbliprules = $scanner->{uridnsbl_active_rules_rhsbl_ipsonly};
- my $rhsbldomrules = $scanner->{uridnsbl_active_rules_rhsbl_domsonly};
- my $nsrhsblrules = $scanner->{uridnsbl_active_rules_nsrhsbl};
- my $fullnsrhsblrules = $scanner->{uridnsbl_active_rules_fullnsrhsbl};
- my $nsreviprules = $scanner->{uridnsbl_active_rules_nsrevipbl};
- my $areviprules = $scanner->{uridnsbl_active_rules_arevipbl};
+ my ($self, $pms, $hosthash_ref) = @_;
+ my $conf = $pms->{conf};
+ my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
+
+ my $rhsblrules = $pms->{uridnsbl_active_rules_rhsbl};
+ my $rhsbliprules = $pms->{uridnsbl_active_rules_rhsbl_ipsonly};
+ my $rhsbldomrules = $pms->{uridnsbl_active_rules_rhsbl_domsonly};
+ my $nsrhsblrules = $pms->{uridnsbl_active_rules_nsrhsbl};
+ my $fullnsrhsblrules = $pms->{uridnsbl_active_rules_fullnsrhsbl};
+ my $nsreviprules = $pms->{uridnsbl_active_rules_nsrevipbl};
+ my $areviprules = $pms->{uridnsbl_active_rules_arevipbl};
while (my($host,$domain) = each(%$hosthash_ref)) {
$domain = lc $domain; # just in case
@@ -846,7 +842,7 @@ sub query_hosts_or_domains {
# only look up the IP if it is public and valid
if ($host =~ /^$IPV4_ADDRESS$/o && $host !~ /^$IP_PRIVATE$/o) {
my $obj = { dom => $host };
- $self->lookup_dnsbl_for_ip($scanner, $obj, $host);
+ $self->lookup_dnsbl_for_ip($pms, $obj, $host);
# and check the IP in RHSBLs too
local($1,$2,$3,$4);
if ($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
@@ -873,13 +869,13 @@ sub query_hosts_or_domains {
foreach my $rulename (@rhsblrules) {
my $rulecf = $conf->{uridnsbls}->{$rulename};
- $self->lookup_single_dnsbl($scanner, $obj, $rulename,
+ $self->lookup_single_dnsbl($pms, $obj, $rulename,
$domain, $rulecf->{zone}, $rulecf->{type});
# note that these rules are now underway. important: unless the
# rule hits, in the current design, these will not be considered
# "finished" until harvest_dnsbl_queries() completes
- $scanner->register_async_rule_start($rulename);
+ $pms->register_async_rule_start($rulename);
}
# perform NS+A or A queries to look up the domain in the non-RHSBL subset,
@@ -888,13 +884,13 @@ sub query_hosts_or_domains {
if ( !$seen_lookups->{'NS:'.$domain} &&
(%$nsreviprules || %$nsrhsblrules || %$fullnsrhsblrules) ) {
$seen_lookups->{'NS:'.$domain} = 1;
- $self->lookup_domain_ns($scanner, $obj, $domain);
+ $self->lookup_domain_ns($pms, $obj, $domain);
}
if (%$areviprules && !$seen_lookups->{'A:'.$host}) {
$seen_lookups->{'A:'.$host} = 1;
my $obj = { dom => $host };
- $self->lookup_a_record($scanner, $obj, $host);
- $scanner->register_async_rule_start($_) for keys %$areviprules;
+ $self->lookup_a_record($pms, $obj, $host);
+ $pms->register_async_rule_start($_) for keys %$areviprules;
}
}
}
@@ -904,31 +900,36 @@ sub query_hosts_or_domains {
# ---------------------------------------------------------------------------
sub lookup_domain_ns {
- my ($self, $scanner, $obj, $dom) = @_;
-
- my $key = "NS:".$dom;
- return if $scanner->{async}->get_lookup($key);
+ my ($self, $pms, $obj, $dom, $rulename) = @_;
+ my $key = "NS:" . $dom;
+ my $ent = {
+ key => $key, zone => $dom, obj => $obj, type => "URI-NS",
+ rulename => $rulename,
+ };
# dig $dom ns
- my $ent = $self->start_lookup($scanner, $dom, 'NS',
- $self->res_bgsend($scanner, $dom, 'NS', $key),
- $key);
- $ent->{obj} = $obj if $ent;
+ $ent = $pms->{async}->bgsend_and_start_lookup(
+ $dom, 'NS', undef, $ent,
+ sub { my ($ent2,$pkt) = @_;
+ $self->complete_ns_lookup($pms, $ent2, $pkt, $dom) },
+ master_deadline => $pms->{master_deadline} );
+
+ return $ent;
}
sub complete_ns_lookup {
- my ($self, $scanner, $ent, $dom) = @_;
- my $conf = $scanner->{conf};
+ my ($self, $pms, $ent, $pkt, $dom) = @_;
+ my $conf = $pms->{conf};
- my $packet = $ent->{response_packet};
+ dbg("uridnsbl: complete_ns_lookup %s", $ent->{key});
my @answer;
- @answer = $packet->answer if $packet;
+ @answer = $pkt->answer if $pkt;
my $IPV4_ADDRESS = IPV4_ADDRESS;
my $IP_PRIVATE = IP_PRIVATE;
- my $nsrhsblrules = $scanner->{uridnsbl_active_rules_nsrhsbl};
- my $fullnsrhsblrules = $scanner->{uridnsbl_active_rules_fullnsrhsbl};
- my $seen_lookups = $scanner->{'uridnsbl_seen_lookups'};
+ my $nsrhsblrules = $pms->{uridnsbl_active_rules_nsrhsbl};
+ my $fullnsrhsblrules = $pms->{uridnsbl_active_rules_fullnsrhsbl};
+ my $seen_lookups = $pms->{'uridnsbl_seen_lookups'};
my $j = 0;
foreach my $rr (@answer) {
@@ -946,32 +947,32 @@ sub complete_ns_lookup {
if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+$/) {
# only look up the IP if it is public and valid
if ($nsmatch =~ /^$IPV4_ADDRESS$/o && $nsmatch !~ /^$IP_PRIVATE$/o) {
- $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $nsmatch);
+ $self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $nsmatch);
}
$nsrhblstr = $nsmatch;
}
else {
if (!$seen_lookups->{'A:'.$nsmatch}) {
$seen_lookups->{'A:'.$nsmatch} = 1;
- $self->lookup_a_record($scanner, $ent->{obj}, $nsmatch);
+ $self->lookup_a_record($pms, $ent->{obj}, $nsmatch);
}
$nsrhblstr = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($nsmatch);
}
foreach my $rulename (keys %{$nsrhsblrules}) {
my $rulecf = $conf->{uridnsbls}->{$rulename};
- $self->lookup_single_dnsbl($scanner, $ent->{obj}, $rulename,
+ $self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
$nsrhblstr, $rulecf->{zone}, $rulecf->{type});
- $scanner->register_async_rule_start($rulename);
+ $pms->register_async_rule_start($rulename);
}
foreach my $rulename (keys %{$fullnsrhsblrules}) {
my $rulecf = $conf->{uridnsbls}->{$rulename};
- $self->lookup_single_dnsbl($scanner, $ent->{obj}, $rulename,
+ $self->lookup_single_dnsbl($pms, $ent->{obj}, $rulename,
$fullnsrhblstr, $rulecf->{zone}, $rulecf->{type});
- $scanner->register_async_rule_start($rulename);
+ $pms->register_async_rule_start($rulename);
}
}
}
@@ -980,24 +981,29 @@ sub complete_ns_lookup {
# ---------------------------------------------------------------------------
sub lookup_a_record {
- my ($self, $scanner, $obj, $hname) = @_;
-
- my $key = "A:".$hname;
- return if $scanner->{async}->get_lookup($key);
+ my ($self, $pms, $obj, $hname, $rulename) = @_;
+ my $key = "A:" . $hname;
+ my $ent = {
+ key => $key, zone => $hname, obj => $obj, type => "URI-A",
+ rulename => $rulename,
+ };
# dig $hname a
- my $ent = $self->start_lookup($scanner, $hname, 'A',
- $self->res_bgsend($scanner, $hname, 'A', $key),
- $key);
- $ent->{obj} = $obj if $ent;
+ $ent = $pms->{async}->bgsend_and_start_lookup(
+ $hname, 'A', undef, $ent,
+ sub { my ($ent2,$pkt) = @_;
+ $self->complete_a_lookup($pms, $ent2, $pkt, $hname) },
+ master_deadline => $pms->{master_deadline} );
+
+ return $ent;
}
sub complete_a_lookup {
- my ($self, $scanner, $ent, $hname) = @_;
+ my ($self, $pms, $ent, $pkt, $hname) = @_;
- my $packet = $ent->{response_packet};
+ dbg("uridnsbl: complete_a_lookup %s", $ent->{key});
my @answer;
- @answer = $packet->answer if $packet;
+ @answer = $pkt->answer if $pkt;
my $j = 0;
foreach my $rr (@answer) {
$j++;
@@ -1012,7 +1018,7 @@ sub complete_a_lookup {
local $1;
if ($str =~ /IN\s+A\s+(\S+)/) {
- $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $1);
+ $self->lookup_dnsbl_for_ip($pms, $ent->{obj}, $1);
}
}
}
@@ -1020,16 +1026,16 @@ sub complete_a_lookup {
# ---------------------------------------------------------------------------
sub lookup_dnsbl_for_ip {
- my ($self, $scanner, $obj, $ip) = @_;
+ my ($self, $pms, $obj, $ip) = @_;
local($1,$2,$3,$4);
$ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
my $revip = "$4.$3.$2.$1";
- my $conf = $scanner->{conf};
+ my $conf = $pms->{conf};
my $tflags = $conf->{tflags};
- my $cfns = $scanner->{uridnsbl_active_rules_nsrevipbl};
- my $cfa = $scanner->{uridnsbl_active_rules_arevipbl};
+ my $cfns = $pms->{uridnsbl_active_rules_nsrevipbl};
+ my $cfa = $pms->{uridnsbl_active_rules_arevipbl};
foreach my $rulename (keys %$cfa, keys %$cfns) {
my $rulecf = $conf->{uridnsbls}->{$rulename};
@@ -1037,47 +1043,42 @@ sub lookup_dnsbl_for_ip {
next if defined $tflags->{$rulename} &&
$tflags->{$rulename} =~ /\b(?:ips_only|domains_only)\b/;
- $self->lookup_single_dnsbl($scanner, $obj, $rulename,
+ $self->lookup_single_dnsbl($pms, $obj, $rulename,
$revip, $rulecf->{zone}, $rulecf->{type});
}
}
sub lookup_single_dnsbl {
- my ($self, $scanner, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
+ my ($self, $pms, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
- my $key = "DNSBL:".$dnsbl.":".$lookupstr;
- return if $scanner->{async}->get_lookup($key);
-
- my $item = $lookupstr.".".$dnsbl;
+ my $key = "DNSBL:" . $lookupstr . ':' . $dnsbl;
+ my $ent = {
+ key => $key, zone => $dnsbl, obj => $obj, type => 'URI-DNSBL',
+ rulename => $rulename,
+ };
+ $ent = $pms->{async}->bgsend_and_start_lookup(
+ $lookupstr.".".$dnsbl, $qtype, undef, $ent,
+ sub { my ($ent2,$pkt) = @_;
+ $self->complete_dnsbl_lookup($pms, $ent2, $pkt) },
+ master_deadline => $pms->{master_deadline} );
- # dig $ip txt
- my $ent = $self->start_lookup($scanner, $item, 'DNSBL',
- $self->res_bgsend($scanner, $item, $qtype, $key),
- $key);
- if ($ent) {
- $ent->{obj} = $obj;
- $ent->{rulename} = $rulename;
- $ent->{zone} = $dnsbl;
- }
+ return $ent;
}
sub complete_dnsbl_lookup {
- my ($self, $scanner, $ent, $dnsblip) = @_;
+ my ($self, $pms, $ent, $pkt) = @_;
+ dbg("uridnsbl: complete_dnsbl_lookup %s %s", $ent->{rulename}, $ent->{key});
my(@answer,@subtests);
- my $conf = $scanner->{conf};
+ my $conf = $pms->{conf};
my $zone = $ent->{zone};
my $dom = $ent->{obj}->{dom};
my $rulename = $ent->{rulename};
- my $packet = $ent->{response_packet};
- @answer = $packet->answer if $packet;
+ @answer = $pkt->answer if $pkt;
my $rulecf = $conf->{uridnsbls}->{$rulename};
- # subrule tests (filters) for a given zone
- my $uridnsbl_subs = $conf->{uridnsbl_subs}->{$zone};
-
foreach my $rr (@answer)
{
my($rdatastr,$rdatanum);
@@ -1097,143 +1098,76 @@ sub complete_dnsbl_lookup {
next;
}
- if (!$rulecf->{is_subrule}) {
+ my $subtest = $rulecf->{subtest};
+
+ dbg("uridnsbl: %s . %s -> %s, %s%s",
+ $dom, $zone, $rdatastr, $rulename,
+ !defined $subtest ? '' : ', subtest:'.$subtest);
+
+ my $match;
+ if (!defined $subtest) {
# this zone is a simple rule, not a set of subrules
# skip any A record that isn't on 127/8
if ($rr_type eq 'A' && $rdatastr !~ /^127\./) {
warn("uridnsbl: bogus rr for domain=$dom, rule=$rulename, id=" .
- $packet->header->id." rr=".$rr->string);
+ $pkt->header->id." rr=".$rr->string);
next;
}
- $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $rulename);
- }
- else {
- local($1,$2,$3);
- foreach my $subtest (keys (%{$uridnsbl_subs})) {
-
- # dbg("uridnsbl: %s . %s -> %s, %s, sub:%s",
- # $dom, $zone, $rdatastr, $rulename,
- # join('.',@{$uridnsbl_subs->{$subtest}->{rulenames}}) );
-
- my $match;
- if ($subtest eq $rdatastr) {
- $match = 1;
- } elsif ($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) == ($n1 & $n2) # value/mask
- : 0;
-
- # dbg("uridnsbl: %s . %s -> %s, %s, %08x %s %s",
- # $dom, $zone, $rdatastr, $rulename, $rdatanum,
- # !defined $n2 ? sprintf('& %08x', $n1)
- # : $n1 == $n2 ? sprintf('== %08x', $n1)
- # : sprintf('%08x%s%08x', $n1,$delim,$n2),
- # $match ? 'match' : 'no');
-
- }
- if ($match) {
- foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
- $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
- }
- }
- }
+ $match = 1;
+ } elsif ($subtest eq $rdatastr) {
+ $match = 1;
+ } elsif ($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) == ($n1 & $n2) # value/mask
+ : 0;
+
+ dbg("uridnsbl: %s . %s -> %s, %s, %08x %s %s",
+ $dom, $zone, $rdatastr, $rulename, $rdatanum,
+ !defined $n2 ? sprintf('& %08x', $n1)
+ : $n1 == $n2 ? sprintf('== %08x', $n1)
+ : sprintf('%08x%s%08x', $n1,$delim,$n2),
+ $match ? 'match' : 'no');
}
+ $self->got_dnsbl_hit($pms, $ent, $rdatastr, $dom, $rulename) if $match;
}
}
sub got_dnsbl_hit {
- my ($self, $scanner, $ent, $str, $dom, $rulename) = @_;
+ my ($self, $pms, $ent, $str, $dom, $rulename) = @_;
$str =~ s/\s+/ /gs; # long whitespace => short
dbg("uridnsbl: domain \"$dom\" listed ($rulename): $str");
- if (!defined $scanner->{uridnsbl_hits}->{$rulename}) {
- $scanner->{uridnsbl_hits}->{$rulename} = { };
+ if (!defined $pms->{uridnsbl_hits}->{$rulename}) {
+ $pms->{uridnsbl_hits}->{$rulename} = { };
};
- $scanner->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
+ $pms->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
- if ( $scanner->{uridnsbl_active_rules_nsrevipbl}->{$rulename}
- || $scanner->{uridnsbl_active_rules_arevipbl}->{$rulename}
- || $scanner->{uridnsbl_active_rules_nsrhsbl}->{$rulename}
- || $scanner->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename}
- || $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename}
- || $scanner->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename}
- || $scanner->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename})
+ if ( $pms->{uridnsbl_active_rules_nsrevipbl}->{$rulename}
+ || $pms->{uridnsbl_active_rules_arevipbl}->{$rulename}
+ || $pms->{uridnsbl_active_rules_nsrhsbl}->{$rulename}
+ || $pms->{uridnsbl_active_rules_fullnsrhsbl}->{$rulename}
+ || $pms->{uridnsbl_active_rules_rhsbl}->{$rulename}
+ || $pms->{uridnsbl_active_rules_rhsbl_ipsonly}->{$rulename}
+ || $pms->{uridnsbl_active_rules_rhsbl_domsonly}->{$rulename})
{
# TODO: this needs to handle multiple domain hits per rule
- $scanner->clear_test_state();
- my $uris = join (' ', keys %{$scanner->{uridnsbl_hits}->{$rulename}});
- $scanner->test_log ("URIs: $uris");
- $scanner->got_hit ($rulename, "");
+ $pms->clear_test_state();
+ my $uris = join (' ', keys %{$pms->{uridnsbl_hits}->{$rulename}});
+ $pms->test_log ("URIs: $uris");
+ $pms->got_hit ($rulename, "");
# note that this rule has completed (since it got at least 1 hit)
- $scanner->register_async_rule_finish($rulename);
+ $pms->register_async_rule_finish($rulename);
}
}
# ---------------------------------------------------------------------------
-sub start_lookup {
- my ($self, $scanner, $zone, $type, $id, $key) = @_;
-
- return if !defined $id;
- my $ent = {
- key => $key,
- zone => $zone, # serves to fetch other per-zone settings
- type => "URI-".$type,
- id => $id,
- completed_callback => sub {
- my $ent = shift;
- if (defined $ent->{response_packet}) { # not aborted or empty
- $self->completed_lookup_callback ($scanner, $ent);
- }
- }
- };
- $scanner->{async}->start_lookup($ent, $scanner->{master_deadline});
- return $ent;
-}
-
-sub completed_lookup_callback {
- my ($self, $scanner, $ent) = @_;
- my $type = $ent->{type};
- my $key = $ent->{key};
- my $val = $key; $val =~ s/^[^:]*://s;
-
- # key could be: "A:link.software-dispa tch.intel.com"
- # "A:reba b324.storedrugs.ru"
- # <a href="http://Reba B324.storedrugs.ru/item/...>
- #
- dbg("uridnsbl: completed_lookup_callback type=%s, key=%s, val=%s",
- $type, $key, $val);
-
- if ($type eq 'URI-NS') {
- $self->complete_ns_lookup ($scanner, $ent, $val);
- }
- elsif ($type eq 'URI-A') {
- $self->complete_a_lookup ($scanner, $ent, $val);
- }
- elsif ($type eq 'URI-DNSBL') {
- $self->complete_dnsbl_lookup ($scanner, $ent, $val);
- }
-}
-
-# ---------------------------------------------------------------------------
-
-sub res_bgsend {
- my ($self, $scanner, $host, $type, $key) = @_;
-
- return $self->{main}->{resolver}->bgsend($host, $type, undef, sub {
- my ($pkt, $id, $timestamp) = @_;
- $scanner->{async}->set_response_packet($id, $pkt, $key, $timestamp);
- });
-}
-
-# ---------------------------------------------------------------------------
-
# capability checks for "if can()":
#
sub has_tflags_domains_only { 1 }