← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:05 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm
StatementsExecuted 2892 statements in 28.9ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2351124.2ms67.0msMail::SpamAssassin::Plugin::AskDNS::::extract_metadataMail::SpamAssassin::Plugin::AskDNS::extract_metadata
211320µs739µsMail::SpamAssassin::Plugin::AskDNS::::__ANON__[:356]Mail::SpamAssassin::Plugin::AskDNS::__ANON__[:356]
11196µs96µsMail::SpamAssassin::Plugin::AskDNS::::CORE:regcompMail::SpamAssassin::Plugin::AskDNS::CORE:regcomp (opcode)
94186µs86µsMail::SpamAssassin::Plugin::AskDNS::::CORE:matchMail::SpamAssassin::Plugin::AskDNS::CORE:match (opcode)
11172µs184µsMail::SpamAssassin::Plugin::AskDNS::::parse_and_canonicalize_subtestMail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest
11172µs262µsMail::SpamAssassin::Plugin::AskDNS::::newMail::SpamAssassin::Plugin::AskDNS::new
11158µs69µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@187Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187
11142µs138µsMail::SpamAssassin::Plugin::AskDNS::::set_configMail::SpamAssassin::Plugin::AskDNS::set_config
11131µs239µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@193Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193
11126µs90µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@189Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189
11124µs216µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@195Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195
11124µs143µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@192Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192
11121µs55µsMail::SpamAssassin::Plugin::AskDNS::::BEGIN@188Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188
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
187279µs281µs
# spent 69µs (58+11) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187 which was called: # once (58µs+11µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 187
use strict;
# spent 69µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@187 # spent 11µs making 1 call to strict::import
188277µs289µs
# spent 55µs (21+34) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188 which was called: # once (21µs+34µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 188
use warnings;
# spent 55µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@188 # spent 34µs making 1 call to warnings::import
189259µs2154µs
# spent 90µs (26+64) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189 which was called: # once (26µs+64µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 189
use re 'taint';
# spent 90µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@189 # spent 64µs making 1 call to re::import
190
191260µ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
192276µs2263µs
# spent 143µs (24+120) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192 which was called: # once (24µs+120µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 192
use Mail::SpamAssassin::Util qw(decode_dns_question_entry);
# spent 143µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@192 # spent 120µs making 1 call to Exporter::import
193271µs2447µs
# spent 239µs (31+208) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193 which was called: # once (31µs+208µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 193
use Mail::SpamAssassin::Logger;
# spent 239µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@193 # spent 208µs making 1 call to Exporter::import
194
19525.98ms2409µs
# spent 216µs (24+192) within Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195 which was called: # once (24µs+192µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 195
use vars qw(@ISA %rcode_value $txtdata_can_provide_a_list);
# spent 216µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::BEGIN@195 # spent 192µs making 1 call to vars::import
196118µs@ISA = qw(Mail::SpamAssassin::Plugin);
197
198116µ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 262µs (72+190) within Mail::SpamAssassin::Plugin::AskDNS::new which was called: # once (72µs+190µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 113)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
20612µs my($class,$sa_main) = @_;
207
20812µs $class = ref($class) || $class;
209111µs123µs my $self = $class->SUPER::new($sa_main);
# spent 23µs making 1 call to Mail::SpamAssassin::Plugin::new
21012µs bless($self, $class);
211
21218µs1138µs $self->set_config($sa_main->{conf});
# spent 138µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::set_config
213
214156µs129µs $txtdata_can_provide_a_list = Net::DNS->VERSION >= 0.69;
# spent 29µs making 1 call to version::_VERSION
215
216116µ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 184µs (72+112) within Mail::SpamAssassin::Plugin::AskDNS::parse_and_canonicalize_subtest which was called: # once (72µs+112µ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
254120µs16µs if ( $subtest =~ m{^ / (.+) / ([a-z]*) \z}xs) {
# spent 6µs making 1 call to Mail::SpamAssassin::Plugin::AskDNS::CORE:match
2551145µs2106µs $result = $2 ne '' ? qr{(?$2)$1} : qr{$1};
# spent 96µ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 }
296116µs return $result;
297}
298
299
# spent 138µs (42+96) within Mail::SpamAssassin::Plugin::AskDNS::set_config which was called: # once (42µs+96µ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 739µs (320+419) within Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] which was called 2 times, avg 369µs/call: # 2 times (320µs+419µs) by Mail::SpamAssassin::Conf::Parser::parse at line 438 of Mail/SpamAssassin/Conf/Parser.pm, avg 369µs/call
code => sub {
308210µs my($self, $key, $value, $line) = @_;
309211µs local($1,$2,$3,$4);
3102109µs451µs if (!defined $value || $value =~ /^$/) {
# spent 51µs making 4 calls to Mail::SpamAssassin::Plugin::AskDNS::CORE:match, avg 13µ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 {
317212µ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;
320219µs my @answer_types = split(/,/, $query_type);
321 # http://www.iana.org/assignments/dns-parameters/dns-parameters.xml
322239µs217µs if (grep(!/^(?:ANY|A|AAAA|MX|TXT|PTR|NAPTR|NS|SOA|CERT|CNAME|DNAME|
# spent 17µs making 2 calls to Mail::SpamAssassin::Plugin::AskDNS::CORE:match, avg 8µ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 }
32726µs $query_type = 'ANY' if @answer_types > 1 || $answer_types[0] eq 'ANY';
32825µs if (defined $subtest) {
329113µs1184µs $subtest = parse_and_canonicalize_subtest($subtest);
# spent 184µ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
333233µ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 6µ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)
337219µs my $depends_on_tags = !@tags ? '' : join(',',@tags);
338
339 # subgroup rules by a DNS RR type and a nonexpanded query template
34028µs my $query_template_key = $query_type . ':' . $query_template;
341
342217µ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 };
347218µ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
353228µs2154µs $self->{parser}->add_test($rulename, undef,
# spent 154µs making 2 calls to Mail::SpamAssassin::Conf::Parser::add_test, avg 77µs/call
354 $Mail::SpamAssassin::Conf::TYPE_EMPTY_TESTS);
355 }
356 }
357116µs });
358
359117µs196µs $conf->{parser}->register_commands(\@cmds);
# spent 96µ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 67.0ms (24.2+42.8) within Mail::SpamAssassin::Plugin::AskDNS::extract_metadata which was called 235 times, avg 285µs/call: # 235 times (24.2ms+42.8ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm, avg 285µs/call
sub extract_metadata {
366235508µs my($self, $opts) = @_;
367235747µs my $pms = $opts->{permsgstatus};
368235665µs my $conf = $pms->{conf};
369
3702352.21ms23520.2ms return if !$pms->is_dns_available;
# spent 20.2ms making 235 calls to Mail::SpamAssassin::PerMsgStatus::is_dns_available, avg 86µs/call
371235878µ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 #
3764704.59ms for my $depends_on_tags (keys %{$conf->{askdns}}) {
377235435µs my @tags;
3782351.71ms @tags = split(/,/, $depends_on_tags) if $depends_on_tags ne '';
379
3802351.62ms2353.21ms if (would_log("dbg","askdns")) {
# spent 3.21ms making 235 calls to Mail::SpamAssassin::Logger::would_log, avg 14µ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
3902352.77ms 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) }
3982355.58ms23519.4ms );
# spent 19.4ms making 235 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
649122µs1;
 
# spent 86µs within Mail::SpamAssassin::Plugin::AskDNS::CORE:match which was called 9 times, avg 10µs/call: # 4 times (51µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 310, avg 13µs/call # 2 times (17µs+0s) by Mail::SpamAssassin::Plugin::AskDNS::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/AskDNS.pm:356] at line 322, avg 8µ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 6µ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 96µs within Mail::SpamAssassin::Plugin::AskDNS::CORE:regcomp which was called: # once (96µ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.