line |
stmt |
bran |
cond |
sub |
pod |
time |
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
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
AskDNS - 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
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
Using a DNS query template as specified in a parameter of a askdns rule, |
30
|
|
|
|
|
|
|
the plugin replaces tag names as found in the template with their values |
31
|
|
|
|
|
|
|
and launches DNS queries as soon as tag values become available. When DNS |
32
|
|
|
|
|
|
|
responses trickle in, filters them according to the requested DNS resource |
33
|
|
|
|
|
|
|
record type and optional subrule filtering expression, yielding a rule hit |
34
|
|
|
|
|
|
|
if 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
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
The rbl_timeout setting is common to all DNS querying rules (as implemented |
43
|
|
|
|
|
|
|
by other plugins). It can specify a DNS query timeout globally, or individually |
44
|
|
|
|
|
|
|
for each zone. When the zone parameter is specified, the settings affects DNS |
45
|
|
|
|
|
|
|
queries when their query domain equals the specified zone, or is its subdomain. |
46
|
|
|
|
|
|
|
See 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
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
A query template is a string which will be expanded to produce a domain name |
57
|
|
|
|
|
|
|
to be used in a DNS query. The template may include SpamAssassin tag names, |
58
|
|
|
|
|
|
|
which will be replaced by their values to form a final query domain. |
59
|
|
|
|
|
|
|
The final query domain must adhere to rules governing DNS domains, i.e. |
60
|
|
|
|
|
|
|
must consist of fields each up to 63 characters long, delimited by dots. |
61
|
|
|
|
|
|
|
There may be a trailing dot at the end, but it is redundant / carries |
62
|
|
|
|
|
|
|
no semantics, because SpamAssassin uses a Net::DSN::Resolver::send method |
63
|
|
|
|
|
|
|
for querying DNS, which ignores any 'search' or 'domain' DNS resolver options. |
64
|
|
|
|
|
|
|
Domain names in DNS queries are case-insensitive. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
A tag name is a string of capital letters, preceded and followed by an |
67
|
|
|
|
|
|
|
underscore character. This syntax mirrors the add_header setting, except that |
68
|
|
|
|
|
|
|
tags cannot have parameters in parenthesis when used in askdns templates. |
69
|
|
|
|
|
|
|
Tag names may appear anywhere in the template - each queried DNS zone |
70
|
|
|
|
|
|
|
prescribes how a query should be formed. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
A query template may contain any number of tag names including none, |
73
|
|
|
|
|
|
|
although in the most common anticipated scenario exactly one tag name would |
74
|
|
|
|
|
|
|
appear in each askdns rule. Specified tag names are considered dependencies. |
75
|
|
|
|
|
|
|
Askdns rules with dependencies on the same set of tags are grouped, and all |
76
|
|
|
|
|
|
|
queries in a group are launched as soon as all their dependencies are met, |
77
|
|
|
|
|
|
|
i.e. when the last of the awaited tag values becomes available by a call |
78
|
|
|
|
|
|
|
to set_tag() from some other plugin or elsewhere in the SpamAssassin code. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Launched queries from all askdns rules are grouped too according to a pair |
81
|
|
|
|
|
|
|
of: query type and an expanded query domain name. Even if there are multiple |
82
|
|
|
|
|
|
|
rules producing the same type/domain pair, only one DNS query is launched, |
83
|
|
|
|
|
|
|
and a reply to such query contributes to all the constituent rules. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
A tag may produce none, one or multiple values. Askdns rules awaiting for |
86
|
|
|
|
|
|
|
a tag which never receives its value never result in a DNS query. Tags which |
87
|
|
|
|
|
|
|
produce multiple values will result in multiple queries launched, each with |
88
|
|
|
|
|
|
|
an expanded template using one of the tag values. An example is a DKIMDOMAIN |
89
|
|
|
|
|
|
|
tag which yields a list of signing domains, one for each valid signature in |
90
|
|
|
|
|
|
|
a signed message. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
When more than one distinct tag name appears in a template, each potentially |
93
|
|
|
|
|
|
|
resulting in multiple values, a Cartesian product is formed, and each tuple |
94
|
|
|
|
|
|
|
results in a launch of one DNS query (duplicates excluded). For example, |
95
|
|
|
|
|
|
|
a query template _A_._B_.example._A_.com where tag A is a list (11,22) |
96
|
|
|
|
|
|
|
and B is (xx,yy,zz), will result in queries: 11.xx.example.11.com, |
97
|
|
|
|
|
|
|
22.xx.example.22.com, 11.yy.example.11.com, 22.yy.example.22.com, |
98
|
|
|
|
|
|
|
11.zz.example.11.com, 22.zz.example.22.com . |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
A parameter rr_type following the query template is a comma-separated list |
101
|
|
|
|
|
|
|
of expected DNS resource record (RR) types. Missing rr_type parameter implies |
102
|
|
|
|
|
|
|
an 'A'. A DNS result may bring resource records of multiple types, but only |
103
|
|
|
|
|
|
|
resource records of a type found in the rr_type parameter list are considered, |
104
|
|
|
|
|
|
|
other resource records found in the answer section of a DNS reply are ignored |
105
|
|
|
|
|
|
|
for this rule. A value ANY in the rr_type parameter list matches any resource |
106
|
|
|
|
|
|
|
record type. An empty DNS answer section does not match ANY. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
The rr_type parameter not only provides a filter for RR types found in |
109
|
|
|
|
|
|
|
the DNS answer, but also determines the DNS query type. If only a single |
110
|
|
|
|
|
|
|
RR type is specified in the parameter (e.g. TXT), than this is also the RR |
111
|
|
|
|
|
|
|
type of a query. When more than one RR type is specified (e.g. A, AAAA, TXT) |
112
|
|
|
|
|
|
|
or if ANY is specified, then the DNS query type will be ANY and the rr_type |
113
|
|
|
|
|
|
|
parameter will only act as a filter on a result. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Currently recognized RR types in the rr_type parameter are: ANY, A, AAAA, |
116
|
|
|
|
|
|
|
MX, TXT, PTR, NAPTR, NS, SOA, CERT, CNAME, DNAME, DHCID, HINFO, MINFO, |
117
|
|
|
|
|
|
|
RP, HIP, IPSECKEY, KX, LOC, SRV, SSHFP, SPF. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
https://www.iana.org/assignments/dns-parameters/dns-parameters.xml |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
The last optional parameter of a rule is a filtering expression, a.k.a. a |
122
|
|
|
|
|
|
|
subrule. Its function is much like the subrule in URIDNSBL plugin rules, |
123
|
|
|
|
|
|
|
or in the check_rbl eval rules. The main difference is that with askdns |
124
|
|
|
|
|
|
|
rules there is no need to manually group rules according to their queried |
125
|
|
|
|
|
|
|
zone, as the grouping is automatic and duplicate queries are implicitly |
126
|
|
|
|
|
|
|
eliminated. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
The subrule filtering parameter can be: a plain string, a regular expression, |
129
|
|
|
|
|
|
|
a 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 |
131
|
|
|
|
|
|
|
no filtering, i.e. any positive DNS response (rcode=NOERROR) of the requested |
132
|
|
|
|
|
|
|
RR type will result in a rule hit, regardless of the RR value returned with |
133
|
|
|
|
|
|
|
the response. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
When a plain string is used as a filter, it must be enclosed in single or |
136
|
|
|
|
|
|
|
double quotes. For the rule to hit, the response must match the filtering |
137
|
|
|
|
|
|
|
string exactly, and a RR type of a response must match the query type. |
138
|
|
|
|
|
|
|
Typical use is an exact text string for TXT queries, or an exact quad-dotted |
139
|
|
|
|
|
|
|
IPv4 address. In case of a TXT or SPF resource record which can return |
140
|
|
|
|
|
|
|
multiple character-strings (as defined in Section 3.3 of [RFC1035]), these |
141
|
|
|
|
|
|
|
strings are concatenated with no delimiters before comparing the result |
142
|
|
|
|
|
|
|
to the filtering string. This follows requirements of several documents, |
143
|
|
|
|
|
|
|
such as RFC 5518, RFC 7208, RFC 4871, RFC 5617. Examples of a plain text |
144
|
|
|
|
|
|
|
filtering parameter: "127.0.0.1", "transaction", 'list' . |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
A regular expression follows a familiar perl syntax like /.../ or m{...} |
147
|
|
|
|
|
|
|
optionally followed by regexp flags (such as 'i' for case-insensitivity). |
148
|
|
|
|
|
|
|
If a DNS response matches the requested RR type and the regular expression, |
149
|
|
|
|
|
|
|
the rule hits. Examples: /^127\.0\.0\.\d+$/, m{\bdial up\b}i . |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
A single numerical value can be a decimal number, or a hexadecimal number |
152
|
|
|
|
|
|
|
prefixed by 0x. Such numeric filtering expression is typically used with |
153
|
|
|
|
|
|
|
RR type-A DNS queries. The returned value (an IPv4 address) is masked |
154
|
|
|
|
|
|
|
with a specified filtering value and tested to fall within a 127.0.0.0/8 |
155
|
|
|
|
|
|
|
network range - the rule hits if the result is nonzero: |
156
|
|
|
|
|
|
|
((r & n) != 0) && ((r & 0xff000000) == 0x7f000000). An example: 0x10 . |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
A pair of numerical values (each a decimal, hexadecimal or quad-dotted) |
159
|
|
|
|
|
|
|
delimited by a '-' specifies an IPv4 address range, and a pair of values |
160
|
|
|
|
|
|
|
delimited by a '/' specifies an IPv4 address followed by a bitmask. Again, |
161
|
|
|
|
|
|
|
this type of filtering expression is primarily intended with RR type-A |
162
|
|
|
|
|
|
|
DNS queries. The rule hits if the RR type matches, and the returned IP |
163
|
|
|
|
|
|
|
address falls within the specified range: (r >= n1 && r <= n2), or |
164
|
|
|
|
|
|
|
masked with a bitmask matches the specified value: (r & m) == (n & m) . |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
As a shorthand notation, a single quad-dotted value is equivalent to |
167
|
|
|
|
|
|
|
a n-n form, i.e. it must match the returned value exactly with all its bits. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Some typical examples of a numeric filtering parameter are: 127.0.1.2, |
170
|
|
|
|
|
|
|
127.0.1.20-127.0.1.39, 127.0.1.0/255.255.255.0, 0.0.0.16/0.0.0.16, |
171
|
|
|
|
|
|
|
0x10/0x10, 16, 0x10 . |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Lastly, the filtering parameter can be a comma-separated list of DNS status |
174
|
|
|
|
|
|
|
codes (rcode), enclosed in square brackets. Rcodes can be represented either |
175
|
|
|
|
|
|
|
by their numeric decimal values (0=NOERROR, 3=NXDOMAIN, ...), or their names. |
176
|
|
|
|
|
|
|
See https://www.iana.org/assignments/dns-parameters for the list of names. When |
177
|
|
|
|
|
|
|
testing for a rcode where rcode is nonzero, a RR type parameter is ignored |
178
|
|
|
|
|
|
|
as a filter, as there is typically no answer section in a DNS reply when |
179
|
|
|
|
|
|
|
rcode indicates an error. Example: [NXDOMAIN], or [FormErr,ServFail,4,5] . |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=back |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
use strict; |
187
|
22
|
|
|
22
|
|
155
|
use warnings; |
|
22
|
|
|
|
|
40
|
|
|
22
|
|
|
|
|
632
|
|
188
|
22
|
|
|
22
|
|
189
|
use re 'taint'; |
|
22
|
|
|
|
|
44
|
|
|
22
|
|
|
|
|
637
|
|
189
|
22
|
|
|
22
|
|
124
|
|
|
22
|
|
|
|
|
64
|
|
|
22
|
|
|
|
|
717
|
|
190
|
|
|
|
|
|
|
use Mail::SpamAssassin::Plugin; |
191
|
22
|
|
|
22
|
|
120
|
use Mail::SpamAssassin::Util qw(decode_dns_question_entry); |
|
22
|
|
|
|
|
60
|
|
|
22
|
|
|
|
|
589
|
|
192
|
22
|
|
|
22
|
|
116
|
use Mail::SpamAssassin::Logger; |
|
22
|
|
|
|
|
41
|
|
|
22
|
|
|
|
|
1042
|
|
193
|
22
|
|
|
22
|
|
130
|
use version 0.77; |
|
22
|
|
|
|
|
52
|
|
|
22
|
|
|
|
|
1283
|
|
194
|
22
|
|
|
22
|
|
165
|
|
|
22
|
|
|
|
|
397
|
|
|
22
|
|
|
|
|
161
|
|
195
|
|
|
|
|
|
|
our @ISA = qw(Mail::SpamAssassin::Plugin); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
our %rcode_value = ( # https://www.iana.org/assignments/dns-parameters, RFC 6195 |
198
|
|
|
|
|
|
|
NOERROR => 0, FORMERR => 1, SERVFAIL => 2, NXDOMAIN => 3, NOTIMP => 4, |
199
|
|
|
|
|
|
|
REFUSED => 5, YXDOMAIN => 6, YXRRSET => 7, NXRRSET => 8, NOTAUTH => 9, |
200
|
|
|
|
|
|
|
NOTZONE => 10, BADVERS => 16, BADSIG => 16, BADKEY => 17, BADTIME => 18, |
201
|
|
|
|
|
|
|
BADMODE => 19, BADNAME => 20, BADALG => 21, BADTRUNC => 22, |
202
|
|
|
|
|
|
|
); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
our $txtdata_can_provide_a_list; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
my($class,$sa_main) = @_; |
207
|
|
|
|
|
|
|
|
208
|
63
|
|
|
63
|
1
|
249
|
$class = ref($class) || $class; |
209
|
|
|
|
|
|
|
my $self = $class->SUPER::new($sa_main); |
210
|
63
|
|
33
|
|
|
5153
|
bless($self, $class); |
211
|
63
|
|
|
|
|
342
|
|
212
|
63
|
|
|
|
|
179
|
$self->set_config($sa_main->{conf}); |
213
|
|
|
|
|
|
|
|
214
|
63
|
|
|
|
|
325
|
#$txtdata_can_provide_a_list = Net::DNS->VERSION >= 0.69; |
215
|
|
|
|
|
|
|
#more robust version check from Damyan Ivanov - Bug 7095 |
216
|
|
|
|
|
|
|
$txtdata_can_provide_a_list = version->parse(Net::DNS->VERSION) >= version->parse('0.69'); |
217
|
|
|
|
|
|
|
|
218
|
63
|
|
|
|
|
2745
|
return $self; |
219
|
|
|
|
|
|
|
} |
220
|
63
|
|
|
|
|
753
|
|
221
|
|
|
|
|
|
|
# --------------------------------------------------------------------------- |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# Accepts argument as a string in single or double quotes, or as a regular |
224
|
|
|
|
|
|
|
# expression in // or m{} notation, or as a numerical value or a pair of |
225
|
|
|
|
|
|
|
# numerical values, or as a bracketed and comma-separated list of DNS rcode |
226
|
|
|
|
|
|
|
# names or their numerical codes. Recognized numerical forms are: m, n1-n2, |
227
|
|
|
|
|
|
|
# or n/m, where n,n1,n2,m can be any of: decimal digits, 0x followed by |
228
|
|
|
|
|
|
|
# up to 8 hexadecimal digits, or an IPv4 address in quad-dotted notation. |
229
|
|
|
|
|
|
|
# The argument is checked for syntax, undef is returned on syntax errors. |
230
|
|
|
|
|
|
|
# A string that looks like a regular expression is converted to a compiled |
231
|
|
|
|
|
|
|
# Regexp object and returned as a result. Otherwise, numeric components of |
232
|
|
|
|
|
|
|
# the remaining three forms are converted as follows: hex or decimal numeric |
233
|
|
|
|
|
|
|
# strings are converted to a number and a quad-dot is converted to a number, |
234
|
|
|
|
|
|
|
# then components are reassembled into a string delimited by '-' or '/'. |
235
|
|
|
|
|
|
|
# As a special backward compatibility measure, a single quad-dot (with no |
236
|
|
|
|
|
|
|
# second number) is converted into n-n, to distinguish it from a traditional |
237
|
|
|
|
|
|
|
# mask-only form. A list or rcodes is returned as a hashref, where keys |
238
|
|
|
|
|
|
|
# represent specified numerical rcodes. |
239
|
|
|
|
|
|
|
# |
240
|
|
|
|
|
|
|
# Arguments like the following are anticipated: |
241
|
|
|
|
|
|
|
# "127.0.0.1", "some text", 'some "more" text', |
242
|
|
|
|
|
|
|
# /regexp/flags, m{regexp}flags, |
243
|
|
|
|
|
|
|
# 127.0.1.2 (same as 127.0.1.2-127.0.1.2 or 127.0.1.2/255.255.255.255) |
244
|
|
|
|
|
|
|
# 127.0.1.20-127.0.1.39 (= 0x7f000114-0x7f000127 or 2130706708-2130706727) |
245
|
|
|
|
|
|
|
# 0.0.0.16/0.0.0.16 (same as 0x10/0x10 or 16/0x10 or 16/16) |
246
|
|
|
|
|
|
|
# 16 (traditional style mask-only, same as 0x10) |
247
|
|
|
|
|
|
|
# [NXDOMAIN], [FormErr,ServFail,4,5] |
248
|
|
|
|
|
|
|
# |
249
|
|
|
|
|
|
|
my($subtest) = @_; |
250
|
|
|
|
|
|
|
my $result; |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
0
|
0
|
0
|
local($1,$2,$3); |
253
|
0
|
|
|
|
|
0
|
# modifiers /a, /d, /l, /u in suffix form were added with perl 5.13.10 (5.14) |
254
|
|
|
|
|
|
|
# currently known modifiers are [msixoadlu], but let's not be too picky here |
255
|
0
|
|
|
|
|
0
|
if ( $subtest =~ m{^ / (.+) / ([a-z]*) \z}xs) { |
256
|
|
|
|
|
|
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
257
|
|
|
|
|
|
|
} elsif ($subtest =~ m{^ m \s* \( (.+) \) ([a-z]*) \z}xs) { |
258
|
0
|
0
|
|
|
|
0
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
259
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ m \s* \[ (.+) \] ([a-z]*) \z}xs) { |
260
|
|
|
|
|
|
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
261
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ m \s* \{ (.+) \} ([a-z]*) \z}xs) { |
262
|
|
|
|
|
|
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
263
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ m \s* < (.+) > ([a-z]*) \z}xs) { |
264
|
|
|
|
|
|
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
265
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ m \s* (\S) (.+) \1 ([a-z]*) \z}xs) { |
266
|
|
|
|
|
|
|
$result = $2 ne '' ? qr{(?$2)$1} : qr{$1}; |
267
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ (["']) (.*) \1 \z}xs) { # quoted string |
268
|
|
|
|
|
|
|
$result = $2; |
269
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ \[ ( (?:[A-Z]+|\d+) |
270
|
|
|
|
|
|
|
(?: \s* , \s* (?:[A-Z]+|\d+) )* ) \] \z}xis) { |
271
|
0
|
|
|
|
|
0
|
# a comma-separated list of rcode names or their decimal values |
272
|
|
|
|
|
|
|
my @rcodes = split(/\s*,\s*/, uc $1); |
273
|
|
|
|
|
|
|
for (@rcodes) { $_ = $rcode_value{$_} if exists $rcode_value{$_} } |
274
|
|
|
|
|
|
|
return if grep(!/^\d+\z/, @rcodes); |
275
|
0
|
|
|
|
|
0
|
# a hashref indicates a list of DNS rcodes (stored as hash keys) |
276
|
0
|
0
|
|
|
|
0
|
$result = { map( ($_,1), @rcodes) }; |
|
0
|
|
|
|
|
0
|
|
277
|
0
|
0
|
|
|
|
0
|
} elsif ($subtest =~ m{^ ([^/-]+) (?: ([/-]) (.+) )? \z}xs) { |
278
|
|
|
|
|
|
|
my($n1,$delim,$n2) = ($1,$2,$3); |
279
|
0
|
|
|
|
|
0
|
my $any_quad_dot; |
280
|
|
|
|
|
|
|
for ($n1,$n2) { |
281
|
0
|
|
|
|
|
0
|
if (!defined $_) { |
282
|
0
|
|
|
|
|
0
|
# ok, $n2 may not exist |
283
|
0
|
|
|
|
|
0
|
} elsif (/^\d{1,10}\z/) { |
284
|
0
|
0
|
|
|
|
0
|
$_ = 0 + $_; # decimal string -> number |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
285
|
|
|
|
|
|
|
} elsif (/^0x[0-9a-zA-Z]{1,8}\z/) { |
286
|
|
|
|
|
|
|
$_ = hex($_); # hex string -> number |
287
|
0
|
|
|
|
|
0
|
} elsif (/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/) { |
288
|
|
|
|
|
|
|
$_ = Mail::SpamAssassin::Util::my_inet_aton($_); # quad-dot -> number |
289
|
0
|
|
|
|
|
0
|
$any_quad_dot = 1; |
290
|
|
|
|
|
|
|
} else { |
291
|
0
|
|
|
|
|
0
|
return; |
292
|
0
|
|
|
|
|
0
|
} |
293
|
|
|
|
|
|
|
} |
294
|
0
|
|
|
|
|
0
|
$result = defined $n2 ? $n1.$delim.$n2 |
295
|
|
|
|
|
|
|
: $any_quad_dot ? $n1.'-'.$n1 : "$n1"; |
296
|
|
|
|
|
|
|
} |
297
|
0
|
0
|
|
|
|
0
|
return $result; |
|
|
0
|
|
|
|
|
|
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
0
|
|
|
|
|
0
|
my($self, $conf) = @_; |
301
|
|
|
|
|
|
|
my @cmds; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
push(@cmds, { |
304
|
63
|
|
|
63
|
0
|
151
|
setting => 'askdns', |
305
|
63
|
|
|
|
|
126
|
is_admin => 1, |
306
|
|
|
|
|
|
|
type => $Mail::SpamAssassin::Conf::CONF_TYPE_HASH_KEY_VALUE, |
307
|
|
|
|
|
|
|
code => sub { |
308
|
|
|
|
|
|
|
my($self, $key, $value, $line) = @_; |
309
|
|
|
|
|
|
|
local($1,$2,$3,$4); |
310
|
|
|
|
|
|
|
if (!defined $value || $value =~ /^$/) { |
311
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
312
|
0
|
|
|
0
|
|
0
|
} elsif ($value !~ /^ (\S+) \s+ (\S+) |
313
|
0
|
|
|
|
|
0
|
(?: \s+ ([A-Za-z0-9,]+) |
314
|
0
|
0
|
0
|
|
|
0
|
(?: \s+ (.*?) )? )? \s* $/xs) { |
|
|
0
|
|
|
|
|
|
315
|
0
|
|
|
|
|
0
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
316
|
|
|
|
|
|
|
} else { |
317
|
|
|
|
|
|
|
my($rulename,$query_template,$query_type,$subtest) = ($1,$2,$3,$4); |
318
|
|
|
|
|
|
|
$query_type = 'A' if !defined $query_type; |
319
|
0
|
|
|
|
|
0
|
$query_type = uc $query_type; |
320
|
|
|
|
|
|
|
my @answer_types = split(/,/, $query_type); |
321
|
0
|
|
|
|
|
0
|
# https://www.iana.org/assignments/dns-parameters/dns-parameters.xml |
322
|
0
|
0
|
|
|
|
0
|
if (grep(!/^(?:ANY|A|AAAA|MX|TXT|PTR|NAPTR|NS|SOA|CERT|CNAME|DNAME| |
323
|
0
|
|
|
|
|
0
|
DHCID|HINFO|MINFO|RP|HIP|IPSECKEY|KX|LOC|SRV| |
324
|
0
|
|
|
|
|
0
|
SSHFP|SPF)\z/x, @answer_types)) { |
325
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
326
|
0
|
0
|
|
|
|
0
|
} |
327
|
|
|
|
|
|
|
$query_type = 'ANY' if @answer_types > 1 || $answer_types[0] eq 'ANY'; |
328
|
|
|
|
|
|
|
if (defined $subtest) { |
329
|
0
|
|
|
|
|
0
|
$subtest = parse_and_canonicalize_subtest($subtest); |
330
|
|
|
|
|
|
|
defined $subtest or return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
331
|
0
|
0
|
0
|
|
|
0
|
} |
332
|
0
|
0
|
|
|
|
0
|
# collect tag names as used in each query template |
333
|
0
|
|
|
|
|
0
|
my @tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/g; |
334
|
0
|
0
|
|
|
|
0
|
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) |
337
|
0
|
|
|
|
|
0
|
my $depends_on_tags = !@tags ? '' : join(',',@tags); |
338
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
339
|
|
|
|
|
|
|
# subgroup rules by a DNS RR type and a nonexpanded query template |
340
|
|
|
|
|
|
|
my $query_template_key = $query_type . ':' . $query_template; |
341
|
0
|
0
|
|
|
|
0
|
|
342
|
|
|
|
|
|
|
$self->{askdns}{$depends_on_tags}{$query_template_key} ||= |
343
|
|
|
|
|
|
|
{ query => $query_template, rules => {}, q_type => $query_type, |
344
|
0
|
|
|
|
|
0
|
a_types => # optimization: undef means "same as q_type" |
345
|
|
|
|
|
|
|
@answer_types == 1 && $answer_types[0] eq $query_type ? undef |
346
|
0
|
0
|
0
|
|
|
0
|
: \@answer_types }; |
|
|
|
0
|
|
|
|
|
347
|
|
|
|
|
|
|
$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
|
0
|
|
|
|
|
0
|
|
352
|
|
|
|
|
|
|
# just define the test so that scores and lint works |
353
|
|
|
|
|
|
|
$self->{parser}->add_test($rulename, undef, |
354
|
|
|
|
|
|
|
$Mail::SpamAssassin::Conf::TYPE_EMPTY_TESTS); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
} |
357
|
0
|
|
|
|
|
0
|
}); |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
$conf->{parser}->register_commands(\@cmds); |
360
|
|
|
|
|
|
|
} |
361
|
63
|
|
|
|
|
750
|
|
362
|
|
|
|
|
|
|
# run as early as possible, launching DNS queries as soon as their |
363
|
63
|
|
|
|
|
359
|
# dependencies are fulfilled |
364
|
|
|
|
|
|
|
# |
365
|
|
|
|
|
|
|
my($self, $opts) = @_; |
366
|
|
|
|
|
|
|
my $pms = $opts->{permsgstatus}; |
367
|
|
|
|
|
|
|
my $conf = $pms->{conf}; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
return if !$pms->is_dns_available; |
370
|
81
|
|
|
81
|
1
|
223
|
$pms->{askdns_map_dnskey_to_rules} = {}; |
371
|
81
|
|
|
|
|
176
|
|
372
|
81
|
|
|
|
|
176
|
# walk through all collected askdns rules, obtain tag values whenever |
373
|
|
|
|
|
|
|
# they may become available, and launch DNS queries right after |
374
|
81
|
100
|
|
|
|
202
|
# |
375
|
4
|
|
|
|
|
10
|
for my $depends_on_tags (keys %{$conf->{askdns}}) { |
376
|
|
|
|
|
|
|
my @tags; |
377
|
|
|
|
|
|
|
@tags = split(/,/, $depends_on_tags) if $depends_on_tags ne ''; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
if (would_log("dbg","askdns")) { |
380
|
4
|
|
|
|
|
6
|
while ( my($query_template_key, $struct) = |
|
4
|
|
|
|
|
21
|
|
381
|
0
|
|
|
|
|
|
each %{$conf->{askdns}{$depends_on_tags}} ) { |
382
|
0
|
0
|
|
|
|
|
my($query_template, $query_type, $answer_types_ref, $rules) = |
383
|
|
|
|
|
|
|
@$struct{qw(query q_type a_types rules)}; |
384
|
0
|
0
|
|
|
|
|
dbg("askdns: depend on tags %s, rules: %s ", |
385
|
0
|
|
|
|
|
|
$depends_on_tags, join(', ', keys %$rules)); |
386
|
0
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
} |
388
|
0
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
|
if (!@tags) { |
390
|
|
|
|
|
|
|
# no dependencies on tags, just call directly |
391
|
|
|
|
|
|
|
$self->launch_queries($pms,$depends_on_tags); |
392
|
|
|
|
|
|
|
} else { |
393
|
|
|
|
|
|
|
# enqueue callback for tags needed |
394
|
0
|
0
|
|
|
|
|
$pms->action_depends_on_tags(@tags == 1 ? $tags[0] : \@tags, |
395
|
|
|
|
|
|
|
sub { my($pms,@args) = @_; |
396
|
0
|
|
|
|
|
|
$self->launch_queries($pms,$depends_on_tags) } |
397
|
|
|
|
|
|
|
); |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
0
|
|
|
0
|
|
|
} |
401
|
0
|
|
|
|
|
|
|
402
|
0
|
0
|
|
|
|
|
# generate DNS queries - called for each set of rules |
403
|
|
|
|
|
|
|
# when their tag dependencies are met |
404
|
|
|
|
|
|
|
# |
405
|
|
|
|
|
|
|
my($self, $pms, $depends_on_tags) = @_; |
406
|
|
|
|
|
|
|
my $conf = $pms->{conf}; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
my %tags; |
409
|
|
|
|
|
|
|
# obtain tag/value pairs of tags we depend upon in this set of rules |
410
|
|
|
|
|
|
|
if ($depends_on_tags ne '') { |
411
|
0
|
|
|
0
|
0
|
|
%tags = map( ($_,$pms->get_tag($_)), split(/,/,$depends_on_tags) ); |
412
|
0
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
dbg("askdns: preparing queries which depend on tags: %s", |
414
|
0
|
|
|
|
|
|
join(', ', map($_.' => '.$tags{$_}, keys %tags))); |
415
|
|
|
|
|
|
|
|
416
|
0
|
0
|
|
|
|
|
# replace tag names in a query template with actual tag values |
417
|
0
|
|
|
|
|
|
# and launch DNS queries |
418
|
|
|
|
|
|
|
while ( my($query_template_key, $struct) = |
419
|
|
|
|
|
|
|
each %{$conf->{askdns}{$depends_on_tags}} ) { |
420
|
0
|
|
|
|
|
|
my($query_template, $query_type, $answer_types_ref, $rules) = |
421
|
|
|
|
|
|
|
@$struct{qw(query q_type a_types rules)}; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
my @rulenames = keys %$rules; |
424
|
0
|
|
|
|
|
|
if (grep($conf->{scores}->{$_}, @rulenames)) { |
425
|
0
|
|
|
|
|
|
dbg("askdns: query template %s, type %s, rules: %s", |
426
|
|
|
|
|
|
|
$query_template, |
427
|
0
|
|
|
|
|
|
!$answer_types_ref ? $query_type |
428
|
|
|
|
|
|
|
: $query_type.'/'.join(',',@$answer_types_ref), |
429
|
0
|
|
|
|
|
|
join(', ', @rulenames)); |
430
|
0
|
0
|
|
|
|
|
} else { |
431
|
0
|
0
|
|
|
|
|
dbg("askdns: query template %s, type %s, all rules disabled: %s", |
432
|
|
|
|
|
|
|
$query_template, $query_type, join(', ', @rulenames)); |
433
|
|
|
|
|
|
|
next; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# collect all tag names from a template, each may occur more than once |
437
|
0
|
|
|
|
|
|
my @templ_tags = $query_template =~ /_([A-Z][A-Z0-9]*)_/gs; |
438
|
|
|
|
|
|
|
|
439
|
0
|
|
|
|
|
|
# filter out duplicate tag names, and tags with undefined or empty value |
440
|
|
|
|
|
|
|
my %seen; |
441
|
|
|
|
|
|
|
@templ_tags = grep(!$seen{$_}++ && defined $tags{$_} && $tags{$_} ne '', |
442
|
|
|
|
|
|
|
@templ_tags); |
443
|
0
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
my %templ_vals; # values that each tag takes |
445
|
|
|
|
|
|
|
for my $t (@templ_tags) { |
446
|
0
|
|
|
|
|
|
my %seen; |
447
|
0
|
|
0
|
|
|
|
# a tag value may be a space-separated list, |
448
|
|
|
|
|
|
|
# store it as an arrayref, removing duplicate values |
449
|
|
|
|
|
|
|
$templ_vals{$t} = [ grep(!$seen{$_}++, split(' ',$tags{$t})) ]; |
450
|
0
|
|
|
|
|
|
} |
451
|
0
|
|
|
|
|
|
|
452
|
0
|
|
|
|
|
|
# count through all tag value tuples |
453
|
|
|
|
|
|
|
my @digit = (0) x @templ_tags; # counting accumulator |
454
|
|
|
|
|
|
|
OUTER: |
455
|
0
|
|
|
|
|
|
for (;;) { |
456
|
|
|
|
|
|
|
my %current_tag_val; # maps a tag name to its current iteration value |
457
|
|
|
|
|
|
|
for my $j (0 .. $#templ_tags) { |
458
|
|
|
|
|
|
|
my $t = $templ_tags[$j]; |
459
|
0
|
|
|
|
|
|
$current_tag_val{$t} = $templ_vals{$t}[$digit[$j]]; |
460
|
|
|
|
|
|
|
} |
461
|
0
|
|
|
|
|
|
local $1; |
462
|
0
|
|
|
|
|
|
my $query_domain = $query_template; |
463
|
0
|
|
|
|
|
|
$query_domain =~ s{_([A-Z][A-Z0-9]*)_} |
464
|
0
|
|
|
|
|
|
{ defined $current_tag_val{$1} ? $current_tag_val{$1} |
465
|
0
|
|
|
|
|
|
: '' }ge; |
466
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
|
# the $dnskey identifies this query in AsyncLoop's pending_lookups |
468
|
0
|
|
|
|
|
|
my $dnskey = join(':', 'askdns', $query_type, $query_domain); |
469
|
0
|
0
|
|
|
|
|
dbg("askdns: expanded query %s, dns key %s", $query_domain, $dnskey); |
|
0
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
if ($query_domain eq '') { |
472
|
|
|
|
|
|
|
# ignore, just in case |
473
|
0
|
|
|
|
|
|
} else { |
474
|
0
|
|
|
|
|
|
if (!exists $pms->{askdns_map_dnskey_to_rules}{$dnskey}) { |
475
|
|
|
|
|
|
|
$pms->{askdns_map_dnskey_to_rules}{$dnskey} = |
476
|
0
|
0
|
|
|
|
|
[ [$query_type, $answer_types_ref, $rules] ]; |
477
|
|
|
|
|
|
|
} else { |
478
|
|
|
|
|
|
|
push(@{$pms->{askdns_map_dnskey_to_rules}{$dnskey}}, |
479
|
0
|
0
|
|
|
|
|
[$query_type, $answer_types_ref, $rules] ); |
480
|
0
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
# launch a new DNS query for $query_type and $query_domain |
482
|
|
|
|
|
|
|
my $ent = $pms->{async}->bgsend_and_start_lookup( |
483
|
0
|
|
|
|
|
|
$query_domain, $query_type, undef, |
|
0
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
{ key => $dnskey, zone => $query_domain }, |
485
|
|
|
|
|
|
|
sub { my ($ent2,$pkt) = @_; |
486
|
|
|
|
|
|
|
$self->process_response_packet($pms, $ent2, $pkt, $dnskey) }, |
487
|
|
|
|
|
|
|
master_deadline => $pms->{master_deadline} ); |
488
|
|
|
|
|
|
|
# these rules are now underway; unless the rule hits, these will |
489
|
|
|
|
|
|
|
# not be considered "finished" until harvest_dnsbl_queries() completes |
490
|
0
|
|
|
0
|
|
|
$pms->register_async_rule_start($dnskey) if $ent; |
491
|
0
|
|
|
|
|
|
} |
492
|
0
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
last if !@templ_tags; |
494
|
|
|
|
|
|
|
# increment accumulator, little-endian |
495
|
0
|
0
|
|
|
|
|
for (my $j = 0; ; $j++) { |
496
|
|
|
|
|
|
|
last if ++$digit[$j] <= $#{$templ_vals{$templ_tags[$j]}}; |
497
|
|
|
|
|
|
|
$digit[$j] = 0; # and carry |
498
|
0
|
0
|
|
|
|
|
last OUTER if $j >= $#templ_tags; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
|
|
|
|
|
} |
501
|
0
|
0
|
|
|
|
|
} |
|
0
|
|
|
|
|
|
|
502
|
0
|
|
|
|
|
|
} |
503
|
0
|
0
|
|
|
|
|
|
504
|
|
|
|
|
|
|
my($self, $pms, $ent, $pkt, $dnskey) = @_; |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
my $conf = $pms->{conf}; |
507
|
|
|
|
|
|
|
my %rulenames_hit; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# map a dnskey back to info on queries which caused this DNS lookup |
510
|
0
|
|
|
0
|
0
|
|
my $queries_ref = $pms->{askdns_map_dnskey_to_rules}{$dnskey}; |
511
|
|
|
|
|
|
|
|
512
|
0
|
|
|
|
|
|
my($header, @question, @answer, $qtype, $rcode); |
513
|
0
|
|
|
|
|
|
# NOTE: $pkt will be undef if the DNS query was aborted (e.g. timed out) |
514
|
|
|
|
|
|
|
if ($pkt) { |
515
|
|
|
|
|
|
|
@answer = $pkt->answer; |
516
|
0
|
|
|
|
|
|
$header = $pkt->header; |
517
|
|
|
|
|
|
|
@question = $pkt->question; |
518
|
0
|
|
|
|
|
|
$qtype = uc $question[0]->qtype if @question; |
519
|
|
|
|
|
|
|
$rcode = uc $header->rcode if $header; # 'NOERROR', 'NXDOMAIN', ... |
520
|
0
|
0
|
|
|
|
|
|
521
|
0
|
|
|
|
|
|
# NOTE: qname is encoded in RFC 1035 zone format, decode it |
522
|
0
|
|
|
|
|
|
dbg("askdns: answer received, rcode %s, query %s, answer has %d records", |
523
|
0
|
|
|
|
|
|
$rcode, |
524
|
0
|
0
|
|
|
|
|
join(', ', map(join('/', decode_dns_question_entry($_)), @question)), |
525
|
0
|
0
|
|
|
|
|
scalar @answer); |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
if (defined $rcode && exists $rcode_value{$rcode}) { |
528
|
0
|
|
|
|
|
|
# Net::DNS return a rcode name for codes it knows about, |
529
|
|
|
|
|
|
|
# and returns a number for the rest; we deal with numbers from here on |
530
|
|
|
|
|
|
|
$rcode = $rcode_value{$rcode} if exists $rcode_value{$rcode}; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
0
|
0
|
0
|
|
|
|
if (!@answer) { |
534
|
|
|
|
|
|
|
# a trick to make the following loop run at least once, so that we can |
535
|
|
|
|
|
|
|
# evaluate also rules which only care for rcode status |
536
|
0
|
0
|
|
|
|
|
@answer = ( undef ); |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
0
|
0
|
|
|
|
|
# NOTE: $rr->rdstring returns the result encoded in a DNS zone file |
540
|
|
|
|
|
|
|
# format, i.e. enclosed in double quotes if a result contains whitespace |
541
|
|
|
|
|
|
|
# (or other funny characters), and may use \DDD encoding or \X quoting as |
542
|
0
|
|
|
|
|
|
# per RFC 1035. Using $rr->txtdata instead avoids this unnecessary encoding |
543
|
|
|
|
|
|
|
# step and a need for decoding by a caller, returning an unmodified string. |
544
|
|
|
|
|
|
|
# Caveat: in case of multiple RDATA <character-string> fields contained |
545
|
|
|
|
|
|
|
# in a resource record (TXT, SPF, HINFO), starting with Net::DNS 0.69 |
546
|
|
|
|
|
|
|
# the $rr->txtdata in a list context returns these strings as a list. |
547
|
|
|
|
|
|
|
# The $rr->txtdata in a scalar context always returns a single string |
548
|
|
|
|
|
|
|
# with <character-string> fields joined by a single space character as |
549
|
|
|
|
|
|
|
# a separator. The $rr->txtdata in Net::DNS 0.68 and older returned |
550
|
|
|
|
|
|
|
# such joined space-separated string even in a list context. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# RFC 5518: If the RDATA in a TXT record contains multiple |
553
|
|
|
|
|
|
|
# character-strings (as defined in Section 3.3 of [RFC1035]), |
554
|
|
|
|
|
|
|
# the code handling such reply from DNS MUST assemble all of these |
555
|
|
|
|
|
|
|
# marshaled text blocks into a single one before any syntactical |
556
|
|
|
|
|
|
|
# verification takes place. |
557
|
|
|
|
|
|
|
# The same goes for RFC 4408 (SPF), RFC 4871 (DKIM), RFC 5617 (ADSP), |
558
|
|
|
|
|
|
|
# draft-kucherawy-dmarc-base (DMARC), ... |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
for my $rr (@answer) { |
561
|
|
|
|
|
|
|
my($rr_rdatastr, $rdatanum, $rr_type); |
562
|
|
|
|
|
|
|
if (!$rr) { |
563
|
|
|
|
|
|
|
# special case, no answer records, only rcode can be tested |
564
|
|
|
|
|
|
|
} else { |
565
|
|
|
|
|
|
|
$rr_type = uc $rr->type; |
566
|
0
|
|
|
|
|
|
if ($rr_type eq 'A') { |
567
|
0
|
|
|
|
|
|
# Net::DNS::RR::A::address() is available since Net::DNS 0.69 |
568
|
0
|
0
|
|
|
|
|
$rr_rdatastr = $rr->UNIVERSAL::can('address') ? $rr->address |
569
|
|
|
|
|
|
|
: $rr->rdatastr; |
570
|
|
|
|
|
|
|
if ($rr_rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/) { |
571
|
0
|
|
|
|
|
|
$rdatanum = Mail::SpamAssassin::Util::my_inet_aton($rr_rdatastr); |
572
|
0
|
0
|
|
|
|
|
} |
|
|
0
|
|
|
|
|
|
573
|
|
|
|
|
|
|
|
574
|
0
|
0
|
|
|
|
|
} elsif ($rr->UNIVERSAL::can('txtdata')) { |
575
|
|
|
|
|
|
|
# TXT, SPF: join with no intervening spaces, as per RFC 5518 |
576
|
0
|
0
|
|
|
|
|
if ($txtdata_can_provide_a_list || $rr_type ne 'TXT') { |
577
|
0
|
|
|
|
|
|
$rr_rdatastr = join('', $rr->txtdata); # txtdata() in list context! |
578
|
|
|
|
|
|
|
} else { # char_str_list() is only available for TXT records |
579
|
|
|
|
|
|
|
$rr_rdatastr = join('', $rr->char_str_list); # historical |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} else { |
582
|
0
|
0
|
0
|
|
|
|
# rdatastr() is historical, use rdstring() since Net::DNS 0.69 |
583
|
0
|
|
|
|
|
|
$rr_rdatastr = $rr->UNIVERSAL::can('rdstring') ? $rr->rdstring |
584
|
|
|
|
|
|
|
: $rr->rdatastr; |
585
|
0
|
|
|
|
|
|
utf8::encode($rr_rdatastr) if utf8::is_utf8($rr_rdatastr); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
# dbg("askdns: received rr type %s, data: %s", $rr_type, $rr_rdatastr); |
588
|
|
|
|
|
|
|
} |
589
|
0
|
0
|
|
|
|
|
|
590
|
|
|
|
|
|
|
for my $q_tuple (!ref $queries_ref ? () : @$queries_ref) { |
591
|
0
|
0
|
|
|
|
|
next if !$q_tuple; |
592
|
|
|
|
|
|
|
my($query_type, $answer_types_ref, $rules) = @$q_tuple; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
next if !defined $qtype; |
595
|
|
|
|
|
|
|
$answer_types_ref = [$query_type] if !defined $answer_types_ref; |
596
|
0
|
0
|
|
|
|
|
|
597
|
0
|
0
|
|
|
|
|
while (my($rulename,$subtest) = each %$rules) { |
598
|
0
|
|
|
|
|
|
my $match; |
599
|
|
|
|
|
|
|
local($1,$2,$3); |
600
|
0
|
0
|
|
|
|
|
if (ref $subtest eq 'HASH') { # a list of DNS rcodes (as hash keys) |
601
|
0
|
0
|
|
|
|
|
$match = 1 if $subtest->{$rcode}; |
602
|
|
|
|
|
|
|
} elsif ($rcode != 0) { |
603
|
0
|
|
|
|
|
|
# skip remaining tests on DNS error |
604
|
0
|
|
|
|
|
|
} elsif (!defined($rr_type) || |
605
|
0
|
|
|
|
|
|
!grep($_ eq 'ANY' || $_ eq $rr_type, @$answer_types_ref) ) { |
606
|
0
|
0
|
0
|
|
|
|
# skip remaining tests on wrong RR type |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
607
|
0
|
0
|
|
|
|
|
} 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
|
0
|
|
|
|
|
|
$subtest =~ m{^ (\d+) (?: ([/-]) (\d+) )? \z}x) { |
615
|
|
|
|
|
|
|
my($n1,$delim,$n2) = ($1,$2,$3); |
616
|
0
|
0
|
|
|
|
|
$match = |
617
|
|
|
|
|
|
|
!defined $n2 ? ($rdatanum & $n1) && # mask only |
618
|
0
|
|
|
|
|
|
(($rdatanum & 0xff000000) == 0x7f000000) # 127/8 |
619
|
|
|
|
|
|
|
: $delim eq '-' ? $rdatanum >= $n1 && $rdatanum <= $n2 # range |
620
|
|
|
|
|
|
|
: $delim eq '/' ? ($rdatanum & $n2) == (int($n1) & $n2) # value/mask |
621
|
0
|
|
|
|
|
|
: 0; # notice int($n1) to fix perl ~5.14 taint bug (Bug 7725) |
622
|
0
|
0
|
0
|
|
|
|
} |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
623
|
|
|
|
|
|
|
if ($match) { |
624
|
|
|
|
|
|
|
$self->askdns_hit($pms, $ent->{query_domain}, $qtype, |
625
|
|
|
|
|
|
|
$rr_rdatastr, $rulename); |
626
|
|
|
|
|
|
|
$rulenames_hit{$rulename} = 1; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
0
|
0
|
|
|
|
|
} |
630
|
0
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
# these rules have completed (since they got at least 1 hit) |
632
|
0
|
|
|
|
|
|
$pms->register_async_rule_finish($_) for keys %rulenames_hit; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
my($self, $pms, $query_domain, $qtype, $rr_rdatastr, $rulename) = @_; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
$rr_rdatastr = '' if !defined $rr_rdatastr; # e.g. with rules testing rcode |
638
|
0
|
|
|
|
|
|
dbg('askdns: domain "%s" listed (%s): %s', |
639
|
|
|
|
|
|
|
$query_domain, $rulename, $rr_rdatastr); |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# only the first hit will show in the test log report, even if |
642
|
0
|
|
|
0
|
0
|
|
# an answer section matches more than once - got_hit() handles this |
643
|
|
|
|
|
|
|
$pms->clear_test_state; |
644
|
0
|
0
|
|
|
|
|
$pms->test_log(sprintf("%s %s:%s", $query_domain,$qtype,$rr_rdatastr)); |
645
|
0
|
|
|
|
|
|
$pms->got_hit($rulename, 'ASKDNS: ', ruletype => 'askdns'); # score=>$score |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
1; |