/[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 - (show 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 # <@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 URIDNSBL - look up URLs against DNS blocklists
21
22 =head1 SYNOPSIS
23
24 loadplugin Mail::SpamAssassin::Plugin::URIDNSBL
25 uridnsbl URIBL_SBLXBL sbl-xbl.spamhaus.org. TXT
26
27 =head1 DESCRIPTION
28
29 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 =head1 USER SETTINGS
35
36 =over 4
37
38 =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 =item uridnsbl NAME_OF_RULE dnsbl_zone lookuptype
51
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 define a body-eval rule calling C<check_uridnsbl()> to use this.
56
57 Example:
58
59 uridnsbl URIBL_SBLXBL sbl-xbl.spamhaus.org. TXT
60 body URIBL_SBLXBL eval:check_uridnsbl('URIBL_SBLXBL')
61 describe URIBL_SBLXBL Contains a URL listed in the SBL/XBL blocklist
62
63 =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 =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 define a body-eval rule calling C<check_uridnsbl()> to use this.
88
89 An RHSBL zone is one where the domain name is looked up, as a string; e.g. a
90 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
96 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
99 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 either be an IPv4 dotted address for RHSBLs that return multiple A records or a
111 non-negative decimal number to specify a bitmask for RHSBLs that return a
112 single A record containing a bitmask of results.
113
114 Note that, as with C<urirhsbl>, you must also define a body-eval rule calling
115 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 =back
123
124 =head1 ADMINISTRATOR SETTINGS
125
126 =over 4
127
128 =item uridnsbl_max_domains N (default: 20)
129
130 The maximum number of domains to look up.
131
132 =back
133
134 =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 =cut
140
141 package Mail::SpamAssassin::Plugin::URIDNSBL;
142
143 use Mail::SpamAssassin::Plugin;
144 use Mail::SpamAssassin::Constants qw(:ip);
145 use Mail::SpamAssassin::Util;
146 use Mail::SpamAssassin::Logger;
147 use strict;
148 use warnings;
149 use bytes;
150 use re 'taint';
151
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 # this can be effectively global, at least in each process, safely
168
169 $self->{finished} = { };
170
171 $self->register_eval_rule ("check_uridnsbl");
172 $self->set_config($samain->{conf});
173
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 if (!$scanner->is_dns_available()) {
191 $self->{dns_not_available} = 1;
192 return;
193 } 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 }
198
199 $scanner->{'uridnsbl_activerules'} = { };
200 $scanner->{'uridnsbl_hits'} = { };
201 $scanner->{'uridnsbl_seen_domain'} = { };
202
203 # only hit DNSBLs for active rules (defined and score != 0)
204 $scanner->{'uridnsbl_active_rules_rhsbl'} = { };
205 $scanner->{'uridnsbl_active_rules_revipbl'} = { };
206
207 foreach my $rulename (keys %{$scanner->{conf}->{uridnsbls}}) {
208 next unless ($scanner->{conf}->is_rule_active('body_evals',$rulename));
209
210 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
211 if ($rulecf->{is_rhsbl}) {
212 $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename} = 1;
213 } else {
214 $scanner->{uridnsbl_active_rules_revipbl}->{$rulename} = 1;
215 }
216 }
217
218 # get all domains in message
219
220 # don't keep dereferencing this
221 my $skip_domains = $scanner->{main}->{conf}->{uridnsbl_skip_domains};
222
223 # list of hashes to use in order
224 my @uri_ordered;
225
226 # Generate the full list of html-parsed domains.
227 my $uris = $scanner->get_uri_detail_list();
228
229 # 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 while (my($uri, $info) = each %{$uris}) {
237 # 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 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 }
256 elsif ($info->{types}->{form}) {
257 $entry = 1;
258 }
259 elsif ($info->{types}->{img}) {
260 $entry = 2;
261 }
262 elsif ($info->{types}->{parsed} && (keys %{$info->{types}} == 1)) {
263 $entry = 4;
264 }
265
266 # 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 }
275
276 # at this point, @uri_ordered is an ordered array of uri hashes
277
278 my %domlist;
279 my $umd = $scanner->{main}->{conf}->{uridnsbl_max_domains};
280 while (keys %domlist < $umd && @uri_ordered) {
281 my $array = shift @uri_ordered;
282 next unless $array;
283
284 # run through and find the new domains in this grouping
285 my @domains = grep(!$domlist{$_}, keys %{$array});
286 next unless @domains;
287
288 # the new domains are all useful, just add them in
289 if (keys(%domlist) + @domains <= $umd) {
290 foreach (@domains) {
291 $domlist{$_} = 1;
292 }
293 }
294 else {
295 # trim down to a limited number - pick randomly
296 my $i;
297 while (@domains && keys %domlist < $umd) {
298 my $r = int rand (scalar @domains);
299 $domlist{splice (@domains, $r, 1)} = 1;
300 }
301 }
302 }
303
304 # and query
305 dbg("uridnsbl: domains to query: ".join(' ',keys %domlist));
306 foreach my $dom (keys %domlist) {
307 $self->query_domain ($scanner, $dom);
308 }
309
310 return 1;
311 }
312
313 sub set_config {
314 my($self, $conf) = @_;
315 my @cmds;
316
317 push(@cmds, {
318 setting => 'uridnsbl_max_domains',
319 is_admin => 1,
320 default => 20,
321 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
322 });
323
324 push (@cmds, {
325 setting => 'uridnsbl',
326 is_priv => 1,
327 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 elsif ($value =~ /^$/) {
339 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
340 }
341 else {
342 return $Mail::SpamAssassin::Conf::INVALID_VALUE;
343 }
344 }
345 });
346
347 push (@cmds, {
348 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 setting => 'urirhsbl',
375 is_priv => 1,
376 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 elsif ($value =~ /^$/) {
388 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
389 }
390 else {
391 return $Mail::SpamAssassin::Conf::INVALID_VALUE;
392 }
393 }
394 });
395
396 push (@cmds, {
397 setting => 'urirhssub',
398 is_priv => 1,
399 code => sub {
400 my ($self, $key, $value, $line) = @_;
401 if ($value =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\d{1,10}|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
402 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 push (@{$self->{uridnsbl_subs}->{$zone}->{$subrule}->{rulenames}}, $rulename);
412 }
413 elsif ($value =~ /^$/) {
414 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
415 }
416 else {
417 return $Mail::SpamAssassin::Conf::INVALID_VALUE;
418 }
419 }
420 });
421
422 push (@cmds, {
423 setting => 'uridnsbl_skip_domain',
424 default => {},
425 code => sub {
426 my ($self, $key, $value, $line) = @_;
427 if ($value =~ /^$/) {
428 return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
429 }
430 foreach my $domain (split(/\s+/, $value)) {
431 $self->{uridnsbl_skip_domains}->{lc $domain} = 1;
432 }
433 }
434 });
435
436 # 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 $conf->{parser}->register_commands(\@cmds);
448 }
449
450 # ---------------------------------------------------------------------------
451
452 sub query_domain {
453 my ($self, $scanner, $dom) = @_;
454
455 #warn "uridnsbl: domain $dom\n";
456 #return;
457
458 $dom = lc $dom;
459 return if $scanner->{uridnsbl_seen_domain}->{$dom};
460 $scanner->{uridnsbl_seen_domain}->{$dom} = 1;
461 $self->log_dns_result("querying domain $dom");
462
463 my $obj = { dom => $dom };
464
465 my $single_dnsbl = 0;
466 if ($dom =~ /^\d+\.\d+\.\d+\.\d+$/) {
467 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 $self->lookup_dnsbl_for_ip($scanner, $obj, $dom);
472 # 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 }
479 else {
480 $single_dnsbl = 1;
481 }
482
483 my $rhsblrules = $scanner->{uridnsbl_active_rules_rhsbl};
484 my $reviprules = $scanner->{uridnsbl_active_rules_revipbl};
485
486 if ($single_dnsbl) {
487 # look up the domain in the RHSBL subset
488 foreach my $rulename (keys %{$rhsblrules}) {
489 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
490 $self->lookup_single_dnsbl($scanner, $obj, $rulename,
491 $dom, $rulecf->{zone}, $rulecf->{type});
492
493 # see comment below
494 $scanner->register_async_rule_start($rulename);
495 }
496
497 # 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 $self->lookup_domain_ns($scanner, $obj, $dom);
501 }
502 }
503
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 foreach my $rulename (keys %{$reviprules}) {
508 $scanner->register_async_rule_start($rulename);
509 }
510 }
511
512 # ---------------------------------------------------------------------------
513
514 sub lookup_domain_ns {
515 my ($self, $scanner, $obj, $dom) = @_;
516
517 my $key = "NS:".$dom;
518 return if $scanner->{async}->get_lookup($key);
519
520 # dig $dom ns
521 my $ent = $self->start_lookup($scanner, $dom, 'NS',
522 $self->res_bgsend($scanner, $dom, 'NS', $key),
523 $key);
524 $ent->{obj} = $obj;
525 }
526
527 sub complete_ns_lookup {
528 my ($self, $scanner, $ent, $dom) = @_;
529
530 my $packet = $ent->{response_packet};
531 my @answer = !defined $packet ? () : $packet->answer;
532
533 my $IPV4_ADDRESS = IPV4_ADDRESS;
534 my $IP_PRIVATE = IP_PRIVATE;
535
536 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 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 $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $nsmatch);
549 }
550 }
551 else {
552 $self->lookup_a_record($scanner, $ent->{obj}, $nsmatch);
553 }
554 }
555 }
556 }
557
558 # ---------------------------------------------------------------------------
559
560 sub lookup_a_record {
561 my ($self, $scanner, $obj, $hname) = @_;
562
563 my $key = "A:".$hname;
564 return if $scanner->{async}->get_lookup($key);
565
566 # dig $hname a
567 my $ent = $self->start_lookup($scanner, $hname, 'A',
568 $self->res_bgsend($scanner, $hname, 'A', $key),
569 $key);
570 $ent->{obj} = $obj;
571 }
572
573 sub complete_a_lookup {
574 my ($self, $scanner, $ent, $hname) = @_;
575
576 my $packet = $ent->{response_packet};
577 my @answer = !defined $packet ? () : $packet->answer;
578 foreach my $rr (@answer) {
579 my $str = $rr->string;
580 $self->log_dns_result ("A for NS $hname: $str");
581
582 if ($str =~ /IN\s+A\s+(\S+)/) {
583 $self->lookup_dnsbl_for_ip($scanner, $ent->{obj}, $1);
584 }
585 }
586 }
587
588 # ---------------------------------------------------------------------------
589
590 sub lookup_dnsbl_for_ip {
591 my ($self, $scanner, $obj, $ip) = @_;
592
593 $ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
594 my $revip = "$4.$3.$2.$1";
595
596 my $cf = $scanner->{uridnsbl_active_rules_revipbl};
597 foreach my $rulename (keys %{$cf}) {
598 my $rulecf = $scanner->{conf}->{uridnsbls}->{$rulename};
599 $self->lookup_single_dnsbl($scanner, $obj, $rulename,
600 $revip, $rulecf->{zone}, $rulecf->{type});
601 }
602 }
603
604 sub lookup_single_dnsbl {
605 my ($self, $scanner, $obj, $rulename, $lookupstr, $dnsbl, $qtype) = @_;
606
607 my $key = "DNSBL:".$dnsbl.":".$lookupstr;
608 return if $scanner->{async}->get_lookup($key);
609 my $item = $lookupstr.".".$dnsbl;
610
611 # dig $ip txt
612 my $ent = $self->start_lookup($scanner, $item, 'DNSBL',
613 $self->res_bgsend($scanner, $item, $qtype, $key),
614 $key);
615 $ent->{obj} = $obj;
616 $ent->{rulename} = $rulename;
617 $ent->{zone} = $dnsbl;
618 }
619
620 sub complete_dnsbl_lookup {
621 my ($self, $scanner, $ent, $dnsblip) = @_;
622
623 my $conf = $scanner->{conf};
624 my @subtests;
625 my $rulename = $ent->{rulename};
626 my $rulecf = $conf->{uridnsbls}->{$rulename};
627
628 my $packet = $ent->{response_packet};
629 my @answer = !defined $packet ? () : $packet->answer;
630
631 my $uridnsbl_subs = $conf->{uridnsbl_subs}->{$ent->{zone}};
632 foreach my $rr (@answer)
633 {
634 next if ($rr->type ne 'A' && $rr->type ne 'TXT');
635
636 my $rdatastr = $rr->rdatastr;
637 my $dom = $ent->{obj}->{dom};
638
639 if (!$rulecf->{is_subrule}) {
640 # this zone is a simple rule, not a set of subrules
641 # skip any A record that isn't on 127/8
642 if ($rr->type eq 'A' && $rr->rdatastr !~ /^127\./) {
643 warn("uridnsbl: bogus rr for domain=$dom, rule=$rulename, id=" .
644 $packet->header->id." rr=".$rr->string);
645 next;
646 }
647 $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $rulename);
648 }
649 else {
650 foreach my $subtest (keys (%{$uridnsbl_subs}))
651 {
652 if ($subtest eq $rdatastr) {
653 foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
654 $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
655 }
656 }
657 # bitmask
658 elsif ($subtest =~ /^\d+$/) {
659 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 {
662 foreach my $subrulename (@{$uridnsbl_subs->{$subtest}->{rulenames}}) {
663 $self->got_dnsbl_hit($scanner, $ent, $rdatastr, $dom, $subrulename);
664 }
665 }
666 }
667 }
668 }
669 }
670 }
671
672 sub got_dnsbl_hit {
673 my ($self, $scanner, $ent, $str, $dom, $rulename) = @_;
674
675 $str =~ s/\s+/ /gs; # long whitespace => short
676 dbg("uridnsbl: domain \"$dom\" listed ($rulename): $str");
677
678 if (!defined $scanner->{uridnsbl_hits}->{$rulename}) {
679 $scanner->{uridnsbl_hits}->{$rulename} = { };
680 };
681 $scanner->{uridnsbl_hits}->{$rulename}->{$dom} = 1;
682
683 if ($scanner->{uridnsbl_active_rules_revipbl}->{$rulename}
684 || $scanner->{uridnsbl_active_rules_rhsbl}->{$rulename})
685 {
686 # TODO: this needs to handle multiple domain hits per rule
687 $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
692 # note that this rule has completed (since it got at least 1 hit)
693 $scanner->register_async_rule_finish($rulename);
694 }
695 }
696
697 # ---------------------------------------------------------------------------
698
699 sub start_lookup {
700 my ($self, $scanner, $zone, $type, $id, $key) = @_;
701
702 my $ent = {
703 key => $key,
704 zone => $zone, # serves to fetch other per-zone settings
705 type => "URI-".$type,
706 id => $id,
707 completed_callback => sub {
708 my $ent = shift;
709 if (defined $ent->{response_packet}) { # not aborted or empty
710 $self->completed_lookup_callback ($scanner, $ent);
711 }
712 }
713 };
714 $scanner->{async}->start_lookup($ent);
715 return $ent;
716 }
717
718 sub completed_lookup_callback {
719 my ($self, $scanner, $ent) = @_;
720 my $type = $ent->{type};
721 my $key = $ent->{key};
722 $key =~ /:(\S+?)$/; my $val = $1;
723
724 if ($type eq 'URI-NS') {
725 $self->complete_ns_lookup ($scanner, $ent, $val);
726 }
727 elsif ($type eq 'URI-A') {
728 $self->complete_a_lookup ($scanner, $ent, $val);
729 }
730 elsif ($type eq 'URI-DNSBL') {
731 $self->complete_dnsbl_lookup ($scanner, $ent, $val);
732 }
733 }
734
735 # ---------------------------------------------------------------------------
736
737 sub res_bgsend {
738 my ($self, $scanner, $host, $type, $key) = @_;
739
740 return $self->{main}->{resolver}->bgsend($host, $type, undef, sub {
741 my ($pkt, $id, $timestamp) = @_;
742 $scanner->{async}->set_response_packet($id, $pkt, $key, $timestamp);
743 });
744 }
745
746 sub log_dns_result {
747 #my $self = shift;
748 #Mail::SpamAssassin::dbg("uridnsbl: ".join (' ', @_));
749 }
750
751 # ---------------------------------------------------------------------------
752
753 1;

apache@apache.org
ViewVC Help
Powered by ViewVC 1.1.2