/[Apache-SVN]/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm
ViewVC logotype

Contents of /spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/URIDNSBL.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 646805 - (hide annotations)
Thu Apr 10 13:59:09 2008 UTC (19 months, 2 weeks ago) by jm
File size: 21992 byte(s)
bug 5820: add 'uridnssub' keyword for URIDNSBL plugin; fix URIBL_SBL to use this keyword, and thereby produce a marginal gain in efficiency for lookups on zen.spamhaus.org
1 quinlan 149177 # <@LICENSE>
2 felicity 431796 # 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 quinlan 149177 #
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 jm 6898 =head1 NAME
19    
20     URIDNSBL - look up URLs against DNS blocklists
21    
22 quinlan 149177 =head1 SYNOPSIS
23    
24     loadplugin Mail::SpamAssassin::Plugin::URIDNSBL
25     uridnsbl URIBL_SBLXBL sbl-xbl.spamhaus.org. TXT
26    
27     =head1 DESCRIPTION
28    
29 jm 6898 This works by analysing message text and HTML for URLs, extracting the
30     domain names from those, querying their NS records in DNS, resolving
31     the hostnames used therein, and querying various DNS blocklists for
32     those IP addresses. This is quite effective.
33    
34 dos 527740 =head1 USER SETTINGS
35 jm 6898
36     =over 4
37    
38 dos 527740 =item uridnsbl_skip_domain domain1 domain2 ...
39    
40     Specify a domain, or a number of domains, which should be skipped for the
41     URIBL checks. This is very useful to specify very common domains which are
42     not going to be listed in URIBLs.
43    
44     =back
45    
46     =head1 RULE DEFINITIONS AND PRIVILEGED SETTINGS
47    
48     =over 4
49    
50 jm 9881 =item uridnsbl NAME_OF_RULE dnsbl_zone lookuptype
51 jm 6898
52     Specify a lookup. C<NAME_OF_RULE> is the name of the rule to be
53     used, C<dnsbl_zone> is the zone to look up IPs in, and C<lookuptype>
54     is the type of lookup (B<TXT> or B<A>). Note that you must also
55 felicity 54021 define a body-eval rule calling C<check_uridnsbl()> to use this.
56 jm 6898
57     Example:
58    
59     uridnsbl URIBL_SBLXBL sbl-xbl.spamhaus.org. TXT
60 felicity 54021 body URIBL_SBLXBL eval:check_uridnsbl('URIBL_SBLXBL')
61 jm 6898 describe URIBL_SBLXBL Contains a URL listed in the SBL/XBL blocklist
62    
63 jm 646805 =item uridnssub NAME_OF_RULE dnsbl_zone lookuptype subtest
64    
65     Specify a DNSBL-style domain lookup with a sub-test. C<NAME_OF_RULE> is the
66     name of the rule to be used, C<dnsbl_zone> is the zone to look up IPs in,
67     and C<lookuptype> is the type of lookup (B<TXT> or B<A>).
68    
69     C<subtest> is the sub-test to run against the returned data. The sub-test may
70     either be an IPv4 dotted address for DNSBLs that return multiple A records or a
71     non-negative decimal number to specify a bitmask for DNSBLs that return a
72     single A record containing a bitmask of results.
73    
74     Note that, as with C<uridnsbl>, you must also define a body-eval rule calling
75     C<check_uridnsbl()> to use this.
76    
77     Example:
78    
79     uridnssub URIBL_DNSBL_4 dnsbl.example.org. A 127.0.0.4
80     uridnssub URIBL_DNSBL_8 dnsbl.example.org. A 8
81    
82 jm 9881 =item urirhsbl NAME_OF_RULE rhsbl_zone lookuptype
83    
84     Specify a RHSBL-style domain lookup. C<NAME_OF_RULE> is the name of the rule
85     to be used, C<rhsbl_zone> is the zone to look up domain names in, and
86     C<lookuptype> is the type of lookup (B<TXT> or B<A>). Note that you must also
87 felicity 54021 define a body-eval rule calling C<check_uridnsbl()> to use this.
88 jm 9881
89     An RHSBL zone is one where the domain name is looked up, as a string; e.g. a
90 quinlan 160276 URI using the domain C<foo.com> will cause a lookup of
91     C<foo.com.uriblzone.net>. Note that hostnames are stripped from the domain
92     used in the URIBL lookup, so the domain C<foo.bar.com> will look up
93     C<bar.com.uriblzone.net>, and C<foo.bar.co.uk> will look up
94     C<bar.co.uk.uriblzone.net>.
95 jm 9881
96 mmartinec 565567 If an URI consists of an IP address instead of a hostname, the IP address is
97     looked up (using the standard reversed quads method) in each C<rhsbl_zone>.
98 quinlan 160276
99 jm 21406 Example:
100    
101     urirhsbl URIBL_RHSBL rhsbl.example.org. TXT
102    
103     =item urirhssub NAME_OF_RULE rhsbl_zone lookuptype subtest
104    
105     Specify a RHSBL-style domain lookup with a sub-test. C<NAME_OF_RULE> is the
106     name of the rule to be used, C<rhsbl_zone> is the zone to look up domain names
107     in, and C<lookuptype> is the type of lookup (B<TXT> or B<A>).
108    
109     C<subtest> is the sub-test to run against the returned data. The sub-test may
110 sidney 433917 either be an IPv4 dotted address for RHSBLs that return multiple A records or a
111 jm 21406 non-negative decimal number to specify a bitmask for RHSBLs that return a
112 sidney 433917 single A record containing a bitmask of results.
113 jm 21406
114 felicity 54021 Note that, as with C<urirhsbl>, you must also define a body-eval rule calling
115 jm 21406 C<check_uridnsbl()> to use this.
116    
117     Example:
118    
119     urirhssub URIBL_RHSBL_4 rhsbl.example.org. A 127.0.0.4
120     urirhssub URIBL_RHSBL_8 rhsbl.example.org. A 8
121    
122 dos 527740 =back
123    
124     =head1 ADMINISTRATOR SETTINGS
125    
126     =over 4
127    
128 jm 6898 =item uridnsbl_max_domains N (default: 20)
129    
130     The maximum number of domains to look up.
131    
132     =back
133    
134 dos 527786 =head1 NOTES
135    
136     The C<uridnsbl_timeout> option has been obsoleted by the C<rbl_timeout>
137     option. See the C<Mail::SpamAssassin::Conf> POD for details on C<rbl_timeout>.
138    
139 jm 6898 =cut
140    
141     package Mail::SpamAssassin::Plugin::URIDNSBL;
142    
143     use Mail::SpamAssassin::Plugin;
144 quinlan 160273 use Mail::SpamAssassin::Constants qw(:ip);
145 quinlan 7001 use Mail::SpamAssassin::Util;
146 quinlan 162095 use Mail::SpamAssassin::Logger;
147 jm 6898 use strict;
148 quinlan 55260 use warnings;
149 jm 6898 use bytes;
150 mmartinec 574664 use re 'taint';
151 jm 6898
152     use vars qw(@ISA);
153     @ISA = qw(Mail::SpamAssassin::Plugin);
154    
155     use constant LOG_COMPLETION_TIMES => 0;
156    
157     # constructor
158     sub new {
159     my $class = shift;
160     my $samain = shift;
161    
162     # some boilerplate...
163     $class = ref($class) || $class;
164     my $self = $class->SUPER::new($samain);
165     bless ($self, $class);
166    
167 jm 161778 # this can be effectively global, at least in each process, safely
168 jm 6898
169 jm 161778 $self->{finished} = { };
170 jm 6898
171     $self->register_eval_rule ("check_uridnsbl");
172 felicity 56728 $self->set_config($samain->{conf});
173 jm 6898
174     return $self;
175     }
176    
177     # this is just a placeholder; in fact the results are dealt with later
178     sub check_uridnsbl {
179     return 0;
180     }
181    
182     # ---------------------------------------------------------------------------
183    
184     # once the metadata is parsed, we can access the URI list. So start off
185     # the lookups here!
186     sub parsed_metadata {
187     my ($self, $opts) = @_;
188     my $scanner = $opts->{permsgstatus};
189    
190 jm 161778 if (!$scanner->is_dns_available()) {
191 jm 6898 $self->{dns_not_available} = 1;
192     return;
193 dos 518664 } else {
194     # due to re-testing dns may become available after being unavailable
195     # DOS: I don't think dns_not_available is even used anymore
196     $self->{dns_not_available} = 0;
197 jm 6898 }
198    
199 felicity 439873 $scanner->{'uridnsbl_activerules'} = { };
200     $scanner->{'uridnsbl_hits'} = { };
201     $scanner->{'uridnsbl_seen_domain'} = { };
202 jm 6898
203 parker 9571 # only hit DNSBLs for active rules (defined and score != 0)
204 felicity 439873 $scanner->{'uridnsbl_active_rules_rhsbl'} = { };
205     $scanner->{'uridnsbl_active_rules_revipbl'} = { };
206    
207 jm 6898 foreach my $rulename (keys %{$scanner->{conf}->{uridnsbls}}) {
208 felicity 47438 next unless ($scanner->{conf}->is_rule_active('body_evals',$rulename));
209 jm 9881
210 felicity 439873 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
211 jm 9881 if ($rulecf->{is_rhsbl}) {
212 felicity 439873 $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
213 jm 9881 } else {
214 felicity 439873 $scanner->{uridnsbl_active_rules_revipbl}->{$rulename} = 1;
215 jm 9881 }
216 jm 6898 }
217    
218     # get all domains in message
219 felicity 155151
220 felicity 170124 # don't keep dereferencing this
221     my $skip_domains = $scanner->{main}->{conf}->{uridnsbl_skip_domains};
222    
223 dos 573117 # list of hashes to use in order
224 mmartinec 571893 my @uri_ordered;
225 felicity 155151
226     # Generate the full list of html-parsed domains.
227 felicity 169564 my $uris = $scanner->get_uri_detail_list();
228 felicity 155151
229 felicity 157209 # go from uri => info to uri_ordered
230     # 0: a
231     # 1: form
232     # 2: img
233     # 3: !a_empty
234     # 4: parsed
235     # 5: a_empty
236 felicity 169564 while (my($uri, $info) = each %{$uris}) {
237 felicity 170124 # we want to skip mailto: uris
238     next if ($uri =~ /^mailto:/);
239    
240     # no domains were found via this uri, so skip
241     next unless ($info->{domains});
242    
243 felicity 157209 my $entry = 3;
244    
245     if ($info->{types}->{a}) {
246     $entry = 5;
247    
248     # determine a vs a_empty
249     foreach my $at (@{$info->{anchor_text}}) {
250     if (length $at) {
251     $entry = 0;
252     last;
253     }
254     }
255 felicity 155151 }
256 felicity 157209 elsif ($info->{types}->{form}) {
257     $entry = 1;
258     }
259     elsif ($info->{types}->{img}) {
260     $entry = 2;
261     }
262 felicity 169570 elsif ($info->{types}->{parsed} && (keys %{$info->{types}} == 1)) {
263 felicity 169564 $entry = 4;
264     }
265 felicity 155151
266 felicity 170124 # take the usable domains and add to the ordered list
267     foreach ( keys %{ $info->{domains} } ) {
268     if (exists $skip_domains->{$_}) {
269     dbg("uridnsbl: domain $_ in skip list");
270     next;
271     }
272     $uri_ordered[$entry]->{$_} = 1;
273     }
274 felicity 155151 }
275    
276 felicity 170124 # at this point, @uri_ordered is an ordered array of uri hashes
277 felicity 155151
278 mmartinec 571893 my %domlist;
279 felicity 439873 my $umd = $scanner->{main}->{conf}->{uridnsbl_max_domains};
280     while (keys %domlist < $umd && @uri_ordered) {
281 felicity 155151 my $array = shift @uri_ordered;
282 felicity 157209 next unless $array;
283    
284 felicity 170124 # run through and find the new domains in this grouping
285     my @domains = grep(!$domlist{$_}, keys %{$array});
286     next unless @domains;
287 felicity 155151
288     # the new domains are all useful, just add them in
289 felicity 439873 if (keys(%domlist) + @domains <= $umd) {
290 felicity 170124 foreach (@domains) {
291 felicity 155151 $domlist{$_} = 1;
292 felicity 47380 }
293 felicity 155151 }
294     else {
295     # trim down to a limited number - pick randomly
296     my $i;
297 felicity 439873 while (@domains && keys %domlist < $umd) {
298 felicity 170124 my $r = int rand (scalar @domains);
299     $domlist{splice (@domains, $r, 1)} = 1;
300 felicity 47380 }
301     }
302 jm 6898 }
303    
304     # and query
305 felicity 155151 dbg("uridnsbl: domains to query: ".join(' ',keys %domlist));
306     foreach my $dom (keys %domlist) {
307 felicity 439873 $self->query_domain ($scanner, $dom);
308 jm 6898 }
309    
310     return 1;
311     }
312    
313 felicity 56728 sub set_config {
314     my($self, $conf) = @_;
315 mmartinec 571893 my @cmds;
316 jm 6898
317 felicity 56728 push(@cmds, {
318     setting => 'uridnsbl_max_domains',
319 dos 527740 is_admin => 1,
320 felicity 56728 default => 20,
321     type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
322     });
323 jm 6898
324 felicity 56728 push (@cmds, {
325     setting => 'uridnsbl',
326 dos 527740 is_priv => 1,
327 felicity 56728 code => sub {
328     my ($self, $key, $value, $line) = @_;
329     if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
330     my $rulename = $1;
331     my $zone = $2;
332     my $type = $3;
333     $self->{uridnsbls}->{$rulename} = {
334     zone => $zone, type => $type,
335     is_rhsbl => 0
336     };
337     }
338 dos 178359 elsif ($value =~ /^$/) {
339     return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
340     }
341     else {
342     return $Mail::SpamAssassin::Conf::INVALID_VALUE;
343     }
344 jm 6898 }
345 felicity 56728 });
346 felicity 55981
347 felicity 56728 push (@cmds, {
348 jm 646805 setting => 'uridnssub',
349     is_priv => 1,
350     code => sub {
351     my ($self, $key, $value, $line) = @_;
352     if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\d{1,10}|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
353     my $rulename = $1;
354     my $zone = $2;
355     my $type = $3;
356     my $subrule = $4;
357     $self->{uridnsbls}->{$rulename} = {
358     zone => $zone, type => $type,
359     is_rhsbl => 0, is_subrule => 1
360     };
361     $self->{uridnsbl_subs}->{$zone} ||= { };
362     push (@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}}, $rulename);
363     }
364     elsif ($value =~ /^$/) {
365     return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
366     }
367     else {
368     return $Mail::SpamAssassin::Conf::INVALID_VALUE;
369     }
370     }
371     });
372    
373     push (@cmds, {
374 felicity 56728 setting => 'urirhsbl',
375 dos 527740 is_priv => 1,
376 felicity 56728 code => sub {
377     my ($self, $key, $value, $line) = @_;
378     if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)$/) {
379     my $rulename = $1;
380     my $zone = $2;
381     my $type = $3;
382     $self->{uridnsbls}->{$rulename} = {
383     zone => $zone, type => $type,
384     is_rhsbl => 1
385     };
386     }
387 dos 178359 elsif ($value =~ /^$/) {
388     return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
389     }
390     else {
391     return $Mail::SpamAssassin::Conf::INVALID_VALUE;
392     }
393 jm 9881 }
394 felicity 56728 });
395 felicity 55981
396 felicity 56728 push (@cmds, {
397     setting => 'urirhssub',
398 dos 527740 is_priv => 1,
399 felicity 56728 code => sub {
400     my ($self, $key, $value, $line) = @_;
401 sidney 433917 if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\d{1,10}|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
402 felicity 56728 my $rulename = $1;
403     my $zone = $2;
404     my $type = $3;
405     my $subrule = $4;
406     $self->{uridnsbls}->{$rulename} = {
407     zone => $zone, type => $type,
408     is_rhsbl => 1, is_subrule => 1
409     };
410     $self->{uridnsbl_subs}->{$zone} ||= { };
411 dos 543724 push (@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}}, $rulename);
412 felicity 56728 }
413 dos 178359 elsif ($value =~ /^$/) {
414     return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
415     }
416     else {
417     return $Mail::SpamAssassin::Conf::INVALID_VALUE;
418     }
419 jm 21406 }
420 felicity 56728 });
421 felicity 55981
422 felicity 56728 push (@cmds, {
423     setting => 'uridnsbl_skip_domain',
424     default => {},
425     code => sub {
426     my ($self, $key, $value, $line) = @_;
427 dos 178359 if ($value =~ /^$/) {
428     return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
429     }
430 felicity 56728 foreach my $domain (split(/\s+/, $value)) {
431     $self->{uridnsbl_skip_domains}->{lc $domain} = 1;
432     }
433 felicity 47380 }
434 felicity 56728 });
435 felicity 55981
436 jm 527859 # obsolete
437     push(@cmds, {
438     setting => 'uridnsbl_timeout',
439     code => sub {
440     # not a lint_warn(), since it's pretty harmless and we don't want
441     # to break stuff like sa-update
442     warn("config: 'uridnsbl_timeout' is obsolete, use 'rbl_timeout' instead");
443     return 0;
444     }
445     });
446    
447 felicity 56728 $conf->{parser}->register_commands(\@cmds);
448 jm 6898 }
449    
450     # ---------------------------------------------------------------------------
451    
452     sub query_domain {
453 felicity 439873 my ($self, $scanner, $dom) = @_;
454 jm 6898
455 quinlan 51813 #warn "uridnsbl: domain $dom\n";
456     #return;
457 jm 6898
458     $dom = lc $dom;
459 felicity 439873 return if $scanner->{uridnsbl_seen_domain}->{$dom};
460     $scanner->{uridnsbl_seen_domain}->{$dom} = 1;
461 quinlan 160273 $self->log_dns_result("querying domain $dom");
462 jm 6898
463 mmartinec 567684 my $obj = { dom => $dom };
464 jm 6898
465 quinlan 160273 my $single_dnsbl = 0;
466 jm 394351 if ($dom =~ /^\d+\.\d+\.\d+\.\d+$/) {
467 quinlan 160273 my $IPV4_ADDRESS = IPV4_ADDRESS;
468     my $IP_PRIVATE = IP_PRIVATE;
469     # only look up the IP if it is public and valid
470     if ($dom =~ /^$IPV4_ADDRESS$/ && $dom !~ /^$IP_PRIVATE$/) {
471 felicity 439873 $self->lookup_dnsbl_for_ip($scanner, $obj, $dom);
472 quinlan 160273 # and check the IP in RHSBLs too
473     if ($dom =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
474     $dom = "$4.$3.$2.$1";
475     $single_dnsbl = 1;
476     }
477     }
478 jm 9881 }
479 felicity 47380 else {
480 quinlan 160273 $single_dnsbl = 1;
481     }
482    
483 jm 596095 my $rhsblrules = $scanner->{uridnsbl_active_rules_rhsbl};
484     my $reviprules = $scanner->{uridnsbl_active_rules_revipbl};
485    
486 quinlan 160273 if ($single_dnsbl) {
487 jm 9881 # look up the domain in the RHSBL subset
488 jm 596095 foreach my $rulename (keys %{$rhsblrules}) {
489 felicity 439873 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
490     $self->lookup_single_dnsbl($scanner, $obj, $rulename,
491 quinlan 160273 $dom, $rulecf->{zone}, $rulecf->{type});
492 jm 394351
493     # see comment below
494 felicity 439873 $scanner->register_async_rule_start($rulename);
495 jm 9881 }
496    
497 jm 596095 # perform NS, A lookups to look up the domain in the non-RHSBL subset,
498     # but only if there are active reverse-IP-URIBL rules
499     if ($dom !~ /^\d+\.\d+\.\d+\.\d+$/ && (scalar keys %{$reviprules})) {
500 felicity 439873 $self->lookup_domain_ns($scanner, $obj, $dom);
501 quinlan 160273 }
502 jm 6898 }
503 jm 394351
504     # note that these rules are now underway. important: unless the
505     # rule hits, in the current design, these will not be considered
506     # "finished" until harvest_dnsbl_queries() completes
507 jm 596095 foreach my $rulename (keys %{$reviprules}) {
508 felicity 439873 $scanner->register_async_rule_start($rulename);
509 jm 394351 }
510 jm 6898 }
511    
512     # ---------------------------------------------------------------------------
513    
514     sub lookup_domain_ns {
515 felicity 439873 my ($self, $scanner, $obj, $dom) = @_;
516 jm 6898
517     my $key = "NS:".$dom;
518 felicity 439873 return if $scanner->{async}->get_lookup($key);
519 jm 6898
520     # dig $dom ns
521 mmartinec 585292 my $ent = $self->start_lookup($scanner, $dom, 'NS',
522 mmartinec 564636 $self->res_bgsend($scanner, $dom, 'NS', $key),
523     $key);
524 jm 6898 $ent->{obj} = $obj;
525     }
526    
527     sub complete_ns_lookup {
528 felicity 439873 my ($self, $scanner, $ent, $dom) = @_;
529 jm 7002
530 jm 161157 my $packet = $ent->{response_packet};
531 mmartinec 582903 my @answer = !defined $packet ? () : $packet->answer;
532 jm 6898
533 quinlan 160273 my $IPV4_ADDRESS = IPV4_ADDRESS;
534     my $IP_PRIVATE = IP_PRIVATE;
535    
536 jm 6898 foreach my $rr (@answer) {
537     my $str = $rr->string;
538     next unless (defined($str) && defined($dom));
539     $self->log_dns_result ("NSs for $dom: $str");
540    
541     if ($str =~ /IN\s+NS\s+(\S+)/) {
542 quinlan 160273 my $nsmatch = $1;
543    
544     if ($nsmatch =~ /^\d+\.\d+\.\d+\.\d+\.?$/) {
545     $nsmatch =~ s/\.$//;
546     # only look up the IP if it is public and valid
547     if ($nsmatch =~ /^$IPV4_ADDRESS$/ && $nsmatch !~ /^$IP_PRIVATE$/) {
548 felicity 439873 $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $nsmatch);
549 quinlan 160273 }
550     }
551     else {
552 felicity 439873 $self->lookup_a_record($scanner, $ent->{obj}, $nsmatch);
553 quinlan 160273 }
554 jm 6898 }
555     }
556     }
557    
558     # ---------------------------------------------------------------------------
559    
560     sub lookup_a_record {
561 felicity 439873 my ($self, $scanner, $obj, $hname) = @_;
562 jm 6898
563     my $key = "A:".$hname;
564 felicity 439873 return if $scanner->{async}->get_lookup($key);
565 jm 6898
566     # dig $hname a
567 mmartinec 585292 my $ent = $self->start_lookup($scanner, $hname, 'A',
568 mmartinec 564636 $self->res_bgsend($scanner, $hname, 'A', $key),
569     $key);
570 jm 6898 $ent->{obj} = $obj;
571     }
572    
573     sub complete_a_lookup {
574 felicity 439873 my ($self, $scanner, $ent, $hname) = @_;
575 jm 6898
576 mmartinec 582903 my $packet = $ent->{response_packet};
577     my @answer = !defined $packet ? () : $packet->answer;
578     foreach my $rr (@answer) {
579 jm 6898 my $str = $rr->string;
580     $self->log_dns_result ("A for NS $hname: $str");
581    
582     if ($str =~ /IN\s+A\s+(\S+)/) {
583 felicity 439873 $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $1);
584 jm 6898 }
585     }
586     }
587    
588     # ---------------------------------------------------------------------------
589    
590     sub lookup_dnsbl_for_ip {
591 felicity 439873 my ($self, $scanner, $obj, $ip) = @_;
592 jm 6898
593     $ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
594     my $revip = "$4.$3.$2.$1";
595    
596 felicity 439873 my $cf = $scanner->{uridnsbl_active_rules_revipbl};
597 jm 6898 foreach my $rulename (keys %{$cf}) {
598 felicity 439873 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
599     $self->lookup_single_dnsbl($scanner, $obj, $rulename,
600 quinlan 160273 $revip, $rulecf->{zone}, $rulecf->{type});
601 jm 6898 }
602     }
603    
604     sub lookup_single_dnsbl {
605 felicity 439873 my ($self, $scanner, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
606 jm 6898
607 jm 9881 my $key = "DNSBL:".$dnsbl.":".$lookupstr;
608 felicity 439873 return if $scanner->{async}->get_lookup($key);
609 jm 9881 my $item = $lookupstr.".".$dnsbl;
610 jm 6898
611     # dig $ip txt
612 mmartinec 585292 my $ent = $self->start_lookup($scanner, $item, 'DNSBL',
613 mmartinec 564636 $self->res_bgsend($scanner, $item, $qtype, $key),
614     $key);
615 jm 6898 $ent->{obj} = $obj;
616     $ent->{rulename} = $rulename;
617 jm 21406 $ent->{zone} = $dnsbl;
618 jm 6898 }
619    
620     sub complete_dnsbl_lookup {
621 felicity 439873 my ($self, $scanner, $ent, $dnsblip) = @_;
622 jm 6898
623 felicity 439873 my $conf = $scanner->{conf};
624 mmartinec 571893 my @subtests;
625 jm 21406 my $rulename = $ent->{rulename};
626     my $rulecf = $conf->{uridnsbls}->{$rulename};
627    
628 jm 161157 my $packet = $ent->{response_packet};
629 mmartinec 582903 my @answer = !defined $packet ? () : $packet->answer;
630 jm 161157
631 quinlan 125719 my $uridnsbl_subs = $conf->{uridnsbl_subs}->{$ent->{zone}};
632 jm 21406 foreach my $rr (@answer)
633     {
634     next if ($rr->type ne 'A' && $rr->type ne 'TXT');
635    
636     my $rdatastr = $rr->rdatastr;
637 jm 6898 my $dom = $ent->{obj}->{dom};
638    
639 jm 21406 if (!$rulecf->{is_subrule}) {
640     # this zone is a simple rule, not a set of subrules
641 quinlan 125719 # skip any A record that isn't on 127/8
642 jm 158887 if ($rr->type eq 'A' && $rr->rdatastr !~ /^127\./) {
643 jm 165017 warn("uridnsbl: bogus rr for domain=$dom, rule=$rulename, id=" .
644     $packet->header->id." rr=".$rr->string);
645 quinlan 158898 next;
646 jm 158887 }
647 felicity 439873 $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $rulename);
648 jm 21406 }
649     else {
650     foreach my $subtest (keys (%{$uridnsbl_subs}))
651     {
652     if ($subtest eq $rdatastr) {
653 dos 543724 foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
654     $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
655     }
656 jm 21406 }
657     # bitmask
658     elsif ($subtest =~ /^\d+$/) {
659 sidney 433917 if ($rdatastr =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ &&
660     Mail::SpamAssassin::Util::my_inet_aton($rdatastr) & $subtest)
661 jm 21406 {
662 dos 543724 foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
663     $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
664     }
665 jm 21406 }
666     }
667     }
668     }
669 jm 6898 }
670     }
671    
672 jm 21406 sub got_dnsbl_hit {
673 felicity 439873 my ($self, $scanner, $ent, $str, $dom, $rulename) = @_;
674 jm 21406
675     $str =~ s/\s+/ /gs; # long whitespace => short
676 quinlan 51813 dbg("uridnsbl: domain \"$dom\" listed ($rulename): $str");
677 jm 21406
678 felicity 439873 if (!defined $scanner->{uridnsbl_hits}->{$rulename}) {
679     $scanner->{uridnsbl_hits}->{$rulename} = { };
680 jm 21406 };
681 felicity 439873 $scanner->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
682 jm 394348
683 felicity 439873 if ($scanner->{uridnsbl_active_rules_revipbl}->{$rulename}
684     || $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename})
685 jm 394348 {
686     # TODO: this needs to handle multiple domain hits per rule
687 felicity 439873 $scanner->clear_test_state();
688     my $uris = join (' ', keys %{$scanner->{uridnsbl_hits}->{$rulename}});
689     $scanner->test_log ("URIs: $uris");
690     $scanner->got_hit ($rulename, "");
691 jm 394351
692     # note that this rule has completed (since it got at least 1 hit)
693 felicity 439873 $scanner->register_async_rule_finish($rulename);
694 jm 394348 }
695 jm 21406 }
696    
697 jm 6898 # ---------------------------------------------------------------------------
698    
699     sub start_lookup {
700 mmartinec 585292 my ($self, $scanner, $zone, $type, $id, $key) = @_;
701 jm 394348
702 jm 6898 my $ent = {
703 jm 394348 key => $key,
704 mmartinec 585292 zone => $zone, # serves to fetch other per-zone settings
705 jm 394348 type => "URI-".$type,
706     id => $id,
707     completed_callback => sub {
708     my $ent = shift;
709 mmartinec 580055 if (defined $ent->{response_packet}) { # not aborted or empty
710     $self->completed_lookup_callback ($scanner, $ent);
711     }
712 jm 394348 }
713 jm 6898 };
714 felicity 439873 $scanner->{async}->start_lookup($ent);
715 jm 394348 return $ent;
716 jm 6898 }
717    
718 jm 394348 sub completed_lookup_callback {
719 felicity 439873 my ($self, $scanner, $ent) = @_;
720 jm 394348 my $type = $ent->{type};
721     my $key = $ent->{key};
722     $key =~ /:(\S+?)$/; my $val = $1;
723 jm 6898
724 jm 394348 if ($type eq 'URI-NS') {
725 felicity 439873 $self->complete_ns_lookup ($scanner, $ent, $val);
726 jm 6898 }
727 jm 394348 elsif ($type eq 'URI-A') {
728 felicity 439873 $self->complete_a_lookup ($scanner, $ent, $val);
729 jm 6898 }
730 jm 394348 elsif ($type eq 'URI-DNSBL') {
731 felicity 439873 $self->complete_dnsbl_lookup ($scanner, $ent, $val);
732 jm 6898 }
733     }
734    
735     # ---------------------------------------------------------------------------
736    
737 jm 161148 sub res_bgsend {
738 mmartinec 564636 my ($self, $scanner, $host, $type, $key) = @_;
739 jm 161778
740     return $self->{main}->{resolver}->bgsend($host, $type, undef, sub {
741 mmartinec 564636 my ($pkt, $id, $timestamp) = @_;
742     $scanner->{async}->set_response_packet($id, $pkt, $key, $timestamp);
743 jm 161778 });
744 jm 161148 }
745    
746 jm 6898 sub log_dns_result {
747 felicity 57557 #my $self = shift;
748 quinlan 51813 #Mail::SpamAssassin::dbg("uridnsbl: ".join (' ', @_));
749 jm 6898 }
750    
751     # ---------------------------------------------------------------------------
752    
753     1;

apache@apache.org
ViewVC Help
Powered by ViewVC 1.1.2