#!/usr/bin/perl
# $Id: walker,v 1.8 2003/02/18 21:19:11 jas Exp $

=head1 NAME

walker - Retrieve a DNS zone using NXT traversal

=head1 SYNOPSIS

B<walker> S<[-y]> S<[-n]> S<[ B<@>I<nameserver> ]> I<zone>

=head1 DESCRIPTION

B<walker> retrieves a DNS zone from the default or supplied name
server and prints each record to the standard output.  AXFR is not
used, instead the DNSSEC NXT record chain is traversed.  The zone must
use DNSSEC.  The output should conform to the standard DNS master file
format (but see B<BUGS>).  Optionally, B<walker> can also verify
DNSSEC signatures on the RRsets within the zone.

=head1 OPTIONS

=over 4

=item B<@>I<nameserver>

Query I<nameserver> instead of the default nameserver.

=item -y

Additionally perform verification on each RRset within the zone and
print result of verification (in a zone file comment).

=item -n

When querying for NS records, ask the nameserver non-recursively and
print the NS records from the authority section, instead of going
through the full resolver logic.  It is only useful when you know that
the default name server (or the supplied specific nameserver) can
respond correctly, which it typically only would if it is responsible
for the zone.  The reason for this parameter is to improve speed when
used against an authorative server that would otherwise recursively
ask child servers for NS records.

=back

=head1 AUTHOR

Simon Josefsson <simon@josefsson.org>

=head1 BUGS

CNAME, CERT and/or SRV RRs is known to cause perl warnings during
verifications with some versions of Net::DNS and Net::DNS::SEC.  The
cause is belived to be in Perl, Net::DNS or Net::DNS::SEC.  The reader
is encouraged to track down and fix these bugs.

=head1 SEE ALSO

L<perl(1)>, L<axfr>, L<perldig>, L<Net::DNS>, L<Net::DNS::SEC>, L<resolv.conf>

=cut

use strict;
use File::Basename;
use Net::DNS;

die "Usage: ", basename($0), " [-y] [-n] [ \@nameserver ] zone\n"
    unless (@ARGV >= 1) && (@ARGV <= 4);

my $verify = $ARGV[0] =~ /-y/ ? shift @ARGV : 0;
my $norecursivens = $ARGV[0] =~ /-n/ ? shift @ARGV : 0;
my $nameserver = ($ARGV[0] =~ /^@/) ? shift @ARGV : "";
$nameserver =~ s/^@//;

my $domain = $ARGV[0];
my $res = Net::DNS::Resolver->new;
$res->nameservers($nameserver) if $nameserver;
$res->dnssec(1) if ($verify);
my $rr;
my $keyrr;
my $sigrr;
my $query;

# Don't add /etc/resolv.conf search, thanks to Miek Gieben.
$res->defnames(0);

# Print first SOA
$query = $res->query($domain, "SOA");
die "No SOA for $domain: ", $res->errorstring, "\n"
    unless defined($query) and ($query->header->ancount > 0)
    and ($rr = ($query->answer)[0]) and ($rr->type eq "SOA");
print $rr->string, "\n";

my $firstdname = $rr->name;

# Get KEY for zone
if ($verify) {
    $query = $res->query($firstdname . ".", "KEY");
    die "No KEY for $firstdname: ", $res->errorstring, "\n"
	unless defined($query) and ($query->header->ancount > 0)
	and ($keyrr = ($query->answer)[0]) and ($keyrr->type eq "KEY");
    print "\t;; Key used to verify signatures:\n";
    $_ = $keyrr->string;
    s/^/\t;; /;
    s/\n/\n\t;; /g;
    print $_, "\n";
}


# Walk the chain
my $curdname = $firstdname;

do {
    print "\t;; Getting NXT for $curdname\n";
    $query = $res->query($curdname . ".", "NXT");
    die "No NXT for $curdname: ", $res->errorstring, "\n"
	unless defined($query) and ($query->header->ancount > 0)
	    and ($rr = ($query->answer)[0]) and ($rr->type eq "NXT");
    print $rr->string, "\n";

    my $type;
    foreach $type (split(' ',$rr->typelist)) {
	next if $verify && $type eq "SIG";
	print "\t;; Looking at type $type for domain $curdname\n";
	if ($norecursivens && $type eq "NS") {
	  # Optimization suggested by Miek Gieben.
	  my $tmpres = $res;
	  $tmpres->recurse(0);
	  $query = $tmpres->send($curdname . ".", $type);
	  foreach $rr ($query->authority) {
	    $rr->print;
	  }
	  next;
	}
	$query = $res->query($curdname . ".", $type);
	if (!$query) {
	    print ";; No such RR: $curdname $type\n";
	    next;
	}
	$sigrr = "";
	my @answer;
	foreach $rr ($query->answer) {
	    $rr->print unless
		($rr->name eq $firstdname) and  ($rr->type eq "SOA");
	    if ($rr->type eq "SIG") {
		$sigrr=$rr;
	    } else {
		push @answer, $rr;
	    }
	}
	if ($verify) {
	  if ($sigrr) {
		if ($sigrr->verify(\@answer, $keyrr)) {
		    print "\t;; verify ok\n";
		} else {
		    print "\t;; verify failure: ", $sigrr->vrfyerrstr, "\n";
		}
	    } else {
		print "\t;; no signature found\n";
	    }
	}
    }

    $curdname = $rr->nxtdname;
} while ($curdname ne $firstdname);

# Print last SOA
$query = $res->query($firstdname . ".", "SOA");
die "No SOA for $firstdname: ", $res->errorstring, "\n"
    unless defined($query) and ($query->header->ancount > 0)
    and ($rr = ($query->answer)[0]) and ($rr->type eq "SOA");
$rr->print;
