#!/usr/bin/perl

# Copyright (C) 2001, 2002, 2003, 2004, 2005  Simon Josefsson
#
# Walker is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# Walker is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Walker; see the file COPYING.  If not, write to the Free
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA.

# $Id: walker,v 1.31 2005/09/20 10:16:30 jas Exp $

=head1 NAME

walker - Retrieve a DNS zone using NXT/NSEC traversal

=head1 SYNOPSIS

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

=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/NSEC 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 S<-y>

Additionally perform verification on each RRset within the zone and
print result of verification (in a zone file comment).  This also turn
on EDNS.0 and set the DNSSEC flag in queries.

=item S<-n>

When querying for records, ask the nameserver non-recursively, instead
of going through the full resolver logic.  This parameter is 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 original motivation for the -n parameter was to improve speed when
asking parents for NS records on delegated zones, which would make the
server recursively ask the child servers.

=item S<-d>

Enable debugging in the resolver (this will print all DNS packets,
just like dig).

=item S<-x>

Enable the EDNS.0 DNSSEC flag for SIG/RRSIG queries.  Not effective if
S<-y> is used.  This is needed for some servers to return SIG/RRSIG at
all.

=item B<@>I<nameserver>

Query I<nameserver> instead of the default nameserver.

=item I<zone>

Name of the zone to retrieve master file for.  For example, "com".

=item I<startname>

Optional name to start the zone walk at.  The default is to start
walking from the start.  This option is useful if the tool failed or
was intterupted in the middle of a large zone.

=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] [-d] [ \@nameserver ] zone\n"
    unless (@ARGV >= 1) && (@ARGV <= 5);

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

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

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

print ";; Walker by Simon Josefsson\n";
print ';; $Id: walker,v 1.31 2005/09/20 10:16:30 jas Exp $' . "\n";
print ";; Net::DNS $Net::DNS::VERSION\n";
print ";; Net::DNS::SEC $Net::DNS::SEC::VERSION\n";
print "\n";

# Canonicalize zone name.
$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");
my $firstdname = $rr->name . ".";

# Figure out if we should do KEY or DNSKEY.
my $keyrrtype;
if ($verify)
{
    $query = $res->query($firstdname, "DNSKEY");
    if (defined($query) and ($query->header->ancount > 0)) {
	$keyrrtype = "DNSKEY";
    } else {
	$query = $res->query($firstdname, "KEY");
	die "No DNSKEY or KEY for $firstdname: ", $res->errorstring, "\n"
	    unless defined($query) and ($query->header->ancount > 0);
	$keyrrtype = "KEY";
    }
    my $key;
    foreach $key ($query->answer) {
	$keyrr{$key->keytag} = $key if $key->type eq $keyrrtype;
    }
    print "\t;; Using key RR type: $keyrrtype\n";
    print "\t;; Key(s) used to verify signatures:\n";
    foreach $key (keys %keyrr) {
	$_ = $keyrr{$key}->string;
	s/^/\t;; /;
	s/\n/\n\t;; /g;
	print $_, "\n";
	print "\n";
    } %keyrr;

}

# Figure out if we should do NSEC or NXT.
my $nextrrtype;
$query = $res->query($firstdname, "NSEC");
if (defined($query) and ($query->header->ancount > 0)
    and ($rr = ($query->answer)[0]) and ($rr->type eq "NSEC")) {
    $nextrrtype = "NSEC";
} else {
    $query = $res->query($firstdname, "NXT");
    die "Can't find neither NXT nor NSEC for $firstdname: ",
    $res->errorstring, "\n" unless defined($query) and
	($query->header->ancount > 0)
	and ($rr = ($query->answer)[0]) and ($rr->type eq "NXT");
    $nextrrtype = "NXT";
}

print "\t;; Using next RR type: $nextrrtype\n";

# Figure out if we should do RRSIG or SIG.
my $sigrrtype;
$query = $res->query($firstdname, "RRSIG");
if (defined($query) and ($query->header->ancount > 0)
    and ($rr = ($query->answer)[0]) and ($rr->type eq "RRSIG")) {
    $sigrrtype = "RRSIG";
} else {
    $query = $res->query($firstdname, "SIG");
    die "Can't find neither RRSIG nor SIG for $firstdname: ",
    $res->errorstring, "\n" unless defined($query) and
	($query->header->ancount > 0)
	and ($rr = ($query->answer)[0]) and ($rr->type eq "SIG");
    $sigrrtype = "SIG";
}

print "\t;; Using signature RR type: $sigrrtype\n";

# Canonicalize start name.
if ($startname) {
    $query = $res->query($startname, $nextrrtype);
    die "No $nextrrtype for $startname: ", $res->errorstring, "\n"
	unless defined($query) and ($query->header->ancount > 0)
	and ($rr = ($query->answer)[0]) and ($rr->type eq $nextrrtype);
    $startname = $rr->name . ".";
}

# Print first SOA.
if (!$startname) {
    $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");
    print "\t;; First SOA:\n";
    print $rr->string, "\n";
}

# Walk the chain.
my $curdname = $startname ? $startname : $firstdname;

do {
    print "\n\t;; Getting NXT/NSEC for $curdname\n";
    print "\t;; ", scalar localtime, "\n";

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

    my $type;
    foreach $type (split(' ',$rr->typelist)) {
	next if $verify && $type eq $sigrrtype;
	next if ($curdname eq $firstdname) and ($type eq "SOA");

	print "\t;; Looking at type $type for domain $curdname\n";

	$res->dnssec(1) if ($needdnssecforsig && !$verify &&
			    $type eq $sigrrtype);

	$query = $res->send($curdname, $type);
	if (!$query) {
	    print ";; Query for RR $curdname $type failed:",
	    $res->errorstring, "\n";
	    next;
	}

	$res->dnssec(0) if ($needdnssecforsig && !$verify &&
			    $type eq $sigrrtype);

	my %sigrr;
	my @answer;
	foreach $rr ($query->answer, $query->authority) {
	    if ($rr->name . "." eq $curdname &&
		$rr->type eq $sigrrtype &&
		$rr->typecovered eq $type)
	    {
		$sigrr{$rr->keytag} = $rr;
	    }
	    elsif ($rr->name . "." eq $curdname && $rr->type eq $type)
	    {
		push @answer, $rr;
	    }
	    else
	    {
		next;
	    }
	    $rr->print
	}
	if ($verify) {
	    if (%sigrr) {
		my $tag;
		foreach $tag (keys %sigrr) {
		    if ($sigrr{$tag}->verify(\@answer,
					     $keyrr{$sigrr{$tag}->keytag})) {
			print "\t;; verify ok (key ", $sigrr{$tag}->keytag,
			")\n";
		    } else {
			print "\t;; verify failure (key ", $sigrr{$tag}->keytag,
			"): ", $sigrr{$tag}->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");
print "\n\t;; Last SOA:\n";
$rr->print;