2005-07-11 21:11:11 +02:00
|
|
|
# $Id: DNS.pm,v 1.12 2005/02/14 22:06:08 msergeant Exp $
|
|
|
|
|
|
|
|
package Danga::DNS;
|
|
|
|
|
|
|
|
# This is the query class - it is really just an encapsulation of the
|
|
|
|
# hosts you want to query, plus the callback. All the hard work is done
|
|
|
|
# in Danga::DNS::Resolver.
|
|
|
|
|
2005-11-23 00:04:06 +01:00
|
|
|
use fields qw(client hosts num_hosts callback finished results start);
|
2005-07-11 21:11:11 +02:00
|
|
|
use strict;
|
|
|
|
|
|
|
|
use Danga::DNS::Resolver;
|
|
|
|
|
|
|
|
my $resolver;
|
|
|
|
|
|
|
|
sub trace {
|
|
|
|
my $level = shift;
|
|
|
|
print STDERR ("[$$] dns lookup: @_") if $::DEBUG >= $level;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub new {
|
|
|
|
my Danga::DNS $self = shift;
|
|
|
|
my %options = @_;
|
|
|
|
|
|
|
|
$resolver ||= Danga::DNS::Resolver->new();
|
|
|
|
|
|
|
|
my $client = $options{client};
|
2006-06-20 15:51:32 +02:00
|
|
|
$client->pause_read() if $client;
|
2005-07-11 21:11:11 +02:00
|
|
|
|
|
|
|
$self = fields::new($self) unless ref $self;
|
|
|
|
|
|
|
|
$self->{hosts} = $options{hosts} ? $options{hosts} : [ $options{host} ];
|
|
|
|
$self->{num_hosts} = scalar(@{$self->{hosts}}) || "No hosts supplied";
|
|
|
|
$self->{client} = $client;
|
|
|
|
$self->{callback} = $options{callback} || die "No callback given";
|
2005-11-23 00:03:05 +01:00
|
|
|
$self->{finished} = $options{finished};
|
2005-07-11 21:11:11 +02:00
|
|
|
$self->{results} = {};
|
|
|
|
$self->{start} = time;
|
|
|
|
|
|
|
|
if ($options{type}) {
|
2005-11-23 00:03:05 +01:00
|
|
|
if ( ($options{type} eq 'A') || ($options{type} eq 'PTR') ) {
|
2005-07-11 21:11:11 +02:00
|
|
|
if (!$resolver->query($self, @{$self->{hosts}})) {
|
2006-06-20 15:51:32 +02:00
|
|
|
$client->continue_read() if $client;
|
2005-07-11 21:11:11 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
2005-11-11 15:28:47 +01:00
|
|
|
if (!$resolver->query_type($self, $options{type}, @{$self->{hosts}})) {
|
2006-06-20 15:51:32 +02:00
|
|
|
$client->continue_read() if $client;
|
2005-11-11 15:28:47 +01:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
# die "Unsupported DNS query type: $options{type}";
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
if (!$resolver->query($self, @{$self->{hosts}})) {
|
2006-06-20 15:51:32 +02:00
|
|
|
$client->continue_read() if $client;
|
2005-07-11 21:11:11 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub run_callback {
|
|
|
|
my Danga::DNS $self = shift;
|
|
|
|
my ($result, $query) = @_;
|
|
|
|
$self->{results}{$query} = $result;
|
|
|
|
trace(2, "got $query => $result\n");
|
|
|
|
eval {
|
|
|
|
$self->{callback}->($result, $query);
|
|
|
|
};
|
|
|
|
if ($@) {
|
|
|
|
warn($@);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub DESTROY {
|
|
|
|
my Danga::DNS $self = shift;
|
|
|
|
my $now = time;
|
|
|
|
foreach my $host (@{$self->{hosts}}) {
|
|
|
|
if (!exists($self->{results}{$host})) {
|
|
|
|
print STDERR "DNS timeout (presumably) looking for $host after " . ($now - $self->{start}) . " secs\n";
|
|
|
|
$self->{callback}->("NXDOMAIN", $host);
|
|
|
|
}
|
|
|
|
}
|
2006-06-20 15:51:32 +02:00
|
|
|
$self->{client}->continue_read() if $self->{client};
|
2005-11-23 00:03:05 +01:00
|
|
|
if ($self->{finished}) {
|
|
|
|
$self->{finished}->();
|
|
|
|
}
|
2005-07-11 21:11:11 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
Danga::DNS - a DNS lookup class for the Danga::Socket framework
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
Danga::DNS->new(%options);
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
This module performs asynchronous DNS lookups, making use of a single UDP
|
|
|
|
socket (unlike Net::DNS's bgsend/bgread combination), and blocking reading on
|
|
|
|
a client until the response comes back (this is useful for e.g. SMTP rDNS
|
|
|
|
lookups where you want the answer before you see the next SMTP command).
|
|
|
|
|
|
|
|
Currently this module will only perform A or PTR lookups. A rDNS (PTR) lookup
|
|
|
|
will be performed if the host matches the regexp: C</^\d+\.\d+\.\d+.\d+$/>.
|
|
|
|
|
|
|
|
The lookups time out after 15 seconds.
|
|
|
|
|
|
|
|
=head1 API
|
|
|
|
|
|
|
|
=head2 C<< Danga::DNS->new( %options ) >>
|
|
|
|
|
|
|
|
Create a new DNS query. You do not need to store the resulting object as this
|
|
|
|
class is all done with callbacks.
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
Danga::DNS->new(
|
|
|
|
callback => sub { print "Got result: $_[0]\n" },
|
|
|
|
host => 'google.com',
|
|
|
|
);
|
|
|
|
|
|
|
|
=over 4
|
|
|
|
|
|
|
|
=item B<[required]> C<callback>
|
|
|
|
|
|
|
|
The callback to call when results come in. This should be a reference to a
|
|
|
|
subroutine. The callback receives two parameters - the result of the DNS lookup
|
|
|
|
and the host that was looked up.
|
|
|
|
|
|
|
|
=item C<host>
|
|
|
|
|
|
|
|
A host name to lookup. Note that if the hostname is a dotted quad of numbers then
|
|
|
|
a reverse DNS (PTR) lookup is performend.
|
|
|
|
|
|
|
|
=item C<hosts>
|
|
|
|
|
|
|
|
An array-ref list of hosts to lookup.
|
|
|
|
|
|
|
|
B<NOTE:> One of either C<host> or C<hosts> is B<required>.
|
|
|
|
|
|
|
|
=item C<client>
|
|
|
|
|
|
|
|
It is possible to specify a C<Danga::Client> object (or subclass) which you wish
|
|
|
|
to disable for reading until your DNS result returns.
|
|
|
|
|
|
|
|
=item C<type>
|
|
|
|
|
|
|
|
You can specify one of: I<"A">, I<"PTR"> or I<"TXT"> here. Other types may be
|
|
|
|
supported in the future.
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
=cut
|