1package Net::DNS::Resolver::Recurse;
2#
3# $Id: Recurse.pm 591 2006-05-22 21:32:38Z olaf $
4#
5use strict;
6use Net::DNS::Resolver;
7
8use vars qw($VERSION @ISA);
9
10$VERSION = (qw$LastChangedRevision: 591 $)[1];
11@ISA = qw(Net::DNS::Resolver);
12
13sub hints {
14  my $self = shift;
15  my @hints = @_;
16  print ";; hints(@hints)\n" if $self->{'debug'};
17  if (!@hints && $self->nameservers) {
18    $self->hints($self->nameservers);
19  } else {
20    $self->nameservers(@hints);
21  }
22
23  print ";; verifying (root) zone...\n" if $self->{'debug'};
24  # bind always asks one of the hint servers
25  # for who it thinks is authoritative for
26  # the (root) zone as a sanity check.
27  # Nice idea.
28
29  $self->recurse(1);
30  my $packet=$self->query(".", "NS", "IN");
31  $self->recurse(0);
32  my %hints = ();
33  if ($packet) {
34    if (my @ans = $packet->answer) {
35      foreach my $rr (@ans) {
36        if ($rr->name =~ /^\.?$/ and
37            $rr->type eq "NS") {
38          # Found root authority
39          my $server = lc $rr->rdatastr;
40          $server =~ s/\.$//;
41          print ";; FOUND HINT: $server\n" if $self->{'debug'};
42          $hints{$server} = [];
43        }
44      }
45      foreach my $rr ($packet->additional) {
46	print ";; ADDITIONAL: ",$rr->string,"\n" if $self->{'debug'};
47	if (my $server = lc $rr->name){
48	  if ( $rr->type eq "A") {
49	    #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
50	    if ($hints{$server}) {
51	      print ";; STORING IP: $server IN A ",$rr->rdatastr,"\n" if $self->{'debug'};
52	      push @{ $hints{$server} }, $rr->rdatastr;
53	    }
54	  }
55	  if ( $rr->type eq "AAAA") {
56	    #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
57	    if ($hints{$server}) {
58	      print ";; STORING IP6: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'};
59	      push @{ $hints{$server} }, $rr->rdatastr;
60	    }
61	  }
62
63	}
64      }
65    }
66    foreach my $server (keys %hints) {
67      if (!@{ $hints{$server} }) {
68	# Wipe the servers without lookups
69	delete $hints{$server};
70      }
71    }
72    $self->{'hints'} = \%hints;
73  } else {
74    $self->{'hints'} = {};
75  }
76  if (%{ $self->{'hints'} }) {
77    if ($self->{'debug'}) {
78      print ";; USING THE FOLLOWING HINT IPS:\n";
79      foreach my $ips (values %{ $self->{'hints'} }) {
80	foreach my $server (@{ $ips }) {
81	  print ";;  $server\n";
82	}
83      }
84    }
85  } else {
86    warn "Server [".($self->nameservers)[0]."] did not give answers";
87  }
88
89  # Disable recursion flag.
90
91
92  return $self->nameservers( map { @{ $_ } } values %{ $self->{'hints'} } );
93}
94
95
96sub recursion_callback {
97	my ($self, $sub) = @_;
98
99	if ($sub && UNIVERSAL::isa($sub, 'CODE')) {
100		$self->{'callback'} = $sub;
101	}
102
103	return $self->{'callback'};
104}
105
106
107# $res->query_dorecursion( args );
108# Takes same args as Net::DNS::Resolver->query
109# Purpose: Do that "hot pototo dance" on args.
110sub query_dorecursion {
111  my $self = shift;
112  my @query = @_;
113
114  # Make sure the hint servers are initialized.
115  $self->hints unless $self->{'hints'};
116  $self->recurse(0);
117  # Make sure the authority cache is clean.
118  # It is only used to store A and AAAA records of
119  # the suposedly authoritative name servers.
120  $self->{'authority_cache'} = {};
121
122  # Obtain real question Net::DNS::Packet
123  my $query_packet = $self->make_query_packet(@query);
124
125  # Seed name servers with hints
126  return $self->_dorecursion( $query_packet, ".", $self->{'hints'}, 0);
127}
128
129sub _dorecursion {
130  my $self = shift;
131  my $query_packet = shift;
132  my $known_zone = shift;
133  my $known_authorities = shift;
134  my $depth = shift;
135  my $cache = $self->{'authority_cache'};
136
137  # die "Recursion too deep, aborting..." if $depth > 255;
138  if ( $depth > 255 ) {
139      print ";; _dorecursion() Recursion too deep, aborting...\n" if
140	  $self->{'debug'};
141      $self->errorstring="Recursion to deep, abborted";
142      return undef;
143  }
144
145  $known_zone =~ s/\.*$/./;
146
147  # Get IPs from authorities
148  my @ns = ();
149  foreach my $ns (keys %{ $known_authorities }) {
150    if (scalar @{ $known_authorities->{$ns} }) {
151      $cache->{$ns} = $known_authorities->{$ns};
152      push (@ns, @{ $cache->{$ns} });
153    } elsif ($cache->{$ns}) {
154      $known_authorities->{$ns} = $cache->{$ns};
155      push (@ns, @{ $cache->{$ns} });
156    }
157  }
158
159  if (!@ns) {
160    my $found_auth = 0;
161    if ($self->{'debug'}) {
162      require Data::Dumper;
163      print ";; _dorecursion() Failed to extract nameserver IPs:\n";
164      print Data::Dumper::Dumper([$known_authorities,$cache]);
165    }
166    foreach my $ns (keys %{ $known_authorities }) {
167      if (!@{ $known_authorities->{$ns} }) {
168        print ";; _dorecursion() Manual lookup for authority [$ns]\n" if $self->{'debug'};
169
170        my $auth_packet;
171	my @ans;
172
173	# Don't query for V6 if its not there.
174	if ($Net::DNS::Resolver::Base::has_inet6 && ! $self->{force_v4}){
175	    $auth_packet =
176		$self->_dorecursion
177		($self->make_query_packet($ns,"AAAA"),  # packet
178		 ".",               # known_zone
179		 $self->{'hints'},  # known_authorities
180		 $depth+1);         # depth
181	    @ans = $auth_packet->answer if $auth_packet;
182	}
183
184	$auth_packet =
185	    $self->_dorecursion
186	    ($self->make_query_packet($ns,"A"),  # packet
187	     ".",               # known_zone
188	     $self->{'hints'},  # known_authorities
189	     $depth+1);         # depth
190
191	push (@ans,$auth_packet->answer ) if $auth_packet;
192
193        if ( @ans ) {
194          print ";; _dorecursion() Answers found for [$ns]\n" if $self->{'debug'};
195          foreach my $rr (@ans) {
196	    print ";; RR:".$rr->string."\n" if $self->{'debug'};
197            if ($rr->type eq "CNAME") {
198              # Follow CNAME
199              if (my $server = lc $rr->name) {
200                $server =~ s/\.*$/./;
201                if ($server eq $ns) {
202                  my $cname = lc $rr->rdatastr;
203                  $cname =~ s/\.*$/./;
204                  print ";; _dorecursion() Following CNAME ns [$ns] -> [$cname]\n" if $self->{'debug'};
205                  $known_authorities->{$cname} ||= [];
206                  delete $known_authorities->{$ns};
207                  next;
208                }
209              }
210            } elsif ($rr->type eq "A" ||$rr->type eq "AAAA" ) {
211              if (my $server = lc $rr->name) {
212                $server =~ s/\.*$/./;
213                if ($known_authorities->{$server}) {
214                  my $ip = $rr->rdatastr;
215                  print ";; _dorecursion() Found ns: $server IN A $ip\n" if $self->{'debug'};
216                  $cache->{$server} = $known_authorities->{$server};
217                  push (@{ $cache->{$ns} }, $ip);
218                  $found_auth++;
219                  next;
220                }
221              }
222            }
223            print ";; _dorecursion() Ignoring useless answer: ",$rr->string,"\n" if $self->{'debug'};
224          }
225        } else {
226          print ";; _dorecursion() Could not find A records for [$ns]\n" if $self->{'debug'};
227        }
228      }
229    }
230    if ($found_auth) {
231      print ";; _dorecursion() Found $found_auth new NS authorities...\n" if $self->{'debug'};
232      return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1);
233    }
234    print ";; _dorecursion() No authority information could be obtained.\n" if $self->{'debug'};
235    return undef;
236  }
237
238  # Cut the deck of IPs in a random place.
239  print ";; _dorecursion() cutting deck of (".scalar(@ns).") authorities...\n" if $self->{'debug'};
240  splice(@ns, 0, 0, splice(@ns, int(rand @ns)));
241
242
243 LEVEL:  foreach my $levelns (@ns){
244   print ";; _dorecursion() Trying nameserver [$levelns]\n" if $self->{'debug'};
245   $self->nameservers($levelns);
246
247   if (my $packet = $self->send( $query_packet )) {
248
249     if ($self->{'callback'}) {
250       $self->{'callback'}->($packet);
251     }
252
253     my $of = undef;
254     print ";; _dorecursion() Response received from [",$self->answerfrom,"]\n" if $self->{'debug'};
255     if (my $status = $packet->header->rcode) {
256       if ($status eq "NXDOMAIN") {
257	 # I guess NXDOMAIN is the best we'll ever get
258	 print ";; _dorecursion() returning NXDOMAIN\n" if $self->{'debug'};
259	 return $packet;
260       } elsif (my @ans = $packet->answer) {
261	 print ";; _dorecursion() Answers were found.\n" if $self->{'debug'};
262	 return $packet;
263       } elsif (my @authority = $packet->authority) {
264	 my %auth = ();
265	 foreach my $rr (@authority) {
266	   if ($rr->type =~ /^(NS|SOA)$/) {
267	     my $server = lc ($1 eq "NS" ? $rr->nsdname : $rr->mname);
268	     $server =~ s/\.*$/./;
269	     $of = lc $rr->name;
270	     $of =~ s/\.*$/./;
271	     print ";; _dorecursion() Received authority [$of] [",$rr->type(),"] [$server]\n" if $self->{'debug'};
272	     if (length $of <= length $known_zone) {
273	       print ";; _dorecursion() Deadbeat name server did not provide new information.\n" if $self->{'debug'};
274	       next LEVEL;
275	     } elsif ($of =~ /$known_zone$/) {
276	       print ";; _dorecursion() FOUND closer authority for [$of] at [$server].\n" if $self->{'debug'};
277	       $auth{$server} ||= [];
278	     } else {
279	       print ";; _dorecursion() Confused name server [",$self->answerfrom,"] thinks [$of] is closer than [$known_zone]?\n" if $self->{'debug'};
280	       last;
281	     }
282	   } else {
283	     print ";; _dorecursion() Ignoring NON NS entry found in authority section: ",$rr->string,"\n" if $self->{'debug'};
284	   }
285	 }
286	 foreach my $rr ($packet->additional) {
287	   if ($rr->type eq "CNAME") {
288	     # Store this CNAME into %auth too
289	     if (my $server = lc $rr->name) {
290	       $server =~ s/\.*$/./;
291	       if ($auth{$server}) {
292		 my $cname = lc $rr->rdatastr;
293		 $cname =~ s/\.*$/./;
294		 print ";; _dorecursion() FOUND CNAME authority: ",$rr->string,"\n" if $self->{'debug'};
295		 $auth{$cname} ||= [];
296		 $auth{$server} = $auth{$cname};
297		 next;
298	       }
299	     }
300	   } elsif ($rr->type eq "A" || $rr->type eq "AAAA") {
301	     if (my $server = lc $rr->name) {
302	       $server =~ s/\.*$/./;
303	       if ($auth{$server}) {
304		 print ";; _dorecursion() STORING: $server IN A    ",$rr->rdatastr,"\n" if $self->{'debug'} &&  $rr->type eq "A";
305		 print ";; _dorecursion() STORING: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'}&&  $rr->type eq "AAAA";
306		 push @{ $auth{$server} }, $rr->rdatastr;
307		 next;
308	       }
309	     }
310	   }
311	   print ";; _dorecursion() Ignoring useless: ",$rr->string,"\n" if $self->{'debug'};
312	 }
313	 if ($of =~ /$known_zone$/) {
314	   return $self->_dorecursion( $query_packet, $of, \%auth, $depth+1 );
315	 } else {
316	   return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1 );
317	 }
318      }
319     }
320   }
321 }
322
323  return undef;
324}
325
3261;
327
328__END__
329
330
331=head1 NAME
332
333Net::DNS::Resolver::Recurse - Perform recursive dns lookups
334
335=head1 SYNOPSIS
336
337  use Net::DNS::Resolver::Recurse;
338  my $res = Net::DNS::Resolver::Recurse->new;
339
340=head1 DESCRIPTION
341
342This module is a sub class of Net::DNS::Resolver. So the methods for
343Net::DNS::Resolver still work for this module as well.  There are just a
344couple methods added:
345
346=head2 hints
347
348Initialize the hint servers.  Recursive queries need a starting name
349server to work off of. This method takes a list of IP addresses to use
350as the starting servers.  These name servers should be authoritative for
351the root (.) zone.
352
353  $res->hints(@ips);
354
355If no hints are passed, the default nameserver is asked for the hints.
356Normally these IPs can be obtained from the following location:
357
358  ftp://ftp.internic.net/domain/named.root
359
360=head2 recursion_callback
361
362This method is takes a code reference, which is then invoked each time a
363packet is received during the recursive lookup.  For example to emulate
364dig's C<+trace> function:
365
366 $res->recursion_callback(sub {
367     my $packet = shift;
368
369     $_->print for $packet->additional;
370
371     printf(";; Received %d bytes from %s\n\n",
372         $packet->answersize,
373         $packet->answerfrom
374     );
375 });
376
377=head2 query_dorecursion
378
379This method is much like the normal query() method except it disables
380the recurse flag in the packet and explicitly performs the recursion.
381
382  $packet = $res->query_dorecursion( "www.netscape.com.", "A");
383
384
385=head1 IPv6 transport
386
387If the appropriate IPv6 libraries are installed the recursive resolver
388will randomly choose between IPv6 and IPv4 addresses of the
389nameservers it encounters during recursion.
390
391If you want to force IPv4 transport use the force_v4() method. Also see
392the IPv6 transport notes in the Net::DNS::Resolver documentation.
393
394=head1 AUTHOR
395
396Rob Brown, bbb@cpan.org
397
398=head1 SEE ALSO
399
400L<Net::DNS::Resolver>,
401
402=head1 COPYRIGHT
403
404Copyright (c) 2002, Rob Brown.  All rights reserved.
405Portions Copyright (c) 2005, Olaf M Kolkman.
406
407This module is free software; you can redistribute
408it and/or modify it under the same terms as Perl itself.
409
410$Id: Recurse.pm 591 2006-05-22 21:32:38Z olaf $
411
412=cut
413
414Example lookup process:
415
416[root@box root]# dig +trace www.rob.com.au.
417
418; <<>> DiG 9.2.0 <<>> +trace www.rob.com.au.
419;; global options:  printcmd
420.                       507343  IN      NS      C.ROOT-SERVERS.NET.
421.                       507343  IN      NS      D.ROOT-SERVERS.NET.
422.                       507343  IN      NS      E.ROOT-SERVERS.NET.
423.                       507343  IN      NS      F.ROOT-SERVERS.NET.
424.                       507343  IN      NS      G.ROOT-SERVERS.NET.
425.                       507343  IN      NS      H.ROOT-SERVERS.NET.
426.                       507343  IN      NS      I.ROOT-SERVERS.NET.
427.                       507343  IN      NS      J.ROOT-SERVERS.NET.
428.                       507343  IN      NS      K.ROOT-SERVERS.NET.
429.                       507343  IN      NS      L.ROOT-SERVERS.NET.
430.                       507343  IN      NS      M.ROOT-SERVERS.NET.
431.                       507343  IN      NS      A.ROOT-SERVERS.NET.
432.                       507343  IN      NS      B.ROOT-SERVERS.NET.
433;; Received 436 bytes from 127.0.0.1#53(127.0.0.1) in 9 ms
434  ;;; But these should be hard coded as the hints
435
436  ;;; Ask H.ROOT-SERVERS.NET gave:
437au.                     172800  IN      NS      NS2.BERKELEY.EDU.
438au.                     172800  IN      NS      NS1.BERKELEY.EDU.
439au.                     172800  IN      NS      NS.UU.NET.
440au.                     172800  IN      NS      BOX2.AUNIC.NET.
441au.                     172800  IN      NS      SEC1.APNIC.NET.
442au.                     172800  IN      NS      SEC3.APNIC.NET.
443;; Received 300 bytes from 128.63.2.53#53(H.ROOT-SERVERS.NET) in 322 ms
444  ;;; A little closer than before
445
446  ;;; Ask NS2.BERKELEY.EDU gave:
447com.au.                 259200  IN      NS      ns4.ausregistry.net.
448com.au.                 259200  IN      NS      dns1.telstra.net.
449com.au.                 259200  IN      NS      au2ld.CSIRO.au.
450com.au.                 259200  IN      NS      audns01.syd.optus.net.
451com.au.                 259200  IN      NS      ns.ripe.net.
452com.au.                 259200  IN      NS      ns1.ausregistry.net.
453com.au.                 259200  IN      NS      ns2.ausregistry.net.
454com.au.                 259200  IN      NS      ns3.ausregistry.net.
455com.au.                 259200  IN      NS      ns3.melbourneit.com.
456;; Received 387 bytes from 128.32.206.12#53(NS2.BERKELEY.EDU) in 10312 ms
457  ;;; A little closer than before
458
459  ;;; Ask ns4.ausregistry.net gave:
460com.au.                 259200  IN      NS      ns1.ausregistry.net.
461com.au.                 259200  IN      NS      ns2.ausregistry.net.
462com.au.                 259200  IN      NS      ns3.ausregistry.net.
463com.au.                 259200  IN      NS      ns4.ausregistry.net.
464com.au.                 259200  IN      NS      ns3.melbourneit.com.
465com.au.                 259200  IN      NS      dns1.telstra.net.
466com.au.                 259200  IN      NS      au2ld.CSIRO.au.
467com.au.                 259200  IN      NS      ns.ripe.net.
468com.au.                 259200  IN      NS      audns01.syd.optus.net.
469;; Received 259 bytes from 137.39.1.3#53(ns4.ausregistry.net) in 606 ms
470  ;;; Uh... yeah... I already knew this
471  ;;; from what NS2.BERKELEY.EDU told me.
472  ;;; ns4.ausregistry.net must have brain damage
473
474  ;;; Ask ns1.ausregistry.net gave:
475rob.com.au.             86400   IN      NS      sy-dns02.tmns.net.au.
476rob.com.au.             86400   IN      NS      sy-dns01.tmns.net.au.
477;; Received 87 bytes from 203.18.56.41#53(ns1.ausregistry.net) in 372 ms
478  ;;; Ah, much better.  Something more useful.
479
480  ;;; Ask sy-dns02.tmns.net.au gave:
481www.rob.com.au.         7200    IN      A       139.134.5.123
482rob.com.au.             7200    IN      NS      sy-dns01.tmns.net.au.
483rob.com.au.             7200    IN      NS      sy-dns02.tmns.net.au.
484;; Received 135 bytes from 139.134.2.18#53(sy-dns02.tmns.net.au) in 525 ms
485  ;;; FINALLY, THE ANSWER!
486