Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Dns.pm |
Statements | Executed 29099 statements in 232ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
8426 | 2 | 1 | 200ms | 259ms | register_async_rule_start | Mail::SpamAssassin::PerMsgStatus::
470 | 2 | 2 | 15.1ms | 29.2ms | is_dns_available | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 10.2ms | 38.9ms | BEGIN@35 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 4.12ms | 151ms | BEGIN@74 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 60µs | 65µs | clear_resolver | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 48µs | 59µs | BEGIN@18 | Mail::SpamAssassin::Message::Metadata::
1 | 1 | 1 | 37µs | 42µs | BEGIN@25 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 35µs | 793µs | BEGIN@36 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 34µs | 90µs | BEGIN@86 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 32µs | 60µs | BEGIN@24 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 26µs | 10.7ms | load_resolver | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 26µs | 185µs | BEGIN@32 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 25µs | 32µs | BEGIN@23 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 25µs | 85µs | BEGIN@26 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 24µs | 262µs | BEGIN@38 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 22µs | 626µs | BEGIN@31 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 20µs | 20µs | BEGIN@29 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 18µs | 18µs | BEGIN@28 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 18µs | 18µs | BEGIN@34 | Mail::SpamAssassin::PerMsgStatus::
1 | 1 | 1 | 15µs | 15µs | BEGIN@30 | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | __ANON__[:120] | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | __ANON__[:160] | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | check_for_from_dns | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | cleanup_kids | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | dnsbl_hit | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | dnsbl_uri | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | do_dns_lookup | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | do_rbl_lookup | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | enter_helper_run_mode | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | harvest_completed_queries | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | harvest_dnsbl_queries | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | harvest_until_rule_completes | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | is_rule_complete | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | leave_helper_run_mode | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | lookup_ns | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | mark_all_async_rules_complete | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | process_dnsbl_result | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | process_dnsbl_set | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | rbl_finish | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | register_async_rule_finish | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | register_rbl_subtest | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | server_failed_to_respond_for_domain | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | set_rbl_tag_data | Mail::SpamAssassin::PerMsgStatus::
0 | 0 | 0 | 0s | 0s | set_server_failed_to_respond_for_domain | Mail::SpamAssassin::PerMsgStatus::
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 | 2 | 119µs | 2 | 71µs | # spent 59µs (48+12) within Mail::SpamAssassin::Message::Metadata::BEGIN@18 which was called:
# once (48µs+12µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 18 # spent 59µs making 1 call to Mail::SpamAssassin::Message::Metadata::BEGIN@18
# spent 12µs making 1 call to strict::import |
19 | package Mail::SpamAssassin::Dns; 1; | ||||
20 | |||||
21 | package Mail::SpamAssassin::PerMsgStatus; | ||||
22 | |||||
23 | 2 | 79µs | 2 | 38µs | # spent 32µs (25+6) within Mail::SpamAssassin::PerMsgStatus::BEGIN@23 which was called:
# once (25µs+6µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 23 # spent 32µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@23
# spent 6µs making 1 call to strict::import |
24 | 2 | 58µs | 2 | 89µs | # spent 60µs (32+29) within Mail::SpamAssassin::PerMsgStatus::BEGIN@24 which was called:
# once (32µs+29µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 24 # spent 60µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@24
# spent 29µs making 1 call to warnings::import |
25 | 2 | 63µs | 2 | 48µs | # spent 42µs (37+5) within Mail::SpamAssassin::PerMsgStatus::BEGIN@25 which was called:
# once (37µs+5µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 25 # spent 42µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@25
# spent 6µs making 1 call to bytes::import |
26 | 2 | 70µs | 2 | 145µs | # spent 85µs (25+60) within Mail::SpamAssassin::PerMsgStatus::BEGIN@26 which was called:
# once (25µs+60µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 26 # spent 85µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@26
# spent 60µs making 1 call to re::import |
27 | |||||
28 | 2 | 70µs | 1 | 18µs | # spent 18µs within Mail::SpamAssassin::PerMsgStatus::BEGIN@28 which was called:
# once (18µs+0s) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 28 # spent 18µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@28 |
29 | 2 | 61µs | 1 | 20µs | # spent 20µs within Mail::SpamAssassin::PerMsgStatus::BEGIN@29 which was called:
# once (20µs+0s) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 29 # spent 20µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@29 |
30 | 2 | 77µs | 1 | 15µs | # spent 15µs within Mail::SpamAssassin::PerMsgStatus::BEGIN@30 which was called:
# once (15µs+0s) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 30 # spent 15µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@30 |
31 | 2 | 71µs | 2 | 1.23ms | # spent 626µs (22+604) within Mail::SpamAssassin::PerMsgStatus::BEGIN@31 which was called:
# once (22µs+604µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 31 # spent 626µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@31
# spent 604µs making 1 call to Exporter::import |
32 | 2 | 72µs | 2 | 343µs | # spent 185µs (26+159) within Mail::SpamAssassin::PerMsgStatus::BEGIN@32 which was called:
# once (26µs+159µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 32 # spent 185µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@32
# spent 159µs making 1 call to Exporter::import |
33 | |||||
34 | 2 | 63µs | 1 | 18µs | # spent 18µs within Mail::SpamAssassin::PerMsgStatus::BEGIN@34 which was called:
# once (18µs+0s) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 34 # spent 18µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@34 |
35 | 2 | 379µs | 2 | 44.3ms | # spent 38.9ms (10.2+28.7) within Mail::SpamAssassin::PerMsgStatus::BEGIN@35 which was called:
# once (10.2ms+28.7ms) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 35 # spent 38.9ms making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@35
# spent 5.33ms making 1 call to IO::Socket::import |
36 | 2 | 90µs | 2 | 1.55ms | # spent 793µs (35+758) within Mail::SpamAssassin::PerMsgStatus::BEGIN@36 which was called:
# once (35µs+758µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 36 # spent 793µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@36
# spent 758µs making 1 call to POSIX::import |
37 | |||||
38 | 1 | 2µs | # spent 262µs (24+239) within Mail::SpamAssassin::PerMsgStatus::BEGIN@38 which was called:
# once (24µs+239µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 40 | ||
39 | $KNOWN_BAD_DIALUP_RANGES @EXISTING_DOMAINS $IS_DNS_AVAILABLE $LAST_DNS_CHECK | ||||
40 | 1 | 208µs | 2 | 501µs | }; # spent 262µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@38
# spent 239µs making 1 call to vars::import |
41 | |||||
42 | # use very well-connected domains (fast DNS response, many DNS servers, | ||||
43 | # geographical distribution is a plus, TTL of at least 3600s) | ||||
44 | 1 | 9µs | @EXISTING_DOMAINS = qw{ | ||
45 | adelphia.net | ||||
46 | akamai.com | ||||
47 | apache.org | ||||
48 | cingular.com | ||||
49 | colorado.edu | ||||
50 | comcast.net | ||||
51 | doubleclick.com | ||||
52 | ebay.com | ||||
53 | gmx.net | ||||
54 | google.com | ||||
55 | intel.com | ||||
56 | kernel.org | ||||
57 | linux.org | ||||
58 | mit.edu | ||||
59 | motorola.com | ||||
60 | msn.com | ||||
61 | sourceforge.net | ||||
62 | sun.com | ||||
63 | w3.org | ||||
64 | yahoo.com | ||||
65 | }; | ||||
66 | |||||
67 | 1 | 2µs | $IS_DNS_AVAILABLE = undef; | ||
68 | |||||
69 | #Removed $VERSION per BUG 6422 | ||||
70 | #$VERSION = 'bogus'; # avoid CPAN.pm picking up razor ver | ||||
71 | |||||
72 | ########################################################################### | ||||
73 | |||||
74 | # spent 151ms (4.12+147) within Mail::SpamAssassin::PerMsgStatus::BEGIN@74 which was called:
# once (4.12ms+147ms) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 97 | ||||
75 | # some trickery. Load these modules right here, if possible; that way, if | ||||
76 | # the module exists, we'll get it loaded now. Very useful to avoid attempted | ||||
77 | # loads later (which will happen). If we do a fork(), we could wind up | ||||
78 | # attempting to load these modules in *every* subprocess. | ||||
79 | # | ||||
80 | # # We turn off strict and warnings, because Net::DNS and Razor both contain | ||||
81 | # # crud that -w complains about (perl 5.6.0). Not that this seems to work, | ||||
82 | # # mind ;) | ||||
83 | # no strict; | ||||
84 | # local ($^W) = 0; | ||||
85 | |||||
86 | 2 | 120µs | 2 | 147µs | # spent 90µs (34+57) within Mail::SpamAssassin::PerMsgStatus::BEGIN@86 which was called:
# once (34µs+57µs) by Mail::SpamAssassin::Message::Metadata::BEGIN@49 at line 86 # spent 90µs making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@86
# spent 56µs making 1 call to warnings::unimport |
87 | 1 | 4µs | eval { | ||
88 | 1 | 298µs | require Net::DNS; | ||
89 | 1 | 3µs | require Net::DNS::Resolver; | ||
90 | }; | ||||
91 | 1 | 4µs | eval { | ||
92 | 1 | 4µs | require MIME::Base64; | ||
93 | }; | ||||
94 | 1 | 16µs | eval { | ||
95 | 1 | 3µs | require IO::Socket::UNIX; | ||
96 | }; | ||||
97 | 1 | 7.08ms | 1 | 151ms | }; # spent 151ms making 1 call to Mail::SpamAssassin::PerMsgStatus::BEGIN@74 |
98 | |||||
99 | ########################################################################### | ||||
100 | |||||
101 | sub do_rbl_lookup { | ||||
102 | my ($self, $rule, $set, $type, $host, $subtest) = @_; | ||||
103 | |||||
104 | $host =~ s/\.\z//s; # strip a redundant trailing dot | ||||
105 | my $key = "dns:$type:$host"; | ||||
106 | my $existing_ent = $self->{async}->get_lookup($key); | ||||
107 | |||||
108 | # only make a specific query once | ||||
109 | if (!$existing_ent) { | ||||
110 | my $ent = { | ||||
111 | key => $key, | ||||
112 | zone => $host, # serves to fetch other per-zone settings | ||||
113 | type => "DNSBL-".$type, | ||||
114 | sets => [ ], # filled in below | ||||
115 | rules => [ ], # filled in below | ||||
116 | # id is filled in after we send the query below | ||||
117 | }; | ||||
118 | $existing_ent = $self->{async}->bgsend_and_start_lookup( | ||||
119 | $host, $type, undef, $ent, | ||||
120 | sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) }, | ||||
121 | master_deadline => $self->{master_deadline} ); | ||||
122 | } | ||||
123 | |||||
124 | if ($existing_ent) { | ||||
125 | # always add set | ||||
126 | push @{$existing_ent->{sets}}, $set; | ||||
127 | |||||
128 | # sometimes match or always match | ||||
129 | if (defined $subtest) { | ||||
130 | $self->{dnspost}->{$set}->{$subtest} = $rule; | ||||
131 | } else { | ||||
132 | push @{$existing_ent->{rules}}, $rule; | ||||
133 | } | ||||
134 | |||||
135 | $self->{rule_to_rblkey}->{$rule} = $key; | ||||
136 | } | ||||
137 | } | ||||
138 | |||||
139 | # TODO: these are constant so they should only be added once at startup | ||||
140 | sub register_rbl_subtest { | ||||
141 | my ($self, $rule, $set, $subtest) = @_; | ||||
142 | $self->{dnspost}->{$set}->{$subtest} = $rule; | ||||
143 | } | ||||
144 | |||||
145 | sub do_dns_lookup { | ||||
146 | my ($self, $rule, $type, $host) = @_; | ||||
147 | |||||
148 | $host =~ s/\.\z//s; # strip a redundant trailing dot | ||||
149 | my $key = "dns:$type:$host"; | ||||
150 | |||||
151 | my $ent = { | ||||
152 | key => $key, | ||||
153 | zone => $host, # serves to fetch other per-zone settings | ||||
154 | type => "DNSBL-".$type, | ||||
155 | rules => [ $rule ], | ||||
156 | # id is filled in after we send the query below | ||||
157 | }; | ||||
158 | $ent = $self->{async}->bgsend_and_start_lookup( | ||||
159 | $host, $type, undef, $ent, | ||||
160 | sub { my($ent, $pkt) = @_; $self->process_dnsbl_result($ent, $pkt) }, | ||||
161 | master_deadline => $self->{master_deadline} ); | ||||
162 | $ent; | ||||
163 | } | ||||
164 | |||||
165 | ########################################################################### | ||||
166 | |||||
167 | sub dnsbl_hit { | ||||
168 | my ($self, $rule, $question, $answer) = @_; | ||||
169 | |||||
170 | my $log = ""; | ||||
171 | if (substr($rule, 0, 2) eq "__") { | ||||
172 | # don't bother with meta rules | ||||
173 | } elsif ($answer->type eq 'TXT') { | ||||
174 | # txtdata returns a non- zone-file-format encoded result, unlike rdatastr; | ||||
175 | # avoid space-separated RDATA <character-string> fields if possible, | ||||
176 | # txtdata provides a list of strings in a list context since Net::DNS 0.69 | ||||
177 | $log = join('',$answer->txtdata); | ||||
178 | local $1; | ||||
179 | $log =~ s{ (?<! [<(\[] ) (https? : // \S+)}{<$1>}xgi; | ||||
180 | } else { # assuming $answer->type eq 'A' | ||||
181 | local($1,$2,$3,$4,$5); | ||||
182 | if ($question->string =~ m/^((?:[0-9a-fA-F]\.){32})(\S+\w)/) { | ||||
183 | $log = ' listed in ' . lc($2); | ||||
184 | my $ipv6addr = join('', reverse split(/\./, lc $1)); | ||||
185 | $ipv6addr =~ s/\G(....)/$1:/g; chop $ipv6addr; | ||||
186 | $ipv6addr =~ s/:0{1,3}/:/g; | ||||
187 | $log = $ipv6addr . $log; | ||||
188 | } elsif ($question->string =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\S+\w)/) { | ||||
189 | $log = "$4.$3.$2.$1 listed in " . lc($5); | ||||
190 | } else { | ||||
191 | $log = 'listed in ' . $question->string; | ||||
192 | } | ||||
193 | } | ||||
194 | |||||
195 | # TODO: this may result in some log messages appearing under the | ||||
196 | # wrong rules, since we could see this sequence: { test one hits, | ||||
197 | # test one's message is logged, test two hits, test one fires again | ||||
198 | # on another IP, test one's message is logged for that other IP -- | ||||
199 | # but under test two's heading }. Right now though it's better | ||||
200 | # than just not logging at all. | ||||
201 | |||||
202 | $self->{already_logged} ||= { }; | ||||
203 | if ($log && !$self->{already_logged}->{$log}) { | ||||
204 | $self->test_log($log); | ||||
205 | $self->{already_logged}->{$log} = 1; | ||||
206 | } | ||||
207 | |||||
208 | if (!$self->{tests_already_hit}->{$rule}) { | ||||
209 | $self->got_hit($rule, "RBL: ", ruletype => "dnsbl"); | ||||
210 | } | ||||
211 | } | ||||
212 | |||||
213 | sub dnsbl_uri { | ||||
214 | my ($self, $question, $answer) = @_; | ||||
215 | |||||
216 | my $qname = $question->qname; | ||||
217 | |||||
218 | # txtdata returns a non- zone-file-format encoded result, unlike rdatastr; | ||||
219 | # avoid space-separated RDATA <character-string> fields if possible, | ||||
220 | # txtdata provides a list of strings in a list context since Net::DNS 0.69 | ||||
221 | # | ||||
222 | my $rdatastr = $answer->UNIVERSAL::can('txtdata') ? join('',$answer->txtdata) | ||||
223 | : $answer->rdatastr; | ||||
224 | if (defined $qname && defined $rdatastr) { | ||||
225 | my $qclass = $question->qclass; | ||||
226 | my $qtype = $question->qtype; | ||||
227 | my @vals; | ||||
228 | push(@vals, "class=$qclass") if $qclass ne "IN"; | ||||
229 | push(@vals, "type=$qtype") if $qtype ne "A"; | ||||
230 | my $uri = "dns:$qname" . (@vals ? "?" . join(";", @vals) : ""); | ||||
231 | push @{ $self->{dnsuri}->{$uri} }, $rdatastr; | ||||
232 | |||||
233 | dbg("dns: hit <$uri> $rdatastr"); | ||||
234 | } | ||||
235 | } | ||||
236 | |||||
237 | # called as a completion routine to bgsend by DnsResolver::poll_responses; | ||||
238 | # returns 1 on successful packet processing | ||||
239 | sub process_dnsbl_result { | ||||
240 | my ($self, $ent, $pkt) = @_; | ||||
241 | |||||
242 | return if !$pkt; | ||||
243 | my $question = ($pkt->question)[0]; | ||||
244 | return if !$question; | ||||
245 | |||||
246 | my $sets = $ent->{sets} || []; | ||||
247 | my $rules = $ent->{rules}; | ||||
248 | |||||
249 | # NO_DNS_FOR_FROM | ||||
250 | if ($self->{sender_host} && | ||||
251 | # fishy, qname should have been "RFC 1035 zone format" -decoded first | ||||
252 | lc($question->qname) eq lc($self->{sender_host}) && | ||||
253 | $question->qtype =~ /^(?:A|MX)$/ && | ||||
254 | $pkt->header->rcode =~ /^(?:NXDOMAIN|SERVFAIL)$/ && | ||||
255 | ++$self->{sender_host_fail} == 2) | ||||
256 | { | ||||
257 | for my $rule (@{$rules}) { | ||||
258 | $self->got_hit($rule, "DNS: ", ruletype => "dns"); | ||||
259 | } | ||||
260 | } | ||||
261 | |||||
262 | # DNSBL tests are here | ||||
263 | foreach my $answer ($pkt->answer) { | ||||
264 | next if !$answer; | ||||
265 | # track all responses | ||||
266 | $self->dnsbl_uri($question, $answer); | ||||
267 | my $answ_type = $answer->type; | ||||
268 | # TODO: there are some CNAME returns that might be useful | ||||
269 | next if ($answ_type ne 'A' && $answ_type ne 'TXT'); | ||||
270 | # skip any A record that isn't on 127/8 | ||||
271 | next if ($answ_type eq 'A' && $answer->rdatastr !~ /^127\./); | ||||
272 | for my $rule (@{$rules}) { | ||||
273 | $self->dnsbl_hit($rule, $question, $answer); | ||||
274 | } | ||||
275 | for my $set (@{$sets}) { | ||||
276 | if ($self->{dnspost}->{$set}) { | ||||
277 | $self->process_dnsbl_set($set, $question, $answer); | ||||
278 | } | ||||
279 | } | ||||
280 | } | ||||
281 | return 1; | ||||
282 | } | ||||
283 | |||||
284 | sub process_dnsbl_set { | ||||
285 | my ($self, $set, $question, $answer) = @_; | ||||
286 | |||||
287 | # txtdata returns a non- zone-file-format encoded result, unlike rdatastr; | ||||
288 | # avoid space-separated RDATA <character-string> fields if possible, | ||||
289 | # txtdata provides a list of strings in a list context since Net::DNS 0.69 | ||||
290 | # | ||||
291 | my $rdatastr = $answer->UNIVERSAL::can('txtdata') ? join('',$answer->txtdata) | ||||
292 | : $answer->rdatastr; | ||||
293 | |||||
294 | while (my ($subtest, $rule) = each %{ $self->{dnspost}->{$set} }) { | ||||
295 | next if $self->{tests_already_hit}->{$rule}; | ||||
296 | |||||
297 | if ($subtest =~ /^\d+\.\d+\.\d+\.\d+$/) { | ||||
298 | # test for exact equality, not a regexp (an IPv4 address) | ||||
299 | $self->dnsbl_hit($rule, $question, $answer) if $subtest eq $rdatastr; | ||||
300 | } | ||||
301 | # senderbase | ||||
302 | elsif ($subtest =~ s/^sb://) { | ||||
303 | # SB rules are not available to users | ||||
304 | if ($self->{conf}->{user_defined_rules}->{$rule}) { | ||||
305 | dbg("dns: skipping rule '$rule': not supported when user-defined"); | ||||
306 | next; | ||||
307 | } | ||||
308 | |||||
309 | $rdatastr =~ s/^\d+-//; | ||||
310 | my %sb = ($rdatastr =~ m/(?:^|\|)(\d+)=([^|]+)/g); | ||||
311 | my $undef = 0; | ||||
312 | while ($subtest =~ m/\bS(\d+)\b/g) { | ||||
313 | if (!defined $sb{$1}) { | ||||
314 | $undef = 1; | ||||
315 | last; | ||||
316 | } | ||||
317 | $subtest =~ s/\bS(\d+)\b/\$sb{$1}/; | ||||
318 | } | ||||
319 | |||||
320 | # untaint. (bug 3325) | ||||
321 | $subtest = untaint_var($subtest); | ||||
322 | |||||
323 | $self->got_hit($rule, "SenderBase: ", ruletype => "dnsbl") if !$undef && eval $subtest; | ||||
324 | } | ||||
325 | # bitmask | ||||
326 | elsif ($subtest =~ /^\d+$/) { | ||||
327 | # Bug 6803: response should be within 127.0.0.0/8, ignore otherwise | ||||
328 | if ($rdatastr =~ m/^127\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ && | ||||
329 | Mail::SpamAssassin::Util::my_inet_aton($rdatastr) & $subtest) | ||||
330 | { | ||||
331 | $self->dnsbl_hit($rule, $question, $answer); | ||||
332 | } | ||||
333 | } | ||||
334 | # regular expression | ||||
335 | else { | ||||
336 | my $test = qr/$subtest/; | ||||
337 | if ($rdatastr =~ /$test/) { | ||||
338 | $self->dnsbl_hit($rule, $question, $answer); | ||||
339 | } | ||||
340 | } | ||||
341 | } | ||||
342 | } | ||||
343 | |||||
344 | sub harvest_until_rule_completes { | ||||
345 | my ($self, $rule) = @_; | ||||
346 | |||||
347 | dbg("dns: harvest_until_rule_completes"); | ||||
348 | my $result = 0; | ||||
349 | |||||
350 | for (my $first=1; ; $first=0) { | ||||
351 | # complete_lookups() may call completed_callback(), which may | ||||
352 | # call start_lookup() again (like in Plugin::URIDNSBL) | ||||
353 | my ($alldone,$anydone) = | ||||
354 | $self->{async}->complete_lookups($first ? 0 : 1.0, 1); | ||||
355 | |||||
356 | $result = 1 if $self->is_rule_complete($rule); | ||||
357 | last if $result || $alldone; | ||||
358 | |||||
359 | dbg("dns: harvest_until_rule_completes - check_tick"); | ||||
360 | $self->{main}->call_plugins ("check_tick", { permsgstatus => $self }); | ||||
361 | } | ||||
362 | |||||
363 | return $result; | ||||
364 | } | ||||
365 | |||||
366 | sub harvest_dnsbl_queries { | ||||
367 | my ($self) = @_; | ||||
368 | |||||
369 | dbg("dns: harvest_dnsbl_queries"); | ||||
370 | |||||
371 | for (my $first=1; ; $first=0) { | ||||
372 | # complete_lookups() may call completed_callback(), which may | ||||
373 | # call start_lookup() again (like in Plugin::URIDNSBL) | ||||
374 | |||||
375 | # the first time around we specify a 0 timeout, which gives | ||||
376 | # complete_lookups a chance to ripe any available results and | ||||
377 | # abort overdue requests, without needlessly waiting for more | ||||
378 | |||||
379 | my ($alldone,$anydone) = | ||||
380 | $self->{async}->complete_lookups($first ? 0 : 1.0, 1); | ||||
381 | |||||
382 | last if $alldone; | ||||
383 | |||||
384 | dbg("dns: harvest_dnsbl_queries - check_tick"); | ||||
385 | $self->{main}->call_plugins ("check_tick", { permsgstatus => $self }); | ||||
386 | } | ||||
387 | |||||
388 | # explicitly abort anything left | ||||
389 | $self->{async}->abort_remaining_lookups(); | ||||
390 | $self->{async}->log_lookups_timing(); | ||||
391 | $self->mark_all_async_rules_complete(); | ||||
392 | 1; | ||||
393 | } | ||||
394 | |||||
395 | # collect and process whatever DNS responses have already arrived, | ||||
396 | # don't waste time waiting for more, don't poll too often. | ||||
397 | # don't abort any queries even if overdue, | ||||
398 | sub harvest_completed_queries { | ||||
399 | my ($self) = @_; | ||||
400 | |||||
401 | # don't bother collecting responses too often | ||||
402 | my $last_poll_time = $self->{async}->last_poll_responses_time(); | ||||
403 | return if defined $last_poll_time && time - $last_poll_time < 0.1; | ||||
404 | |||||
405 | my ($alldone,$anydone) = $self->{async}->complete_lookups(0, 0); | ||||
406 | if ($anydone) { | ||||
407 | dbg("dns: harvested completed queries"); | ||||
408 | # $self->{main}->call_plugins ("check_tick", { permsgstatus => $self }); | ||||
409 | } | ||||
410 | } | ||||
411 | |||||
412 | sub set_rbl_tag_data { | ||||
413 | my ($self) = @_; | ||||
414 | |||||
415 | # DNS URIs | ||||
416 | my $rbl_tag = $self->{tag_data}->{RBL}; # just in case, should be empty | ||||
417 | $rbl_tag = '' if !defined $rbl_tag; | ||||
418 | while (my ($dnsuri, $answers) = each %{ $self->{dnsuri} }) { | ||||
419 | # when parsing, look for elements of \".*?\" or \S+ with ", " as separator | ||||
420 | $rbl_tag .= "<$dnsuri>" . " [" . join(", ", @{ $answers }) . "]\n"; | ||||
421 | } | ||||
422 | if (defined $rbl_tag && $rbl_tag ne '') { | ||||
423 | chomp $rbl_tag; | ||||
424 | $self->set_tag('RBL', $rbl_tag); | ||||
425 | } | ||||
426 | } | ||||
427 | |||||
428 | ########################################################################### | ||||
429 | |||||
430 | sub rbl_finish { | ||||
431 | my ($self) = @_; | ||||
432 | |||||
433 | $self->set_rbl_tag_data(); | ||||
434 | |||||
435 | delete $self->{dnspost}; | ||||
436 | delete $self->{dnsuri}; | ||||
437 | } | ||||
438 | |||||
439 | ########################################################################### | ||||
440 | |||||
441 | # spent 10.7ms (26µs+10.7) within Mail::SpamAssassin::PerMsgStatus::load_resolver which was called:
# once (26µs+10.7ms) by Mail::SpamAssassin::PerMsgStatus::is_dns_available at line 529 | ||||
442 | 1 | 3µs | my ($self) = @_; | ||
443 | 1 | 4µs | $self->{resolver} = $self->{main}->{resolver}; | ||
444 | 1 | 18µs | 1 | 10.7ms | return $self->{resolver}->load_resolver(); # spent 10.7ms making 1 call to Mail::SpamAssassin::DnsResolver::load_resolver |
445 | } | ||||
446 | |||||
447 | # spent 65µs (60+6) within Mail::SpamAssassin::PerMsgStatus::clear_resolver which was called:
# once (60µs+6µs) by Mail::SpamAssassin::PerMsgStatus::is_dns_available at line 528 | ||||
448 | 1 | 2µs | my ($self) = @_; | ||
449 | 1 | 6µs | 1 | 6µs | dbg("dns: clear_resolver"); # spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg |
450 | 1 | 34µs | $self->{main}->{resolver}->{res} = undef; | ||
451 | 1 | 21µs | return 0; | ||
452 | } | ||||
453 | |||||
454 | sub lookup_ns { | ||||
455 | my ($self, $dom) = @_; | ||||
456 | |||||
457 | return unless $self->load_resolver(); | ||||
458 | return if ($self->server_failed_to_respond_for_domain ($dom)); | ||||
459 | |||||
460 | my $nsrecords; | ||||
461 | dbg("dns: looking up NS for '$dom'"); | ||||
462 | |||||
463 | eval { | ||||
464 | my $query = $self->{resolver}->send($dom, 'NS'); | ||||
465 | my @nses; | ||||
466 | if ($query) { | ||||
467 | foreach my $rr ($query->answer) { | ||||
468 | if ($rr->type eq "NS") { push (@nses, $rr->nsdname); } | ||||
469 | } | ||||
470 | } | ||||
471 | $nsrecords = [ @nses ]; | ||||
472 | 1; | ||||
473 | } or do { | ||||
474 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
475 | dbg("dns: NS lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat); | ||||
476 | return; | ||||
477 | }; | ||||
478 | |||||
479 | $nsrecords; | ||||
480 | } | ||||
481 | |||||
482 | # spent 29.2ms (15.1+14.1) within Mail::SpamAssassin::PerMsgStatus::is_dns_available which was called 470 times, avg 62µs/call:
# 235 times (8.04ms+12.2ms) by Mail::SpamAssassin::Plugin::AskDNS::extract_metadata at line 370 of Mail/SpamAssassin/Plugin/AskDNS.pm, avg 86µs/call
# 235 times (7.10ms+1.92ms) by Mail::SpamAssassin::Plugin::URIDNSBL::parsed_metadata at line 345 of Mail/SpamAssassin/Plugin/URIDNSBL.pm, avg 38µs/call | ||||
483 | 470 | 1.04ms | my ($self) = @_; | ||
484 | 470 | 2.14ms | my $dnsopt = $self->{conf}->{dns_available}; | ||
485 | 470 | 1.32ms | my $dnsint = $self->{conf}->{dns_test_interval} || 600; | ||
486 | 470 | 872µs | my @domains; | ||
487 | |||||
488 | 470 | 1.14ms | $LAST_DNS_CHECK ||= 0; | ||
489 | 470 | 7.22ms | 470 | 3.32ms | my $diff = time() - $LAST_DNS_CHECK; # spent 3.32ms making 470 calls to Time::HiRes::time, avg 7µs/call |
490 | |||||
491 | # undef $IS_DNS_AVAILABLE if we should be testing for | ||||
492 | # working DNS and our check interval time has passed | ||||
493 | 470 | 1.09ms | if ($dnsopt eq "test" && $diff > $dnsint) { | ||
494 | $IS_DNS_AVAILABLE = undef; | ||||
495 | dbg("dns: is_dns_available() last checked %.1f seconds ago; re-checking", | ||||
496 | $diff); | ||||
497 | } | ||||
498 | |||||
499 | 470 | 5.10ms | return $IS_DNS_AVAILABLE if (defined $IS_DNS_AVAILABLE); | ||
500 | 1 | 14µs | 1 | 4µs | $LAST_DNS_CHECK = time(); # spent 4µs making 1 call to Time::HiRes::time |
501 | |||||
502 | 1 | 3µs | $IS_DNS_AVAILABLE = 0; | ||
503 | 1 | 2µs | if ($dnsopt eq "no") { | ||
504 | dbg("dns: dns_available set to no in config file, skipping test"); | ||||
505 | return $IS_DNS_AVAILABLE; | ||||
506 | } | ||||
507 | |||||
508 | # Even if "dns_available" is explicitly set to "yes", we want to ignore | ||||
509 | # DNS if we're only supposed to be looking at local tests. | ||||
510 | 1 | 3µs | goto done if ($self->{main}->{local_tests_only}); | ||
511 | |||||
512 | # Check version numbers - runtime check only | ||||
513 | 1 | 5µs | if (defined $Net::DNS::VERSION) { | ||
514 | 1 | 11µs | 1 | 24µs | if (am_running_on_windows()) { # spent 24µs making 1 call to Mail::SpamAssassin::Util::am_running_on_windows |
515 | if ($Net::DNS::VERSION < 0.46) { | ||||
516 | warn("dns: Net::DNS version is $Net::DNS::VERSION, but need 0.46 for Win32"); | ||||
517 | return $IS_DNS_AVAILABLE; | ||||
518 | } | ||||
519 | } | ||||
520 | else { | ||||
521 | 1 | 3µs | if ($Net::DNS::VERSION < 0.34) { | ||
522 | warn("dns: Net::DNS version is $Net::DNS::VERSION, but need 0.34"); | ||||
523 | return $IS_DNS_AVAILABLE; | ||||
524 | } | ||||
525 | } | ||||
526 | } | ||||
527 | |||||
528 | 1 | 9µs | 1 | 65µs | $self->clear_resolver(); # spent 65µs making 1 call to Mail::SpamAssassin::PerMsgStatus::clear_resolver |
529 | 1 | 9µs | 1 | 10.7ms | goto done unless $self->load_resolver(); # spent 10.7ms making 1 call to Mail::SpamAssassin::PerMsgStatus::load_resolver |
530 | |||||
531 | 1 | 3µs | if ($dnsopt eq "yes") { | ||
532 | # optionally shuffle the list of nameservers to distribute the load | ||||
533 | 1 | 4µs | if ($self->{conf}->{dns_options}->{rotate}) { | ||
534 | my @nameservers = $self->{resolver}->available_nameservers(); | ||||
535 | Mail::SpamAssassin::Util::fisher_yates_shuffle(\@nameservers); | ||||
536 | dbg("dns: shuffled NS list: " . join(", ", @nameservers)); | ||||
537 | $self->{resolver}->available_nameservers(@nameservers); | ||||
538 | } | ||||
539 | 1 | 2µs | $IS_DNS_AVAILABLE = 1; | ||
540 | 1 | 6µs | 1 | 6µs | dbg("dns: dns_available set to yes in config file, skipping test"); # spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg |
541 | 1 | 12µs | return $IS_DNS_AVAILABLE; | ||
542 | } | ||||
543 | |||||
544 | if ($dnsopt =~ /^test:\s*(\S.*)$/) { | ||||
545 | @domains = split (/\s+/, $1); | ||||
546 | dbg("dns: looking up NS records for user specified domains: %s", | ||||
547 | join(", ", @domains)); | ||||
548 | } else { | ||||
549 | @domains = @EXISTING_DOMAINS; | ||||
550 | dbg("dns: looking up NS records for built-in domains"); | ||||
551 | } | ||||
552 | |||||
553 | # do the test with a full set of configured nameservers | ||||
554 | my @nameservers = $self->{resolver}->configured_nameservers(); | ||||
555 | |||||
556 | # optionally shuffle the list of nameservers to distribute the load | ||||
557 | if ($self->{conf}->{dns_options}->{rotate}) { | ||||
558 | Mail::SpamAssassin::Util::fisher_yates_shuffle(\@nameservers); | ||||
559 | dbg("dns: shuffled NS list, testing: " . join(", ", @nameservers)); | ||||
560 | } else { | ||||
561 | dbg("dns: testing resolver nameservers: " . join(", ", @nameservers)); | ||||
562 | } | ||||
563 | |||||
564 | # Try the different nameservers here and collect a list of working servers | ||||
565 | my @good_nameservers; | ||||
566 | foreach my $ns (@nameservers) { | ||||
567 | $self->{resolver}->available_nameservers($ns); # try just this one | ||||
568 | for (my $retry = 3; $retry > 0 && @domains; $retry--) { | ||||
569 | my $domain = splice(@domains, rand(@domains), 1); | ||||
570 | dbg("dns: trying ($retry) $domain, server $ns ..."); | ||||
571 | my $result = $self->lookup_ns($domain); | ||||
572 | $self->{resolver}->finish_socket(); | ||||
573 | if (!$result) { | ||||
574 | dbg("dns: NS lookup of $domain using $ns failed horribly, ". | ||||
575 | "may not be a valid nameserver"); | ||||
576 | last; | ||||
577 | } elsif (!@$result) { | ||||
578 | dbg("dns: NS lookup of $domain using $ns failed, no results found"); | ||||
579 | } else { | ||||
580 | dbg("dns: NS lookup of $domain using $ns succeeded => DNS available". | ||||
581 | " (set dns_available to override)"); | ||||
582 | push(@good_nameservers, $ns); | ||||
583 | last; | ||||
584 | } | ||||
585 | } | ||||
586 | } | ||||
587 | |||||
588 | if (!@good_nameservers) { | ||||
589 | dbg("dns: all NS queries failed => DNS unavailable ". | ||||
590 | "(set dns_available to override)"); | ||||
591 | } else { | ||||
592 | $IS_DNS_AVAILABLE = 1; | ||||
593 | dbg("dns: NS list: ".join(", ", @good_nameservers)); | ||||
594 | $self->{resolver}->available_nameservers(@good_nameservers); | ||||
595 | } | ||||
596 | |||||
597 | done: | ||||
598 | # jm: leaving this in! | ||||
599 | dbg("dns: is DNS available? " . $IS_DNS_AVAILABLE); | ||||
600 | return $IS_DNS_AVAILABLE; | ||||
601 | } | ||||
602 | |||||
603 | ########################################################################### | ||||
604 | |||||
605 | sub server_failed_to_respond_for_domain { | ||||
606 | my ($self, $dom) = @_; | ||||
607 | if ($self->{dns_server_too_slow}->{$dom}) { | ||||
608 | dbg("dns: server for '$dom' failed to reply previously, not asking again"); | ||||
609 | return 1; | ||||
610 | } | ||||
611 | return 0; | ||||
612 | } | ||||
613 | |||||
614 | sub set_server_failed_to_respond_for_domain { | ||||
615 | my ($self, $dom) = @_; | ||||
616 | dbg("dns: server for '$dom' failed to reply, marking as bad"); | ||||
617 | $self->{dns_server_too_slow}->{$dom} = 1; | ||||
618 | } | ||||
619 | |||||
620 | ########################################################################### | ||||
621 | |||||
622 | sub enter_helper_run_mode { | ||||
623 | my ($self) = @_; | ||||
624 | |||||
625 | dbg("dns: entering helper-app run mode"); | ||||
626 | $self->{old_slash} = $/; # Razor pollutes this | ||||
627 | %{$self->{old_env}} = (); | ||||
628 | if ( %ENV ) { | ||||
629 | # undefined values in %ENV can result due to autovivification elsewhere, | ||||
630 | # this prevents later possible warnings when we restore %ENV | ||||
631 | while (my ($key, $value) = each %ENV) { | ||||
632 | $self->{old_env}->{$key} = $value if defined $value; | ||||
633 | } | ||||
634 | } | ||||
635 | |||||
636 | Mail::SpamAssassin::Util::clean_path_in_taint_mode(); | ||||
637 | |||||
638 | my $newhome; | ||||
639 | if ($self->{main}->{home_dir_for_helpers}) { | ||||
640 | $newhome = $self->{main}->{home_dir_for_helpers}; | ||||
641 | } else { | ||||
642 | # use spamd -u user's home dir | ||||
643 | $newhome = (Mail::SpamAssassin::Util::portable_getpwuid ($>))[7]; | ||||
644 | } | ||||
645 | |||||
646 | if ($newhome) { | ||||
647 | $ENV{'HOME'} = Mail::SpamAssassin::Util::untaint_file_path ($newhome); | ||||
648 | } | ||||
649 | |||||
650 | # enforce SIGCHLD as DEFAULT; IGNORE causes spurious kernel warnings | ||||
651 | # on Red Hat NPTL kernels (bug 1536), and some users of the | ||||
652 | # Mail::SpamAssassin modules set SIGCHLD to be a fatal signal | ||||
653 | # for some reason! (bug 3507) | ||||
654 | $self->{old_sigchld_handler} = $SIG{CHLD}; | ||||
655 | $SIG{CHLD} = 'DEFAULT'; | ||||
656 | } | ||||
657 | |||||
658 | sub leave_helper_run_mode { | ||||
659 | my ($self) = @_; | ||||
660 | |||||
661 | dbg("dns: leaving helper-app run mode"); | ||||
662 | $/ = $self->{old_slash}; | ||||
663 | %ENV = %{$self->{old_env}}; | ||||
664 | |||||
665 | if (defined $self->{old_sigchld_handler}) { | ||||
666 | $SIG{CHLD} = $self->{old_sigchld_handler}; | ||||
667 | } else { | ||||
668 | # if SIGCHLD has never been explicitly set, it's returned as undef. | ||||
669 | # however, when *setting* SIGCHLD, using undef(%) or assigning to an | ||||
670 | # undef value produces annoying 'Use of uninitialized value in scalar | ||||
671 | # assignment' warnings. That's silly. workaround: | ||||
672 | $SIG{CHLD} = 'DEFAULT'; | ||||
673 | } | ||||
674 | } | ||||
675 | |||||
676 | # note: this must be called before leave_helper_run_mode() is called, | ||||
677 | # as the SIGCHLD signal must be set to DEFAULT for it to work. | ||||
678 | sub cleanup_kids { | ||||
679 | my ($self, $pid) = @_; | ||||
680 | |||||
681 | if ($SIG{CHLD} && $SIG{CHLD} ne 'IGNORE') { # running from spamd | ||||
682 | waitpid ($pid, 0); | ||||
683 | } | ||||
684 | } | ||||
685 | |||||
686 | ########################################################################### | ||||
687 | |||||
688 | # spent 259ms (200+58.9) within Mail::SpamAssassin::PerMsgStatus::register_async_rule_start which was called 8426 times, avg 31µs/call:
# 8043 times (192ms+56.5ms) by Mail::SpamAssassin::Plugin::URIDNSBL::query_hosts_or_domains at line 877 of Mail/SpamAssassin/Plugin/URIDNSBL.pm, avg 31µs/call
# 383 times (8.62ms+2.46ms) by Mail::SpamAssassin::Plugin::URIDNSBL::query_hosts_or_domains at line 892 of Mail/SpamAssassin/Plugin/URIDNSBL.pm, avg 29µs/call | ||||
689 | 8426 | 18.1ms | my ($self, $rule) = @_; | ||
690 | 8426 | 63.4ms | 8426 | 58.9ms | dbg("dns: $rule lookup start"); # spent 58.9ms making 8426 calls to Mail::SpamAssassin::Logger::dbg, avg 7µs/call |
691 | 8426 | 122ms | $self->{rule_to_rblkey}->{$rule} = '*ASYNC_START'; | ||
692 | } | ||||
693 | |||||
694 | sub register_async_rule_finish { | ||||
695 | my ($self, $rule) = @_; | ||||
696 | dbg("dns: $rule lookup finished"); | ||||
697 | delete $self->{rule_to_rblkey}->{$rule}; | ||||
698 | } | ||||
699 | |||||
700 | sub mark_all_async_rules_complete { | ||||
701 | my ($self) = @_; | ||||
702 | $self->{rule_to_rblkey} = { }; | ||||
703 | } | ||||
704 | |||||
705 | sub is_rule_complete { | ||||
706 | my ($self, $rule) = @_; | ||||
707 | |||||
708 | my $key = $self->{rule_to_rblkey}->{$rule}; | ||||
709 | if (!defined $key) { | ||||
710 | # dbg("dns: $rule lookup complete, not in list"); | ||||
711 | return 1; | ||||
712 | } | ||||
713 | |||||
714 | if ($key eq '*ASYNC_START') { | ||||
715 | dbg("dns: $rule lookup not yet complete"); | ||||
716 | return 0; # not yet complete | ||||
717 | } | ||||
718 | |||||
719 | my $ent = $self->{async}->get_lookup($key); | ||||
720 | if (!defined $ent) { | ||||
721 | dbg("dns: $rule lookup complete, $key no longer pending"); | ||||
722 | return 1; | ||||
723 | } | ||||
724 | |||||
725 | dbg("dns: $rule lookup not yet complete"); | ||||
726 | return 0; # not yet complete | ||||
727 | } | ||||
728 | |||||
729 | ########################################################################### | ||||
730 | |||||
731 | # interface called by SPF plugin | ||||
732 | sub check_for_from_dns { | ||||
733 | my ($self, $pms) = @_; | ||||
734 | if (defined $pms->{sender_host_fail}) { | ||||
735 | return ($pms->{sender_host_fail} == 2); # both MX and A need to fail | ||||
736 | } | ||||
737 | } | ||||
738 | |||||
739 | 1 | 17µs | 1; |