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