← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:50 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm
StatementsExecuted 2880 statements in 28.4ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2341132.1ms66.9msMail::SpamAssassin::Plugin::AskDNS::::extract_metadataMail::SpamAssassin::Plugin::AskDNS::extract_metadata
211278µs630µsMail::SpamAssassin::Plugin::AskDNS::::__ANON__[:356]Mail::SpamAssassin::Plugin::AskDNS::__ANON__[:356]
11192µs92µsMail::SpamAssassin::Plugin::AskDNS::::CORE:regcompMail::SpamAssassin::Plugin::AskDNS::CORE:regcomp (opcode)
11182µs293µsMail::SpamAssassin::Plugin::AskDNS::::newMail::SpamAssassin::Plugin::AskDNS::new
11172µs182µsMail::SpamAssassin::Plugin::AskDNS::::parse_and_canonicalize_subtestMail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest
94166µs66µsMail::SpamAssassin::Plugin::AskDNS::::CORE:matchMail::SpamAssassin::Plugin::AskDNS::CORE:match (opcode)
11153µs67µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@187Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187
11140µs155µsMail::SpamAssassin::Plugin::AskDNS::::set_configMail::SpamAssassin::Plugin::AskDNS::set_config
11124µs154µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@192Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192
11123µs64µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@188Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188
11122µs95µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@189Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189
11122µs184µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@195Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195
11121µs155µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@193Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193
11113µs13µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@191Mail::SpamAssassin::Plugin::AskDNS::BEGIN@191
11111µs11µsMail::SpamAssassin::Plugin::AskDNS::::CORE:qrMail::SpamAssassin::Plugin::AskDNS::CORE:qr (opcode)
0000s0sMail::SpamAssassin::Plugin::AskDNS::::__ANON__[:397]Mail::SpamAssassin::Plugin::AskDNS::__ANON__[:397]
0000s0sMail::SpamAssassin::Plugin::AskDNS::::__ANON__[:488]Mail::SpamAssassin::Plugin::AskDNS::__ANON__[:488]
0000s0sMail::SpamAssassin::Plugin::AskDNS::::askdns_hitMail::SpamAssassin::Plugin::AskDNS::askdns_hit
0000s0sMail::SpamAssassin::Plugin::AskDNS::::launch_queriesMail::SpamAssassin::Plugin::AskDNS::launch_queries
0000s0sMail::SpamAssassin::Plugin::AskDNS::::process_response_packetMail::SpamAssassin::Plugin::AskDNS::process_response_packet
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements. See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License. You may obtain a copy of the License at:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17
18=head1 NAME
19
20AskDNS - form a DNS query using tag values, and look up the DNSxL lists
21
22=head1 SYNOPSIS
23
24 loadplugin Mail::SpamAssassin::Plugin::AskDNS
25 askdns D_IN_DWL _DKIMDOMAIN_._vouch.dwl.spamhaus.org TXT /\b(transaction|list|all)\b/
26
27=head1 DESCRIPTION
28
29Using a DNS query template as specified in a parameter of a askdns rule,
30the plugin replaces tag names as found in the template with their values
31and launches DNS queries as soon as tag values become available. When DNS
32responses trickle in, filters them according to the requested DNS resource
33record type and optional subrule filtering expression, yielding a rule hit
34if a response meets filtering conditions.
35
36=head1 USER SETTINGS
37
38=over 4
39
40=item rbl_timeout t [t_min] [zone] (default: 15 3)
41
42The rbl_timeout setting is common to all DNS querying rules (as implemented
43by other plugins). It can specify a DNS query timeout globally, or individually
44for each zone. When the zone parameter is specified, the settings affects DNS
45queries when their query domain equals the specified zone, or is its subdomain.
46See the C<Mail::SpamAssassin::Conf> POD for details on C<rbl_timeout>.
47
48=back
49
50=head1 RULE DEFINITIONS
51
52=over 4
53
54=item askdns NAME_OF_RULE query_template [rr_type [subqueryfilter]]
55
56A query template is a string which will be expanded to produce a domain name
57to be used in a DNS query. The template may include SpamAssassin tag names,
58which will be replaced by their values to form a final query domain.
59The final query domain must adhere to rules governing DNS domains, i.e.
60must consist of fields each up to 63 characters long, delimited by dots.
61There may be a trailing dot at the end, but it is redundant / carries
62no semantics, because SpamAssassin uses a Net::DSN::Resolver::send method
63for querying DNS, which ignores any 'search' or 'domain' DNS resolver options.
64Domain names in DNS queries are case-insensitive.
65
66A tag name is a string of capital letters, preceded and followed by an
67underscore character. This syntax mirrors the add_header setting, except that
68tags cannot have parameters in parenthesis when used in askdns templates.
69Tag names may appear anywhere in the template - each queried DNS zone
70prescribes how a query should be formed.
71
72A query template may contain any number of tag names including none,
73although in the most common anticipated scenario exactly one tag name would
74appear in each askdns rule. Specified tag names are considered dependencies.
75Askdns rules with dependencies on the same set of tags are grouped, and all
76queries in a group are launched as soon as all their dependencies are met,
77i.e. when the last of the awaited tag values becomes available by a call
78to set_tag() from some other plugin or elsewhere in the SpamAssassin code.
79
80Launched queries from all askdns rules are grouped too according to a pair
81of: query type and an expanded query domain name. Even if there are multiple
82rules producing the same type/domain pair, only one DNS query is launched,
83and a reply to such query contributes to all the constituent rules.
84
85A tag may produce none, one or multiple values. Askdns rules awaiting for
86a tag which never receives its value never result in a DNS query. Tags which
87produce multiple values will result in multiple queries launched, each with
88an expanded template using one of the tag values. An example is a DKIMDOMAIN
89tag which yields a list of signing domains, one for each valid signature in
90a signed message.
91
92When more than one distinct tag name appears in a template, each potentially
93resulting in multiple values, a Cartesian product is formed, and each tuple
94results in a launch of one DNS query (duplicates excluded). For example,
95a query template _A_._B_.example._A_.com where tag A is a list (11,22)
96and B is (xx,yy,zz), will result in queries: 11.xx.example.11.com,
9722.xx.example.22.com, 11.yy.example.11.com, 22.yy.example.22.com,
9811.zz.example.11.com, 22.zz.example.22.com .
99
100A parameter rr_type following the query template is a comma-separated list
101of expected DNS resource record (RR) types. Missing rr_type parameter implies
102an 'A'. A DNS result may bring resource records of multiple types, but only
103resource records of a type found in the rr_type parameter list are considered,
104other resource records found in the answer section of a DNS reply are ignored
105for this rule. A value ANY in the rr_type parameter list matches any resource
106record type. An empty DNS answer section does not match ANY.
107
108The rr_type parameter not only provides a filter for RR types found in
109the DNS answer, but also determines the DNS query type. If only a single
110RR type is specified in the parameter (e.g. TXT), than this is also the RR
111type of a query. When more than one RR type is specified (e.g. A, AAAA, TXT)
112or if ANY is specified, then the DNS query type will be ANY and the rr_type
113parameter will only act as a filter on a result.
114
115Currently recognized RR types in the rr_type parameter are: ANY, A, AAAA,
116MX, TXT, PTR, NAPTR, NS, SOA, CERT, CNAME, DNAME, DHCID, HINFO, MINFO,
117RP, HIP, IPSECKEY, KX, LOC, SRV, SSHFP, SPF.
118
119http://www.iana.org/assignments/dns-parameters/dns-parameters.xml
120
121The last optional parameter of a rule is a filtering expression, a.k.a. a
122subrule. Its function is much like the subrule in URIDNSBL plugin rules,
123or in the check_rbl eval rules. The main difference is that with askdns
124rules there is no need to manually group rules according to their queried
125zone, as the grouping is automatic and duplicate queries are implicitly
126eliminated.
127
128The subrule filtering parameter can be: a plain string, a regular expression,
129a single numerical value or a pair of numerical values, or a list of rcodes
130(DNS status codes of a response). Absence of the filtering parameter implies
131no filtering, i.e. any positive DNS response (rcode=NOERROR) of the requested
132RR type will result in a rule hit, regardless of the RR value returned with
133the response.
134
135When a plain string is used as a filter, it must be enclosed in single or
136double quotes. For the rule to hit, the response must match the filtering
137string exactly, and a RR type of a response must match the query type.
138Typical use is an exact text string for TXT queries, or an exact quad-dotted
139IPv4 address. In case of a TXT or SPF resource record which can return
140multiple character-strings (as defined in Section 3.3 of [RFC1035]), these
141strings are concatenated with no delimiters before comparing the result
142to the filtering string. This follows requirements of several documents,
143such as RFC 5518, RFC 4408, RFC 4871, RFC 5617. Examples of a plain text
144filtering parameter: "127.0.0.1", "transaction", 'list' .
145
146A regular expression follows a familiar perl syntax like /.../ or m{...}
147optionally followed by regexp flags (such as 'i' for case-insensitivity).
148If a DNS response matches the requested RR type and the regular expression,
149the rule hits. Examples: /^127\.0\.0\.\d+$/, m{\bdial up\b}i .
150
151A single numerical value can be a decimal number, or a hexadecimal number
152prefixed by 0x. Such numeric filtering expression is typically used with
153RR type-A DNS queries. The returned value (an IPv4 address) is masked
154with a specified filtering value and tested to fall within a 127.0.0.0/8
155network range - the rule hits if the result is nonzero:
156((r & n) != 0) && ((r & 0xff000000) == 0x7f000000). An example: 0x10 .
157
158A pair of numerical values (each a decimal, hexadecimal or quad-dotted)
159delimited by a '-' specifies an IPv4 address range, and a pair of values
160delimited by a '/' specifies an IPv4 address followed by a bitmask. Again,
161this type of filtering expression is primarily intended with RR type-A
162DNS queries. The rule hits if the RR type matches, and the returned IP
163address falls within the specified range: (r >= n1 && r <= n2), or
164masked with a bitmask matches the specified value: (r & m) == (n & m) .
165
166As a shorthand notation, a single quad-dotted value is equivalent to
167a n-n form, i.e. it must match the returned value exactly with all its bits.
168
169Some typical examples of a numeric filtering parameter are: 127.0.1.2,
170127.0.1.20-127.0.1.39, 127.0.1.0/255.255.255.0, 0.0.0.16/0.0.0.16,
1710x10/0x10, 16, 0x10 .
172
173Lastly, the filtering parameter can be a comma-separated list of DNS status
174codes (rcode), enclosed in square brackets. Rcodes can be represented either
175by their numeric decimal values (0=NOERROR, 3=NXDOMAIN, ...), or their names.
176See http://www.iana.org/assignments/dns-parameters for the list of names. When
177testing for a rcode where rcode is nonzero, a RR type parameter is ignored
178as a filter, as there is typically no answer section in a DNS reply when
179rcode indicates an error. Example: [NXDOMAIN], or [FormErr,ServFail,4,5] .
180
181=back
182
183=cut
184
185package Mail::SpamAssassin::Plugin::AskDNS;
186
187265µs281µs
# spent 67µs (53+14) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187 which was called: # once (53µs+14µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 187
use strict;
# spent 67µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187 # spent 14µs making 1 call to strict::import
188264µs2104µs
# spent 64µs (23+40) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188 which was called: # once (23µs+40µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 188
use warnings;
# spent 64µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188 # spent 40µs making 1 call to warnings::import
189263µs2167µs
# spent 95µs (22+73) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189 which was called: # once (22µs+73µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 189
use re 'taint';
# spent 95µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189 # spent 73µs making 1 call to re::import
190
191259µs113µs
# spent 13µs within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@191 which was called: # once (13µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 191
use Mail::SpamAssassin::Plugin;
# spent 13µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@191
192267µs2285µs
# spent 154µs (24+130) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192 which was called: # once (24µs+130µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 192
use Mail::SpamAssassin::Util qw(decode_dns_question_entry);
# spent 154µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192 # spent 130µs making 1 call to Exporter::import
193262µs2288µs
# spent 155µs (21+134) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193 which was called: # once (21µs+134µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 193
use Mail::SpamAssassin::Logger;
# spent 155µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193 # spent 134µs making 1 call to Exporter::import
194
19524.89ms2347µs
# spent 184µs (22+163) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195 which was called: # once (22µs+163µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 195
use vars qw(@ISA %rcode_value $txtdata_can_provide_a_list);
# spent 184µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195 # spent 163µs making 1 call to vars::import
196120µs@ISA = qw(Mail::SpamAssassin::Plugin);
197
198118µs%rcode_value = ( # http://www.iana.org/assignments/dns-parameters, RFC 6195
199 NOERROR => 0, FORMERR => 1, SERVFAIL => 2, NXDOMAIN => 3, NOTIMP => 4,
200 REFUSED => 5, YXDOMAIN => 6, YXRRSET => 7, NXRRSET => 8, NOTAUTH => 9,
201 NOTZONE => 10, BADVERS => 16, BADSIG => 16, BADKEY => 17, BADTIME => 18,
202 BADMODE => 19, BADNAME => 20, BADALG => 21, BADTRUNC => 22,
203);
204
205
# spent 293µs (82+212) within Mail::SpamAssassin::Plugin::AskDNS::new which was called: # once (82µs+212µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 113)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
20613µs my($class,$sa_main) = @_;
207
20812µs $class = ref($class) || $class;
209113µs126µs my $self = $class->SUPER::new($sa_main);
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::new
21012µs bless($self, $class);
211
21218µs1155µs $self->set_config($sa_main->{conf});
# spent 155µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::set_config
213
214163µs131µs $txtdata_can_provide_a_list = Net::DNS->VERSION >= 0.69;
# spent 31µs making 1 call to version::_VERSION
215
216110µs return $self;
217}
218
219# ---------------------------------------------------------------------------
220
221# Accepts argument as a string in single or double quotes, or as a regular
222# expression in // or m{} notation, or as a numerical value or a pair of
223# numerical values, or as a bracketed and comma-separated list of DNS rcode
224# names or their numerical codes. Recognized numerical forms are: m, n1-n2,
225# or n/m, where n,n1,n2,m can be any of: decimal digits, 0x followed by
226# up to 8 hexadecimal digits, or an IPv4 address in quad-dotted notation.
227# The argument is checked for syntax, undef is returned on syntax errors.
228# A string that looks like a regular expression is converted to a compiled
229# Regexp object and returned as a result. Otherwise, numeric components of
230# the remaining three forms are converted as follows: hex or decimal numeric
231# strings are converted to a number and a quad-dot is converted to a number,
232# then components are reassembled into a string delimited by '-' or '/'.
233# As a special backward compatibility measure, a single quad-dot (with no
234# second number) is converted into n-n, to distinguish it from a traditional
235# mask-only form. A list or rcodes is returned as a hashref, where keys
236# represent specified numerical rcodes.
237#
238# Arguments like the following are anticipated:
239# "127.0.0.1", "some text", 'some "more" text',
240# /regexp/flags, m{regexp}flags,
241# 127.0.1.2 (same as 127.0.1.2-127.0.1.2 or 127.0.1.2/255.255.255.255)
242# 127.0.1.20-127.0.1.39 (= 0x7f000114-0x7f000127 or 2130706708-2130706727)
243# 0.0.0.16/0.0.0.16 (same as 0x10/0x10 or 16/0x10 or 16/16)
244# 16 (traditional style mask-only, same as 0x10)
245# [NXDOMAIN], [FormErr,ServFail,4,5]
246#
247
# spent 182µs (72+110) within Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest which was called: # once (72µs+110µs) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 329
sub parse_and_canonicalize_subtest {
24813µs my($subtest) = @_;
24912µs my $result;
250
25115µs local($1,$2,$3);
252 # modifiers /a, /d, /l, /u in suffix form were added with perl 5.13.10 (5.14)
253 # currently known modifiers are [msixoadlu], but let's not be too picky here
254121µs16µs if ( $subtest =~ m{^ / (.+) / ([a-z]*) \z}xs) {
# spent 6µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::CORE:match
2551140µs2104µs $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
# spent 92µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::CORE:regcomp # spent 11µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::CORE:qr
256 } elsif ($subtest =~ m{^ m \s* \( (.+) \) ([a-z]*) \z}xs) {
257 $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
258 } elsif ($subtest =~ m{^ m \s* \[ (.+) \] ([a-z]*) \z}xs) {
259 $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
260 } elsif ($subtest =~ m{^ m \s* \{ (.+) \} ([a-z]*) \z}xs) {
261 $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
262 } elsif ($subtest =~ m{^ m \s* < (.+) > ([a-z]*) \z}xs) {
263 $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
264 } elsif ($subtest =~ m{^ m \s* (\S) (.+) \1 ([a-z]*) \z}xs) {
265 $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
266 } elsif ($subtest =~ m{^ (["']) (.*) \1 \z}xs) { # quoted string
267 $result = $2;
268 } elsif ($subtest =~ m{^ \[ ( (?:[A-Z]+|\d+)
269 (?: \s* , \s* (?:[A-Z]+|\d+) )* ) \] \z}xis) {
270 # a comma-separated list of rcode names or their decimal values
271 my @rcodes = split(/\s*,\s*/, uc $1);
272 for (@rcodes) { $_ = $rcode_value{$_} if exists $rcode_value{$_} }
273 return if grep(!/^\d+\z/, @rcodes);
274 # a hashref indicates a list of DNS rcodes (stored as hash keys)
275 $result = { map( ($_,1), @rcodes) };
276 } elsif ($subtest =~ m{^ ([^/-]+) (?: ([/-]) (.+) )? \z}xs) {
277 my($n1,$delim,$n2) = ($1,$2,$3);
278 my $any_quad_dot;
279 for ($n1,$n2) {
280 if (!defined $_) {
281 # ok, $n2 may not exist
282 } elsif (/^\d{1,10}\z/) {
283 $_ = 0 + $_; # decimal string -> number
284 } elsif (/^0x[0-9a-zA-Z]{1,8}\z/) {
285 $_ = hex($_); # hex string -> number
286 } elsif (/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/) {
287 $_ = Mail::SpamAssassin::Util::my_inet_aton($_); # quad-dot -> number
288 $any_quad_dot = 1;
289 } else {
290 return;
291 }
292 }
293 $result = defined $n2 ? $n1.$delim.$n2
294 : $any_quad_dot ? $n1.'-'.$n1 : "$n1";
295 }
296114µs return $result;
297}
298
299
# spent 155µs (40+114) within Mail::SpamAssassin::Plugin::AskDNS::set_config which was called: # once (40µs+114µs) by Mail::SpamAssassin::Plugin::AskDNS::new at line 212
sub set_config {
30012µs my($self, $conf) = @_;
30112µs my @cmds;
302
303 push(@cmds, {
304 setting => 'askdns',
305 is_admin => 1,
306 type => $Mail::SpamAssassin::Conf::CONF_TYPE_HASH_KEY_VALUE,
307
# spent 630µs (278+352) within Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] which was called 2 times, avg 315µs/call: # 2 times (278µs+352µs) by Mail::SpamAssassin::Conf::Parser::parse at line 438 of Mail/SpamAssassin/Conf/Parser.pm, avg 315µs/call
code => sub {
308211µs my($self, $key, $value, $line) = @_;
309211µs local($1,$2,$3,$4);
310289µs436µs if (!defined $value || $value =~ /^$/) {
# spent 36µs making 4 calls to Mail::SpamAssassin::Plugin::AskDNS::CORE:match, avg 9µs/call
311 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
312 } elsif ($value !~ /^ (\S+) \s+ (\S+)
313 (?: \s+ ([A-Za-z0-9,]+)
314 (?: \s+ (.*?) )? )? \s* $/xs) {
315 return $Mail::SpamAssassin::Conf::INVALID_VALUE;
316 } else {
317213µs my($rulename,$query_template,$query_type,$subtest) = ($1,$2,$3,$4);
31824µs $query_type = 'A' if !defined $query_type;
31927µs $query_type = uc $query_type;
320211µs my @answer_types = split(/,/, $query_type);
321 # http://www.iana.org/assignments/dns-parameters/dns-parameters.xml
322234µs210µs if (grep(!/^(?:ANY|A|AAAA|MX|TXT|PTR|NAPTR|NS|SOA|CERT|CNAME|DNAME|
# spent 10µs making 2 calls to Mail::SpamAssassin::Plugin::AskDNS::CORE:match, avg 5µs/call
323 DHCID|HINFO|MINFO|RP|HIP|IPSECKEY|KX|LOC|SRV|
324 SSHFP|SPF)\z/x, @answer_types)) {
325 return $Mail::SpamAssassin::Conf::INVALID_VALUE;
326 }
32727µs $query_type = 'ANY' if @answer_types > 1 || $answer_types[0] eq 'ANY';
32826µs if (defined $subtest) {
329110µs1182µs $subtest = parse_and_canonicalize_subtest($subtest);
# spent 182µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest
33012µs defined $subtest or return $Mail::SpamAssassin::Conf::INVALID_VALUE;
331 }
332 # collect tag names as used in each query template
333234µs213µs my @tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/g;
# spent 13µs making 2 calls to Mail::SpamAssassin::Plugin::AskDNS::CORE:match, avg 7µs/call
334419µs my %seen; @tags = grep(!$seen{$_}++, @tags); # filter out duplicates
335
336 # group rules by tag names used in them (to be used as a hash key)
337210µs my $depends_on_tags = !@tags ? '' : join(',',@tags);
338
339 # subgroup rules by a DNS RR type and a nonexpanded query template
34029µs my $query_template_key = $query_type . ':' . $query_template;
341
342223µs $self->{askdns}{$depends_on_tags}{$query_template_key} ||=
343 { query => $query_template, rules => {}, q_type => $query_type,
344 a_types => # optimization: undef means "same as q_type"
345 @answer_types == 1 && $answer_types[0] eq $query_type ? undef
346 : \@answer_types };
347210µs $self->{askdns}{$depends_on_tags}{$query_template_key}{rules}{$rulename}
348 = $subtest;
349 # dbg("askdns: rule: %s, config dep: %s, domkey: %s, subtest: %s",
350 # $rulename, $depends_on_tags, $query_template_key, $subtest);
351
352 # just define the test so that scores and lint works
353223µs2110µs $self->{parser}->add_test($rulename, undef,
# spent 110µs making 2 calls to Mail::SpamAssassin::Conf::Parser::add_test, avg 55µs/call
354 $Mail::SpamAssassin::Conf::TYPE_EMPTY_TESTS);
355 }
356 }
357114µs });
358
359118µs1114µs $conf->{parser}->register_commands(\@cmds);
# spent 114µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands
360}
361
362# run as early as possible, launching DNS queries as soon as their
363# dependencies are fulfilled
364#
365
# spent 66.9ms (32.1+34.8) within Mail::SpamAssassin::Plugin::AskDNS::extract_metadata which was called 234 times, avg 286µs/call: # 234 times (32.1ms+34.8ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm, avg 286µs/call
sub extract_metadata {
366234526µs my($self, $opts) = @_;
367234813µs my $pms = $opts->{permsgstatus};
368234643µs my $conf = $pms->{conf};
369
3702342.35ms23412.1ms return if !$pms->is_dns_available;
# spent 12.1ms making 234 calls to Mail::SpamAssassin::PerMsgStatus::is_dns_available, avg 52µs/call
371234992µs $pms->{askdns_map_dnskey_to_rules} = {};
372
373 # walk through all collected askdns rules, obtain tag values whenever
374 # they may become available, and launch DNS queries right after
375 #
3764684.70ms for my $depends_on_tags (keys %{$conf->{askdns}}) {
377234441µs my @tags;
3782341.74ms @tags = split(/,/, $depends_on_tags) if $depends_on_tags ne '';
379
3802341.66ms2343.45ms if (would_log("dbg","askdns")) {
# spent 3.45ms making 234 calls to Mail::SpamAssassin::Logger::would_log, avg 15µs/call
381 while ( my($query_template_key, $struct) =
382 each %{$conf->{askdns}{$depends_on_tags}} ) {
383 my($query_template, $query_type, $answer_types_ref, $rules) =
384 @$struct{qw(query q_type a_types rules)};
385 dbg("askdns: depend on tags %s, rules: %s ",
386 $depends_on_tags, join(', ', keys %$rules));
387 }
388 }
389
3902342.67ms if (!@tags) {
391 # no dependencies on tags, just call directly
392 $self->launch_queries($pms,$depends_on_tags);
393 } else {
394 # enqueue callback for tags needed
395 $pms->action_depends_on_tags(@tags == 1 ? $tags[0] : \@tags,
396 sub { my($pms,@args) = @_;
397 $self->launch_queries($pms,$depends_on_tags) }
3982345.90ms23419.2ms );
# spent 19.2ms making 234 calls to Mail::SpamAssassin::PerMsgStatus::action_depends_on_tags, avg 82µs/call
399 }
400 }
401}
402
403# generate DNS queries - called for each set of rules
404# when their tag dependencies are met
405#
406sub launch_queries {
407 my($self, $pms, $depends_on_tags) = @_;
408 my $conf = $pms->{conf};
409
410 my %tags;
411 # obtain tag/value pairs of tags we depend upon in this set of rules
412 if ($depends_on_tags ne '') {
413 %tags = map( ($_,$pms->get_tag($_)), split(/,/,$depends_on_tags) );
414 }
415 dbg("askdns: preparing queries which depend on tags: %s",
416 join(', ', map($_.' => '.$tags{$_}, keys %tags)));
417
418 # replace tag names in a query template with actual tag values
419 # and launch DNS queries
420 while ( my($query_template_key, $struct) =
421 each %{$conf->{askdns}{$depends_on_tags}} ) {
422 my($query_template, $query_type, $answer_types_ref, $rules) =
423 @$struct{qw(query q_type a_types rules)};
424
425 my @rulenames = keys %$rules;
426 if (grep($conf->{scores}->{$_}, @rulenames)) {
427 dbg("askdns: query template %s, type %s, rules: %s",
428 $query_template,
429 !$answer_types_ref ? $query_type
430 : $query_type.'/'.join(',',@$answer_types_ref),
431 join(', ', @rulenames));
432 } else {
433 dbg("askdns: query template %s, type %s, all rules disabled: %s",
434 $query_template, $query_type, join(', ', @rulenames));
435 next;
436 }
437
438 # collect all tag names from a template, each may occur more than once
439 my @templ_tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/gs;
440
441 # filter out duplicate tag names, and tags with undefined or empty value
442 my %seen;
443 @templ_tags = grep(!$seen{$_}++ && defined $tags{$_} && $tags{$_} ne '',
444 @templ_tags);
445
446 my %templ_vals; # values that each tag takes
447 for my $t (@templ_tags) {
448 my %seen;
449 # a tag value may be a space-separated list,
450 # store it as an arrayref, removing duplicate values
451 $templ_vals{$t} = [ grep(!$seen{$_}++, split(' ',$tags{$t})) ];
452 }
453
454 # count through all tag value tuples
455 my @digit = (0) x @templ_tags; # counting accumulator
456OUTER:
457 for (;;) {
458 my %current_tag_val; # maps a tag name to its current iteration value
459 for my $j (0 .. $#templ_tags) {
460 my $t = $templ_tags[$j];
461 $current_tag_val{$t} = $templ_vals{$t}[$digit[$j]];
462 }
463 local $1;
464 my $query_domain = $query_template;
465 $query_domain =~ s{_([A-Z][A-Z0-9]*)_}
466 { defined $current_tag_val{$1} ? $current_tag_val{$1}
467 : '' }ge;
468
469 # the $dnskey identifies this query in AsyncLoop's pending_lookups
470 my $dnskey = join(':', 'askdns', $query_type, $query_domain);
471 dbg("askdns: expanded query %s, dns key %s", $query_domain, $dnskey);
472
473 if ($query_domain eq '') {
474 # ignore, just in case
475 } else {
476 if (!exists $pms->{askdns_map_dnskey_to_rules}{$dnskey}) {
477 $pms->{askdns_map_dnskey_to_rules}{$dnskey} =
478 [ [$query_type, $answer_types_ref, $rules] ];
479 } else {
480 push(@{$pms->{askdns_map_dnskey_to_rules}{$dnskey}},
481 [$query_type, $answer_types_ref, $rules] );
482 }
483 # lauch a new DNS query for $query_type and $query_domain
484 my $ent = $pms->{async}->bgsend_and_start_lookup(
485 $query_domain, $query_type, undef,
486 { key => $dnskey, zone => $query_domain },
487 sub { my ($ent2,$pkt) = @_;
488 $self->process_response_packet($pms, $ent2, $pkt, $dnskey) },
489 master_deadline => $pms->{master_deadline} );
490 # these rules are now underway; unless the rule hits, these will
491 # not be considered "finished" until harvest_dnsbl_queries() completes
492 $pms->register_async_rule_start($dnskey) if $ent;
493 }
494
495 last if !@templ_tags;
496 # increment accumulator, little-endian
497 for (my $j = 0; ; $j++) {
498 last if ++$digit[$j] <= $#{$templ_vals{$templ_tags[$j]}};
499 $digit[$j] = 0; # and carry
500 last OUTER if $j >= $#templ_tags;
501 }
502 }
503 }
504}
505
506sub process_response_packet {
507 my($self, $pms, $ent, $pkt, $dnskey) = @_;
508
509 my $conf = $pms->{conf};
510 my %rulenames_hit;
511
512 # map a dnskey back to info on queries which caused this DNS lookup
513 my $queries_ref = $pms->{askdns_map_dnskey_to_rules}{$dnskey};
514
515 my($header, @question, @answer, $qtype, $rcode);
516 # NOTE: $pkt will be undef if the DNS query was aborted (e.g. timed out)
517 if ($pkt) {
518 @answer = $pkt->answer;
519 $header = $pkt->header;
520 @question = $pkt->question;
521 $qtype = uc $question[0]->qtype if @question;
522 $rcode = uc $header->rcode if $header; # 'NOERROR', 'NXDOMAIN', ...
523
524 # NOTE: qname is encoded in RFC 1035 zone format, decode it
525 dbg("askdns: answer received, rcode %s, query %s, answer has %d records",
526 $rcode,
527 join(', ', map(join('/', decode_dns_question_entry($_)), @question)),
528 scalar @answer);
529
530 if (defined $rcode && exists $rcode_value{$rcode}) {
531 # Net::DNS return a rcode name for codes it knows about,
532 # and returns a number for the rest; we deal with numbers from here on
533 $rcode = $rcode_value{$rcode} if exists $rcode_value{$rcode};
534 }
535 }
536 if (!@answer) {
537 # a trick to make the following loop run at least once, so that we can
538 # evaluate also rules which only care for rcode status
539 @answer = ( undef );
540 }
541
542 # NOTE: $rr->rdatastr returns the result encoded in a DNS zone file
543 # format, i.e. enclosed in double quotes if a result contains whitespace
544 # (or other funny characters), and may use \DDD encoding or \X quoting as
545 # per RFC 1035. Using $rr->txtdata instead avoids this unnecessary encoding
546 # step and a need for decoding by a caller, returning an unmodified string.
547 # Caveat: in case of multiple RDATA <character-string> fields contained
548 # in a resource record (TXT, SPF, HINFO), starting with Net::DNS 0.69
549 # the $rr->txtdata in a list context returns these strings as a list.
550 # The $rr->txtdata in a scalar context always returns a single string
551 # with <character-string> fields joined by a single space character as
552 # a separator. The $rr->txtdata in Net::DNS 0.68 and older returned
553 # such joined space-separated string even in a list context.
554
555 # RFC 5518: If the RDATA in a TXT record contains multiple
556 # character-strings (as defined in Section 3.3 of [RFC1035]),
557 # the code handling such reply from DNS MUST assemble all of these
558 # marshaled text blocks into a single one before any syntactical
559 # verification takes place.
560 # The same goes for RFC 4408 (SPF), RFC 4871 (DKIM), RFC 5617 (ADSP),
561 # draft-kucherawy-dmarc-base (DMARC), ...
562
563 for my $rr (@answer) {
564 my($rr_rdatastr, $rdatanum, $rr_type);
565 if (!$rr) {
566 # special case, no answer records, only rcode can be tested
567 } else {
568 $rr_type = uc $rr->type;
569 if ($rr->UNIVERSAL::can('txtdata')) { # TXT, SPF
570 # join with no intervening spaces, as per RFC 5518
571 if ($txtdata_can_provide_a_list || $rr_type ne 'TXT') {
572 $rr_rdatastr = join('', $rr->txtdata); # txtdata() in list context!
573 } else { # char_str_list() is only available for TXT records
574 $rr_rdatastr = join('', $rr->char_str_list); # historical
575 }
576 } else {
577 $rr_rdatastr = $rr->rdatastr;
578 if ($rr_type eq 'A' &&
579 $rr_rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/) {
580 $rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rr_rdatastr);
581 }
582 }
583 # dbg("askdns: received rr type %s, data: %s", $rr_type, $rr_rdatastr);
584 }
585
586 my $j = 0;
587 for my $q_tuple (!ref $queries_ref ? () : @$queries_ref) {
588 next if !$q_tuple;
589 my($query_type, $answer_types_ref, $rules) = @$q_tuple;
590
591 next if !defined $qtype || $query_type ne $qtype;
592 $answer_types_ref = [$query_type] if !defined $answer_types_ref;
593
594 # mark rule as done
595 $pms->{askdns_map_dnskey_to_rules}{$dnskey}[$j++] = undef;
596
597 while (my($rulename,$subtest) = each %$rules) {
598 my $match;
599 local($1,$2,$3);
600 if (ref $subtest eq 'HASH') { # a list of DNS rcodes (as hash keys)
601 $match = 1 if $subtest->{$rcode};
602 } elsif ($rcode != 0) {
603 # skip remaining tests on DNS error
604 } elsif (!defined($rr_type) ||
605 !grep($_ eq 'ANY' || $_ eq $rr_type, @$answer_types_ref) ) {
606 # skip remaining tests on wrong RR type
607 } elsif (!defined $subtest) {
608 $match = 1; # any valid response of the requested RR type matches
609 } elsif (ref $subtest eq 'Regexp') { # a regular expression
610 $match = 1 if $rr_rdatastr =~ $subtest;
611 } elsif ($rr_rdatastr eq $subtest) { # exact equality
612 $match = 1;
613 } elsif (defined $rdatanum &&
614 $subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) {
615 my($n1,$delim,$n2) = ($1,$2,$3);
616 $match =
617 !defined $n2 ? ($rdatanum & $n1) && # mask only
618 (($rdatanum & 0xff000000) == 0x7f000000) # 127/8
619 : $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range
620 : $delim eq '/' ? ($rdatanum & $n2) == ($n1 & $n2) # value/mask
621 : 0;
622 }
623 if ($match) {
624 $self->askdns_hit($pms, $ent->{query_domain}, $qtype,
625 $rr_rdatastr, $rulename);
626 $rulenames_hit{$rulename} = 1;
627 }
628 }
629 }
630 }
631 # these rules have completed (since they got at least 1 hit)
632 $pms->register_async_rule_finish($_) for keys %rulenames_hit;
633}
634
635sub askdns_hit {
636 my($self, $pms, $query_domain, $qtype, $rr_rdatastr, $rulename) = @_;
637
638 $rr_rdatastr = '' if !defined $rr_rdatastr; # e.g. with rules testing rcode
639 dbg('askdns: domain "%s" listed (%s): %s',
640 $query_domain, $rulename, $rr_rdatastr);
641
642 # only the first hit will show in the test log report, even if
643 # an answer section matches more than once - got_hit() handles this
644 $pms->clear_test_state;
645 $pms->test_log(sprintf("%s %s:%s", $query_domain,$qtype,$rr_rdatastr));
646 $pms->got_hit($rulename, 'ASKDNS: ', ruletype => 'askdns'); # score=>$score
647}
648
649118µs1;
 
# spent 66µs within Mail::SpamAssassin::Plugin::AskDNS::CORE:match which was called 9 times, avg 7µs/call: # 4 times (36µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 310, avg 9µs/call # 2 times (13µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 333, avg 7µs/call # 2 times (10µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 322, avg 5µs/call # once (6µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest at line 254
sub Mail::SpamAssassin::Plugin::AskDNS::CORE:match; # opcode
# spent 11µs within Mail::SpamAssassin::Plugin::AskDNS::CORE:qr which was called: # once (11µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest at line 255
sub Mail::SpamAssassin::Plugin::AskDNS::CORE:qr; # opcode
# spent 92µs within Mail::SpamAssassin::Plugin::AskDNS::CORE:regcomp which was called: # once (92µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest at line 255
sub Mail::SpamAssassin::Plugin::AskDNS::CORE:regcomp; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.