in lib/Mail/SpamAssassin/Plugin/AskDNS.pm [466:581]
sub process_response_packet {
my($self, $pms, $ent, $pkt, $rulename) = @_;
# NOTE: $pkt will be undef if the DNS query was aborted (e.g. timed out)
return if !$pkt;
my @question = $pkt->question;
return if !@question;
$pms->rule_ready($rulename); # mark rule ready for metas
my @answer = $pkt->answer;
my $rcode = uc $pkt->header->rcode; # 'NOERROR', 'NXDOMAIN', ...
# NOTE: qname is encoded in RFC 1035 zone format, decode it
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);
# Net::DNS return a rcode name for codes it knows about,
# and returns a number for the rest; we deal with numbers from here on
$rcode = $rcode_value{$rcode} if exists $rcode_value{$rcode};
# a trick to make the following loop run at least once, so that we can
# evaluate also rules which only care for rcode status
@answer = (undef) if !@answer;
# NOTE: $rr->rdstring returns the result encoded in a DNS zone file
# format, i.e. enclosed in double quotes if a result contains whitespace
# (or other funny characters), and may use \DDD encoding or \X quoting as
# per RFC 1035. Using $rr->txtdata instead avoids this unnecessary encoding
# step and a need for decoding by a caller, returning an unmodified string.
# Caveat: in case of multiple RDATA <character-string> fields contained
# in a resource record (TXT, SPF, HINFO), starting with Net::DNS 0.69
# the $rr->txtdata in a list context returns these strings as a list.
# The $rr->txtdata in a scalar context always returns a single string
# with <character-string> fields joined by a single space character as
# a separator. The $rr->txtdata in Net::DNS 0.68 and older returned
# such joined space-separated string even in a list context.
# RFC 5518: If the RDATA in a TXT record contains multiple
# character-strings (as defined in Section 3.3 of [RFC1035]),
# the code handling such reply from DNS MUST assemble all of these
# marshaled text blocks into a single one before any syntactical
# verification takes place.
# The same goes for RFC 7208 (SPF), RFC 4871 (DKIM), RFC 5617 (ADSP),
# draft-kucherawy-dmarc-base (DMARC), ...
my $arule = $pms->{conf}->{askdns}{$rulename};
my $subtest = $arule->{subtest};
for my $rr (@answer) {
my($rr_rdatastr, $rdatanum, $rr_type);
if (!$rr) {
# special case, no answer records, only rcode can be tested
} else {
$rr_type = uc $rr->type;
if ($rr_type eq 'A') {
$rr_rdatastr = $rr->address;
if ($rr_rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/) {
$rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rr_rdatastr);
}
} elsif ($rr->UNIVERSAL::can('txtdata')) {
# TXT, SPF: join with no intervening spaces, as per RFC 5518
$rr_rdatastr = join('', $rr->txtdata); # txtdata() in list context!
# Net::DNS attempts to decode text strings in a TXT record as UTF-8,
# which is undesired: octets failing the UTF-8 decoding are converted
# to a Unicode "replacement character" U+FFFD (encoded as octets
# \x{EF}\x{BF}\x{BD} in UTF-8), and ASCII text is unnecessarily
# flagged as perl native characters (utf8 flag on), which can be
# disruptive on later processing, e.g. implicitly upgrading strings
# on concatenation. Unfortunately there is no way of legally bypassing
# the UTF-8 decoding by Net::DNS::RR::TXT in Net::DNS::RR::Text.
# Try to minimize damage by encoding back to UTF-8 octets:
utf8::encode($rr_rdatastr) if utf8::is_utf8($rr_rdatastr);
} else {
$rr_rdatastr = $rr->rdstring;
utf8::encode($rr_rdatastr) if utf8::is_utf8($rr_rdatastr);
}
# dbg("askdns: received rr type %s, data: %s", $rr_type, $rr_rdatastr);
}
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, @{$arule->{a_types}}) ) {
# 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}, $question[0]->qtype,
$rr_rdatastr, $rulename);
}
}
}