in lib/Mail/SpamAssassin/AsyncLoop.pm [204:385]
sub bgsend_and_start_lookup {
my $self = shift;
my($domain, $type, $class, $ent, $cb, %options) = @_;
return if $self->{main}->{resolver}->{no_resolver};
# Waiting for priority -100 to launch?
if ($self->{wait_queue}) {
push @{$self->{bgsend_queue}}, [@_];
dbg("async: DNS priority not reached, queueing lookup: $domain/$type");
return $ent;
}
if (!defined $ent->{rulename} && !$self->{rulename_warned}++) {
my($package, $filename, $line) = caller;
warn "async: bgsend_and_start_lookup called without rulename, ".
"from $package ($filename) line $line. You are likely using ".
"a plugin that is not compatible with SpamAssasin 4.0.0.";
}
$domain =~ s/\.+\z//s; # strip trailing dots, these sometimes still sneak in
$domain = idn_to_ascii($domain);
# At this point the $domain should already be encoded to UTF-8 and
# IDN converted to ASCII-compatible encoding (ACE). Make sure this is
# really the case in order to be able to catch any leftover omissions.
if (utf8::is_utf8($domain)) {
utf8::encode($domain);
my($package, $filename, $line) = caller;
info("bgsend_and_start_lookup: Unicode domain name, expected octets: %s, ".
"called from %s line %d", $domain, $package, $line);
} elsif ($domain =~ tr/\x00-\x7F//c) { # is not all-ASCII
my($package, $filename, $line) = caller;
info("bgsend_and_start_lookup: non-ASCII domain name: %s, ".
"called from %s line %d", $domain, $package, $line);
}
my $dnskey = uc($type).'/'.lc($domain);
my $dns_query_info = $self->{all_lookups}{$dnskey};
$ent = {} if !$ent;
$ent->{id} = undef;
my $key = $ent->{key} = $dnskey;
$ent->{query_type} = $type;
$ent->{query_domain} = $domain;
$ent->{type} = $type if !exists $ent->{type};
$ent->{zone} = $domain if !exists $ent->{zone};
$cb = $ent->{completed_callback} if !$cb; # compatibility with SA < 3.4
my @rulenames = grep { defined } (ref $ent->{rulename} ?
@{$ent->{rulename}} : $ent->{rulename});
$self->{rules_for_key}->{$key}{$_} = 1 foreach (@rulenames);
if ($dns_query_info) { # DNS query already underway or completed
if ($dns_query_info->{blocked}) {
dbg("async: blocked by %s: %s, rules: %s", $dns_query_info->{blocked},
$dnskey, join(", ", @rulenames));
return;
}
my $id = $ent->{id} = $dns_query_info->{id}; # re-use existing query
return if !defined $id; # presumably some fatal failure
my $id_tail = $id; $id_tail =~ s{^\d+/IN/}{};
lc($id_tail) eq lc($dnskey)
or info("async: unmatched id %s, key=%s", $id, $dnskey);
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]);
$self->{pending_rules}->{$_}{$key} = 1 foreach (@rulenames);
dbg("async: query %s already underway, adding no.%d, rules: %s",
$id, scalar @{$dns_query_info->{applicants}},
join(", ", @rulenames));
} else { # DNS query already completed, re-use results
# answer already known, just do the callback and be done with it
delete $self->{pending_rules}->{$_}{$key} foreach (@rulenames);
if (!$cb) {
dbg("async: query %s already done, re-using for %s, rules: %s",
$id, $key, join(", ", @rulenames));
} else {
dbg("async: query %s already done, re-using for %s, callback, rules: %s",
$id, $key, join(", ", @rulenames));
eval {
$cb->($ent, $pkt); 1;
} or do {
chomp $@;
# resignal if alarm went off
die "async: (1) $@\n" if $@ =~ /__alarm__ignore__\(.*\)/s;
warn sprintf("async: 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, $check_dbrdom);
# dns_query_restriction
my $blocked_by = 'dns_query_restriction';
my $dns_query_blockages = $self->{main}->{conf}->{dns_query_blocked};
# dns_block_rule
my $dns_block_domains = $self->{main}->{conf}->{dns_block_rule_domains};
if ($dns_query_blockages || $dns_block_domains) {
my $search_list = domain_to_search_list($domain);
foreach my $parent_domain ((@$search_list, '*')) {
if ($dns_query_blockages) {
$blocked = $dns_query_blockages->{$parent_domain};
last if defined $blocked; # stop at first defined, can be true or false
}
if ($parent_domain ne '*' && exists $dns_block_domains->{$parent_domain}) {
# save for later check.. ps. untainted already
$check_dbrdom = $dns_block_domains->{$parent_domain};
}
}
}
if (!$blocked && $check_dbrdom) {
my $blockfile =
$self->{main}->sed_path("__global_state_dir__/dnsblock_${check_dbrdom}");
if (my $mtime = (stat($blockfile))[9]) {
if (time - $mtime <= $self->{main}->{conf}->{dns_block_time}) {
$blocked = 1;
$blocked_by = 'dns_block_rule';
} else {
dbg("async: dns_block_rule removing expired $blockfile");
unlink($blockfile);
}
}
}
if ($blocked) {
dbg("async: blocked by %s: %s, rules: %s", $blocked_by, $dnskey,
join(", ", @rulenames));
$dns_query_info->{blocked} = $blocked_by;
} else {
dbg("async: launching %s, rules: %s", $dnskey, join(", ", @rulenames));
$id = $self->{main}->{resolver}->bgsend($domain, $type, $class, sub {
my($pkt, $pkt_id, $timestamp) = @_;
# this callback sub is called from DnsResolver::poll_responses()
# dbg("async: in a bgsend_and_start_lookup callback, id %s", $pkt_id);
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_count = 0;
foreach my $tuple (@{$dns_query_info->{applicants}}) {
my($appl_ent, $appl_cb) = @$tuple;
my @rulenames = grep { defined } (ref $appl_ent->{rulename} ?
@{$appl_ent->{rulename}} : $appl_ent->{rulename});
foreach (@rulenames) {
delete $self->{pending_rules}->{$_}{$appl_ent->{key}};
}
if ($appl_cb) {
dbg("async: calling callback on key %s, rules: %s",
$key, join(", ", @rulenames));
$cb_count++;
eval {
$appl_cb->($appl_ent, $pkt); 1;
} or do {
chomp $@;
# resignal if alarm went off
die "async: (2) $@\n" if $@ =~ /__alarm__ignore__\(.*\)/s;
warn sprintf("async: query %s completed, callback %s failed: %s\n",
$id, $appl_ent->{key}, $@);
};
}
}
delete $dns_query_info->{applicants};
dbg("async: query $id completed, no callbacks run") if !$cb_count;
});
}
return if !defined $id;
$dns_query_info->{id} = $ent->{id} = $id;
push(@{$dns_query_info->{applicants}}, [$ent,$cb]);
$self->{pending_rules}->{$_}{$key} = 1 foreach (@rulenames);
$self->_start_lookup($ent, $options{master_deadline});
}
return $ent;
}