← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lib/Mail/SpamAssassin/DnsResolver.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/DnsResolver.pm
38
38
use strict;
39
39
use warnings;
40
40
use bytes;
 
41
use re 'taint';
41
42
 
42
43
use Mail::SpamAssassin;
43
44
use Mail::SpamAssassin::Logger;
45
46
use Socket;
46
47
use IO::Socket::INET;
47
48
use Errno qw(EADDRINUSE EACCES);
 
49
use Time::HiRes qw(time);
48
50
 
49
51
use constant HAS_SOCKET_INET6 => eval { require IO::Socket::INET6; };
50
52
 
51
53
our @ISA = qw();
52
54
 
53
 
# Load Time::HiRes if it's available
54
 
BEGIN {
55
 
  eval { require Time::HiRes };
56
 
  Time::HiRes->import( qw(time) ) unless $@;
57
 
}
58
 
 
59
55
###########################################################################
60
56
 
61
57
sub new {
97
93
                                         Proto     => 'udp',
98
94
                                         );
99
95
      if ($sock6) {
100
 
        $sock6->close();
 
96
        $sock6->close()  or die "error closing inet6 socket: $!";
101
97
        1;
102
98
      }
103
99
    } ||
109
105
                                         Proto     => 'udp',
110
106
                                         );
111
107
      if ($sock6) {
112
 
        $sock6->close();
 
108
        $sock6->close()  or die "error closing inet4 socket: $!";
113
109
        1;
114
110
      }
115
111
    };
134
130
      $self->{res}->persistent_udp(0);  # bug 3997
135
131
    }
136
132
    1;
137
 
  };   #  or warn "dns: eval failed: $@ $!\n";
 
133
  } or do {
 
134
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
 
135
    dbg("dns: eval failed: $eval_stat");
 
136
  };
138
137
 
139
138
  dbg("dns: no ipv6") if $force_ipv4;
140
 
  dbg("dns: is Net::DNS::Resolver available? " .
141
 
       ($self->{no_resolver} ? "no" : "yes"));
 
139
  dbg("dns: is Net::DNS::Resolver available? %s",
 
140
      $self->{no_resolver} ? "no" : "yes" );
142
141
  if (!$self->{no_resolver} && defined $Net::DNS::VERSION) {
143
 
    dbg("dns: Net::DNS version: ".$Net::DNS::VERSION);
 
142
    dbg("dns: Net::DNS version: %s", $Net::DNS::VERSION);
144
143
  }
145
144
 
146
145
  return (!$self->{no_resolver});
182
181
 
183
182
  return if $self->{no_resolver};
184
183
 
185
 
  $self->{sock}->close() if $self->{sock};
 
184
  if ($self->{sock}) {
 
185
    $self->{sock}->close()  or die "error closing socket: $!";
 
186
  }
186
187
  my $sock;
187
188
  my $errno;
188
189
 
203
204
    $srcaddr = "0.0.0.0";
204
205
  }
205
206
 
206
 
  dbg("dns: name server: $ns, LocalAddr: $srcaddr");
 
207
  dbg("dns: name server: %s, LocalAddr: %s", $ns,$srcaddr);
207
208
 
208
209
  # find next available unprivileged port (1024 - 65535)
209
210
  # starting at a random value to spread out use of ports
229
230
    if (defined $sock) {  # ok, got it
230
231
      last;
231
232
    } elsif ($! == EADDRINUSE || $! == EACCES) {  # in use, let's try another source port
232
 
      dbg("dns: UDP port $lport already in use, trying another port");
 
233
      dbg("dns: UDP port %s already in use, trying another port", $lport);
233
234
    } else {
234
 
      warn "Error creating a DNS resolver socket: $errno";
 
235
      warn "error creating a DNS resolver socket: $errno";
235
236
      goto no_sock;
236
237
    }
237
238
  }
238
239
  if (!defined $sock) {
239
 
    warn "Can't create a DNS resolver socket: $errno";
 
240
    warn "cannot create a DNS resolver socket: $errno";
240
241
    goto no_sock;
241
242
  }
242
243
 
243
244
  eval {
244
245
    my($bufsiz,$newbufsiz);
245
246
    $bufsiz = $sock->sockopt(Socket::SO_RCVBUF)
246
 
      or die "Can't get a resolver socket rx buffer size: $!";
 
247
      or die "cannot get a resolver socket rx buffer size: $!";
247
248
    if ($bufsiz >= 32*1024) {
248
249
      dbg("dns: resolver socket rx buffer size is %d bytes", $bufsiz);
249
250
    } else {
250
251
      $sock->sockopt(Socket::SO_RCVBUF, 32*1024)
251
 
        or die "Can't set a resolver socket rx buffer size: $!";
 
252
        or die "cannot set a resolver socket rx buffer size: $!";
252
253
      $newbufsiz = $sock->sockopt(Socket::SO_RCVBUF)
253
 
        or die "Can't get a resolver socket rx buffer size: $!";
 
254
        or die "cannot get a resolver socket rx buffer size: $!";
254
255
      dbg("dns: resolver socket rx buffer size changed from %d to %d bytes",
255
256
          $bufsiz, $newbufsiz);
256
257
    }
319
320
    $packet = Net::DNS::Packet->new($host, $type, $class);
320
321
 
321
322
    # a bit noisy, so commented by default...
322
 
    #dbg("dns: new DNS packet time=".time()." host=$host type=$type id=".$packet->id);
 
323
    #dbg("dns: new DNS packet time=%s host=%s type=%s id=%s",
 
324
    #    time, $host, $type, $packet->id);
323
325
    1;
324
326
  } or do {
325
327
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
334
336
# Internal function used only in this file
335
337
## compute an unique ID for a packet to match the query to the reply
336
338
## It must use only data that is returned unchanged by the nameserver.
337
 
## Argument is a Net::DNS::Packet that has a non-empty question section
338
 
## return is an object that can be used as a hash key
 
339
## Argument is a Net::DNS::Packet that has a non-empty question section,
 
340
## return is an (opaque) string that can be used as a hash key
339
341
sub _packet_id {
340
342
  my ($self, $packet) = @_;
341
343
  my $header = $packet->header;
344
346
  my $ques = $questions[0];
345
347
 
346
348
  if (defined $ques) {
347
 
    return join '/', $id, $ques->qname, $ques->qtype, $ques->qclass;
 
349
    # Bug 6232: Net::DNS::Packet::new is not consistent in keeping data in
 
350
    # sections of a packet either as original bytes or presentation-encoded:
 
351
    # creating a query packet as above in new_dns_packet() keeps label in
 
352
    # non-encoded form, yet on parsing an answer packet, its query section
 
353
    # is converted to presentation form by Net::DNS::Question::parse calling
 
354
    # Net::DNS::Packet::dn_expand and Net::DNS::wire2presentation in turn.
 
355
    # Let's undo the effect of the wire2presentation routine here to make
 
356
    # sure the query section of an answer packet matches the query section
 
357
    # in our packet formed by new_dns_packet():
 
358
    #
 
359
    my $qname = $ques->qname;
 
360
    $qname =~ s/\\([0-9]{3}|.)/length($1)==1 ? $1 : chr($1)/gse;
 
361
    return join '/', $id, $qname, $ques->qtype, $ques->qclass;
 
362
 
348
363
  } else {
349
364
    # odd.  this should not happen, but clearly some DNS servers
350
365
    # can return something that Net::DNS interprets as having no
351
366
    # question section.  Better support it; just return the
352
367
    # (safe) ID part, along with a text token indicating that
353
368
    # the packet had no question part.
 
369
    #
354
370
    return $id . "NO_QUESTION_IN_PACKET";
355
371
  }
356
372
}
396
412
    return;
397
413
  }
398
414
  my $id = $self->_packet_id($pkt);
 
415
  dbg("dns: providing a callback for id: $id");
399
416
  $self->{id_to_callback}->{$id} = $cb;
400
417
  return $id;
401
418
}
414
431
  return if $self->{no_resolver};
415
432
  return if !$self->{sock};
416
433
  my $cnt = 0;
417
 
  my $waiting_time = 0;
418
434
 
419
435
  my $rin = $self->{sock_as_vec};
420
436
  my $rout;
421
437
 
422
438
  for (;;) {
423
 
    my $now_before = time;
424
 
    my ($nfound, $timeleft) = select($rout=$rin, undef, undef, $timeout);
 
439
    my ($nfound, $timeleft);
 
440
    { my $timer;  # collects timestamp when variable goes out of scope
 
441
      if (!defined($timeout) || $timeout > 0)
 
442
        { $timer = $self->{main}->time_method("poll_dns_idle") }
 
443
      ($nfound, $timeleft) = select($rout=$rin, undef, undef, $timeout);
 
444
    }
425
445
    if (!defined $nfound || $nfound < 0) {
426
446
      warn "dns: select failed: $!";
427
447
      return;
428
448
    }
429
449
 
430
450
    my $now = time;
431
 
    if ($now > $now_before && (!defined($timeout) || $timeout > 0)) {
432
 
      $waiting_time += $now - $now_before;
433
 
    }
434
451
    $timeout = 0;  # next time around collect whatever is available, then exit
435
452
    last  if $nfound == 0;
436
453
 
459
476
    }
460
477
  }
461
478
 
462
 
  return wantarray ? ($cnt, $waiting_time) : $cnt;
 
479
  return $cnt;
463
480
}
464
481
 
465
482
###########################################################################
548
565
sub finish_socket {
549
566
  my ($self) = @_;
550
567
  if ($self->{sock}) {
551
 
    $self->{sock}->close();
 
568
    $self->{sock}->close()  or die "error closing socket: $!";
552
569
    delete $self->{sock};
553
570
  }
554
571
}