1package Net::Nslookup;
2
3# -------------------------------------------------------------------
4# Net::Nslookup - Provide nslookup(1)-like capabilities
5# Copyright (C) 2002-2013 darren chamberlain <darren@cpan.org>
6#
7# This program is free software; you can redistribute it and/or
8# modify it under the terms of the GNU General Public License as
9# published by the Free Software Foundation; version 2.
10#
11# This program is distributed in the hope that it will be useful, but
12# WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14# General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software
18# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19# 02111-1307  USA
20# -------------------------------------------------------------------
21
22use strict;
23use vars qw($VERSION $DEBUG @EXPORT $TIMEOUT $WIN32);
24use base qw(Exporter);
25
26$VERSION    = "2.04";
27@EXPORT     = qw(nslookup);
28$DEBUG      = 0 unless defined $DEBUG;
29$TIMEOUT    = 15 unless defined $TIMEOUT;
30$WIN32      = $^O =~ /win32/i;
31
32use Exporter;
33
34my %_methods = qw(
35    A       address
36    CNAME   cname
37    MX      exchange
38    NS      nsdname
39    PTR     ptrdname
40    TXT     rdatastr
41    SOA     dummy
42    SRV     target
43);
44
45# ----------------------------------------------------------------------
46# nslookup(%args)
47#
48# Does the actual lookup, deferring to helper functions as necessary.
49# ----------------------------------------------------------------------
50sub nslookup {
51    my $options = isa($_[0], 'HASH') ? shift : @_ % 2 ? { 'host', @_ } : { @_ };
52    my ($term, $type, @answers);
53
54    # Some reasonable defaults.
55    $term = lc ($options->{'term'} ||
56                $options->{'host'} ||
57                $options->{'domain'} || return);
58    $type = uc ($options->{'type'} ||
59                $options->{'qtype'} || "A");
60    $options->{'server'} ||= '';
61    $options->{'recurse'} ||= 0;
62
63    $options->{'timeout'} = $TIMEOUT
64        unless defined $options->{'timeout'};
65
66    $options->{'debug'} = $DEBUG
67        unless defined $options->{'debug'};
68
69    eval {
70        local $SIG{ALRM} = sub { die "alarm\n" };
71        alarm $options->{'timeout'} unless $WIN32;
72
73        my $meth = $_methods{ $type } || die "Unknown type '$type'";
74        my $res = ns($options->{'server'});
75
76        if ($options->{'debug'}) {
77            warn "Performing `$type' lookup on `$term'\n";
78        }
79
80        if (my $q = $res->search($term, $type)) {
81            if ('SOA' eq $type) {
82                my $a = ($q->answer)[0];
83                @answers = (join " ", map { $a->$_ }
84                    qw(mname rname serial refresh retry expire minimum));
85            }
86            else {
87                @answers = map { $_->$meth() } grep { $_->type eq $type } $q->answer;
88            }
89
90            # If recurse option is set, for NS, MX, and CNAME requests,
91            # do an A lookup on the result.  False by default.
92            if ($options->{'recurse'}   &&
93                (('NS' eq $type)        ||
94                 ('MX' eq $type)        ||
95                 ('CNAME' eq $type)
96                )) {
97
98                @answers = map {
99                    nslookup(
100                        host    => $_,
101                        type    => "A",
102                        server  => $options->{'server'},
103                        debug   => $options->{'debug'}
104                    );
105                } @answers;
106            }
107        }
108
109        alarm 0 unless $WIN32;
110    };
111
112    if ($@) {
113        die "nslookup error: $@"
114            unless $@ eq "alarm\n";
115        warn qq{Timeout: nslookup("type" => "$type", "host" => "$term")};
116    }
117
118    return $answers[0] if (@answers == 1);
119    return (wantarray) ? @answers : $answers[0];
120}
121
122{
123    my %res;
124    sub ns {
125        my $server = shift || "";
126
127        unless (defined $res{$server}) {
128            require Net::DNS;
129            import Net::DNS;
130            $res{$server} = Net::DNS::Resolver->new;
131
132            # $server might be empty
133            if ($server) {
134                if (ref($server) eq 'ARRAY') {
135                    $res{$server}->nameservers(@$server);
136                }
137                else {
138                    $res{$server}->nameservers($server);
139                }
140            }
141        }
142
143        return $res{$server};
144    }
145}
146
147sub isa { &UNIVERSAL::isa }
148
1491;
150__END__
151
152=head1 NAME
153
154Net::Nslookup - Provide nslookup(1)-like capabilities
155
156=head1 SYNOPSIS
157
158  use Net::Nslookup;
159  my @addrs = nslookup $host;
160
161  my @mx = nslookup(type => "MX", domain => "perl.org");
162
163=head1 DESCRIPTION
164
165C<Net::Nslookup> provides the capabilities of the standard UNIX
166command line tool F<nslookup(1)>. C<Net::DNS> is a wonderful and
167full featured module, but quite often, all you need is `nslookup
168$host`.  This module provides that functionality.
169
170C<Net::Nslookup> exports a single function, called C<nslookup>.
171C<nslookup> can be used to retrieve A, PTR, CNAME, MX, NS, SOA,
172TXT, and SRV records.
173
174  my $a  = nslookup(host => "use.perl.org", type => "A");
175
176  my @mx = nslookup(domain => "perl.org", type => "MX");
177
178  my @ns = nslookup(domain => "perl.org", type => "NS");
179
180  my $name = nslookup(host => "206.33.105.41", type => "PTR");
181
182  my @srv = nslookup(term => "_jabber._tcp.gmail.com", type => "SRV");
183
184C<nslookup> takes a hash of options, one of which should be I<term>,
185and performs a DNS lookup on that term.  The type of lookup is
186determined by the I<type> argument.  If I<server> is specified (it
187should be an IP address, or a reference to an array of IP
188addresses), that server(s) will be used for lookups.
189
190If only a single argument is passed in, the type defaults to I<A>,
191that is, a normal A record lookup.
192
193If C<nslookup> is called in a list context, and there is more than
194one address, an array is returned.  If C<nslookup> is called in a
195scalar context, and there is more than one address, C<nslookup>
196returns the first address.  If there is only one address returned,
197then, naturally, it will be the only one returned, regardless of the
198calling context.
199
200I<domain> and I<host> are synonyms for I<term>, and can be used to
201make client code more readable.  For example, use I<domain> when
202getting NS records, and use I<host> for A records; both do the same
203thing.
204
205I<server> should be a single IP address or a reference to an array
206of IP addresses:
207
208  my @a = nslookup(host => 'example.com', server => '4.2.2.1');
209
210  my @a = nslookup(host => 'example.com', server => [ '4.2.2.1', '128.103.1.1' ])
211
212By default, when doing CNAME, MX, and NS lookups, C<nslookup>
213returns names, not addresses.  This is a change from versions prior
214to 2.0, which always tried to resolve names to addresses.  Pass the
215I<recurse =E<gt> 1> flag to C<nslookup> to have it follow CNAME, MX,
216and NS lookups.  Note that this usage of "recurse" is not consistent
217with the official DNS meaning of recurse.
218
219    # returns soemthing like ("mail.example.com")
220    my @mx = nslookup(domain => 'example.com', type => 'MX');
221
222    # returns soemthing like ("127.0.0.1")
223    my @mx = nslookup(domain => 'example.com', type => 'MX', recurse => 1);
224
225SOA lookups return the SOA record in the same format as the `host`
226tool:
227
228    print nslookup(domain => 'example.com', type => 'SOA');
229    dns1.icann.org. hostmaster.icann.org. 2011061433 7200 3600 1209600 3600
230
231=head1 TIMEOUTS
232
233Lookups timeout after 15 seconds by default, but this can be configured
234by passing I<timeout =E<gt> X> to C<nslookup>.
235
236=head1 DEBUGGING
237
238Pass I<debug =E<gt> 1> to C<nslookup> to emit debugging messages to STDERR.
239
240=head1 AUTHOR
241
242darren chamberlain <darren@cpan.org>
243
244