← Back to branch summary

~ubuntu-branches/ubuntu/utopic/spamassassin/utopic-proposed

« back to all changes in this revision

Viewing changes to lib/Mail/SpamAssassin/Dns.pm

  • Committer: Bazaar Package Importer
  • Author(s): Noah Meyerhans
  • Date: 2010-01-26 22:53:12 UTC
  • mfrom: (1.1.13 upstream) (5.1.7 sid)
  • Revision ID: james.westby@ubuntu.com-20100126225312-wkftb10idc1kz2aq
Tags: 3.3.0-1
* New upstream version.
* Switch to dpkg-source 3.0 (quilt) format

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Mail/SpamAssassin/Dns.pm
20
20
 
21
21
package Mail::SpamAssassin::PerMsgStatus;
22
22
 
 
23
use strict;
 
24
use warnings;
 
25
use bytes;
 
26
use re 'taint';
 
27
 
23
28
use Mail::SpamAssassin::Conf;
24
29
use Mail::SpamAssassin::PerMsgStatus;
25
30
use Mail::SpamAssassin::AsyncLoop;
26
31
use Mail::SpamAssassin::Constants qw(:ip);
 
32
use Mail::SpamAssassin::Util qw(untaint_var);
 
33
 
27
34
use File::Spec;
28
35
use IO::Socket;
29
36
use POSIX ":sys_wait_h";
30
37
 
31
 
use strict;
32
 
use warnings;
33
 
use bytes;
34
 
 
35
38
use vars qw{
36
39
  $KNOWN_BAD_DIALUP_RANGES @EXISTING_DOMAINS $IS_DNS_AVAILABLE $LAST_DNS_CHECK $VERSION
37
40
};
73
76
  # loads later (which will happen).  If we do a fork(), we could wind up
74
77
  # attempting to load these modules in *every* subprocess.
75
78
  #
76
 
  # We turn off strict and warnings, because Net::DNS and Razor both contain
77
 
  # crud that -w complains about (perl 5.6.0).  Not that this seems to work,
78
 
  # mind ;)
79
 
 
80
 
  no strict;
81
 
  local ($^W) = 0;
82
 
 
 
79
# # We turn off strict and warnings, because Net::DNS and Razor both contain
 
80
# # crud that -w complains about (perl 5.6.0).  Not that this seems to work,
 
81
# # mind ;)
 
82
# no strict;
 
83
# local ($^W) = 0;
 
84
 
 
85
  no warnings;
83
86
  eval {
84
87
    require Net::DNS;
85
88
    require Net::DNS::Resolver;
107
110
 
108
111
    my $ent = {
109
112
      key => $key,
110
 
      zone => $host,  # may serve to fetch other per-zone settings
 
113
      zone => $host,  # serves to fetch other per-zone settings
111
114
      type => "DNSBL-".$type,
112
115
      sets => [ ],  # filled in below
113
116
      rules => [ ], # filled in below
121
124
      });
122
125
 
123
126
    $ent->{id} = $id;     # tie up the loose end
124
 
    $existing = $self->{async}->start_lookup($ent);
 
127
    $existing =
 
128
      $self->{async}->start_lookup($ent, $self->{master_deadline});
125
129
  }
126
130
 
127
131
  # always add set
156
160
 
157
161
  my $ent = {
158
162
    key => $key,
159
 
    zone => $host,  # may serve to fetch other per-zone settings
 
163
    zone => $host,  # serves to fetch other per-zone settings
160
164
    type => "DNSBL-".$type,
161
165
    rules => [ $rule ],
162
166
    # id is filled in after we send the query below
169
173
    });
170
174
 
171
175
  $ent->{id} = $id;     # tie up the loose end
172
 
  $self->{async}->start_lookup($ent);
 
176
  $self->{async}->start_lookup($ent, $self->{master_deadline});
173
177
}
174
178
 
175
179
###########################################################################
182
186
    if ($answer->type eq 'TXT') {
183
187
      $log = $answer->rdatastr;
184
188
      $log =~ s/^"(.*)"$/$1/;
185
 
      $log =~ s/(http:\/\/\S+)/<$1>/g;
 
189
      $log =~ s/(?<![<([])(https?:\/\/\S+)/<$1>/g;
186
190
    }
187
191
    elsif ($question->string =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\S+\w)/) {
188
192
      $log = "$4.$3.$2.$1 listed in $5";
222
226
    my $uri = "dns:$qname" . (@vals ? "?" . join(";", @vals) : "");
223
227
    push @{ $self->{dnsuri}->{$uri} }, $rdatastr;
224
228
 
225
 
    dbg ("dns: hit <$uri> $rdatastr");
 
229
    dbg("dns: hit <$uri> $rdatastr");
226
230
  }
227
231
}
228
232
 
 
233
# called as a completion routine to bgsend by DnsResolver::poll_responses;
229
234
# returns 1 on successful packet processing
230
235
sub process_dnsbl_result {
231
236
  my ($self, $query, $packet) = @_;
300
305
        $subtest =~ s/\bS(\d+)\b/\$sb{$1}/;
301
306
      }
302
307
 
303
 
      # untaint. doing the usual $subtest=$1 doesn't work! (bug 3325)
304
 
      $subtest =~ /^(.*)$/;
305
 
      my $untainted = $1;
306
 
      $subtest = $untainted;
 
308
      # untaint. (bug 3325)
 
309
      $subtest = untaint_var($subtest);
307
310
 
308
311
      $self->got_hit($rule, "SenderBase: ", ruletype => "dnsbl") if !$undef && eval $subtest;
309
312
    }
330
333
 
331
334
  dbg("dns: harvest_until_rule_completes");
332
335
  my $result = 0;
333
 
  my $total_waiting_time = 0;
334
336
 
335
337
  for (my $first=1;  ; $first=0) {
336
338
    # complete_lookups() may call completed_callback(), which may
337
339
    # call start_lookup() again (like in Plugin::URIDNSBL)
338
 
    my ($alldone,$anydone,$waiting_time) =
 
340
    my ($alldone,$anydone) =
339
341
      $self->{async}->complete_lookups($first ? 0 : 1.0,  1);
340
 
    $total_waiting_time += $waiting_time;
341
342
 
342
343
    $result = 1  if $self->is_rule_complete($rule);
343
344
    last  if $result || $alldone;
345
346
    dbg("dns: harvest_until_rule_completes - check_tick");
346
347
    $self->{main}->call_plugins ("check_tick", { permsgstatus => $self });
347
348
  }
348
 
  dbg("dns: timing: %.3f s sleeping in harvest_until_rule_completes",
349
 
      $total_waiting_time)  if $total_waiting_time > 0;
350
349
 
351
350
  return $result;
352
351
}
355
354
  my ($self) = @_;
356
355
 
357
356
  dbg("dns: harvest_dnsbl_queries");
358
 
  my $total_waiting_time = 0;
359
357
 
360
358
  for (my $first=1;  ; $first=0) {
361
 
 
362
359
    # complete_lookups() may call completed_callback(), which may
363
360
    # call start_lookup() again (like in Plugin::URIDNSBL)
364
361
 
366
363
    # complete_lookups a chance to ripe any available results and
367
364
    # abort overdue requests, without needlessly waiting for more
368
365
 
369
 
    my ($alldone,$anydone,$waiting_time) =
 
366
    my ($alldone,$anydone) =
370
367
      $self->{async}->complete_lookups($first ? 0 : 1.0,  1);
371
 
    $total_waiting_time += $waiting_time;
372
368
 
373
369
    last  if $alldone;
374
370
 
380
376
  $self->{async}->abort_remaining_lookups();
381
377
  $self->{async}->log_lookups_timing();
382
378
  $self->mark_all_async_rules_complete();
383
 
  dbg("dns: timing: %.3f s sleeping in harvest_dnsbl_queries",
384
 
      $total_waiting_time)  if $total_waiting_time > 0;
385
379
  1;
386
380
}
387
381
 
456
450
  } else {
457
451
    eval {
458
452
      my $query = $self->{resolver}->send($dom, 'NS');
459
 
      my @nses = ();
 
453
      my @nses;
460
454
      if ($query) {
461
455
        foreach my $rr ($query->answer) {
462
456
          if ($rr->type eq "NS") { push (@nses, $rr->nsdname); }
466
460
      1;
467
461
    } or do {
468
462
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
469
 
      dbg("dns: NS lookup failed horribly, perhaps bad resolv.conf setting? ($eval_stat)");
 
463
      dbg("dns: NS lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
470
464
      return undef;
471
465
    };
472
466
  }
489
483
  } else {
490
484
    eval {
491
485
      my $query = $self->{resolver}->send($dom, 'MX');
492
 
      my @ips = ();
 
486
      my @ips;
493
487
      if ($query) {
494
488
        foreach my $rr ($query->answer) {
495
489
          # just keep the IPs, drop the preferences.
496
490
          if ($rr->type eq "MX") { push (@ips, $rr->exchange); }
497
491
        }
498
492
      }
499
 
 
500
493
      $mxrecords = $self->{dnscache}->{MX}->{$dom} = [ @ips ];
501
494
      1;
502
495
    } or do {
503
496
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
504
 
      dbg("dns: MX lookup failed horribly, perhaps bad resolv.conf setting? ($eval_stat)");
 
497
      dbg("dns: MX lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
505
498
      return undef;
506
499
    };
507
500
  }
555
548
          }
556
549
        }
557
550
      }
558
 
 
559
551
      $name = $self->{dnscache}->{PTR}->{$dom} = $name;
560
552
      1;
561
553
    } or do {
562
554
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
563
 
      dbg("dns: PTR lookup failed horribly, perhaps bad resolv.conf setting? ($eval_stat)");
 
555
      dbg("dns: PTR lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
564
556
      return undef;
565
557
    };
566
558
  }
582
574
  return if ($self->server_failed_to_respond_for_domain ($name));
583
575
 
584
576
  dbg("dns: looking up A records for '$name'");
585
 
  my @addrs = ();
 
577
  my @addrs;
586
578
 
587
579
  if (exists $self->{dnscache}->{A}->{$name}) {
588
580
    my $addrptr = $self->{dnscache}->{A}->{$name};
602
594
      1;
603
595
    } or do {
604
596
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
605
 
      dbg("dns: A lookup failed horribly, perhaps bad resolv.conf setting? ($eval_stat)");
 
597
      dbg("dns: A lookup failed horribly, perhaps bad resolv.conf setting? (%s)", $eval_stat);
606
598
      return undef;
607
599
    };
608
600
  }
609
601
 
610
 
  dbg("dns: A records for '$name': ".join (' ', @addrs));
 
602
  dbg("dns: A records for '$name': " . join(' ',@addrs));
611
603
  return @addrs;
612
604
}
613
605
 
680
672
    my $servers=$1;
681
673
    dbg("dns: servers: $servers");
682
674
    @domains = split (/\s+/, $servers);
683
 
    dbg("dns: looking up NS records for user specified servers: ".join(", ", @domains));
 
675
    dbg("dns: looking up NS records for user specified servers: " .
 
676
        join(", ", @domains));
684
677
  } else {
685
678
    @domains = @EXISTING_DOMAINS;
686
679
  }
687
680
 
688
 
  # Net::DNS::Resolver scans a list of nameservers when it does a foreground query
689
 
  # but only uses the first in a background query like we use.
690
 
  # Try the different nameservers here in case the first one is not woorking
 
681
  # Net::DNS::Resolver scans a list of nameservers when it does a foreground
 
682
  # query but only uses the first in a background query like we use.
 
683
  # Try the different nameservers here in case the first one is not working
691
684
 
692
685
  my @good_nameservers = ();
693
 
  dbg("dns: testing resolver nameservers: ".join(", ", @nameservers));
 
686
  dbg("dns: testing resolver nameservers: " . join(", ", @nameservers));
694
687
  my $ns;
695
688
  while( $ns  = shift(@nameservers)) {
696
689
    for(my $retry = 3; $retry > 0 and $#domains>-1; $retry--) {
699
692
      my $result = $self->lookup_ns($domain);
700
693
      if(defined $result) {
701
694
        if (scalar @$result > 0) {
702
 
          dbg("dns: NS lookup of $domain using $ns succeeded => DNS available (set dns_available to override)");
 
695
          dbg("dns: NS lookup of $domain using $ns succeeded => DNS available".
 
696
              " (set dns_available to override)");
703
697
          $IS_DNS_AVAILABLE = 1;
704
698
          push(@good_nameservers, $ns);
705
699
          last;
710
704
        }
711
705
      }
712
706
      else {
713
 
        dbg("dns: NS lookup of $domain using $ns failed horribly, may not be a valid nameserver");
 
707
        dbg("dns: NS lookup of $domain using $ns failed horribly, ".
 
708
            "may not be a valid nameserver");
714
709
        $IS_DNS_AVAILABLE = 0; # should already be 0, but let's be sure.
715
710
        last; 
716
711
      }
730
725
 
731
726
done:
732
727
  # jm: leaving this in!
733
 
  dbg("dns: is DNS available? $IS_DNS_AVAILABLE");
 
728
  dbg("dns: is DNS available? " . $IS_DNS_AVAILABLE);
734
729
  return $IS_DNS_AVAILABLE;
735
730
}
736
731
 
821
816
 
822
817
sub register_async_rule_start {
823
818
  my ($self, $rule) = @_;
824
 
  dbg ("dns: $rule lookup start");
 
819
  dbg("dns: $rule lookup start");
825
820
  $self->{rule_to_rblkey}->{$rule} = '*ASYNC_START';
826
821
}
827
822
 
828
823
sub register_async_rule_finish {
829
824
  my ($self, $rule) = @_;
830
 
  dbg ("dns: $rule lookup finished");
 
825
  dbg("dns: $rule lookup finished");
831
826
  delete $self->{rule_to_rblkey}->{$rule};
832
827
}
833
828