#!/usr/bin/perl

# Copyright (C) 2001, 2002, 2003, 2004  Simon Josefsson
#
# This file 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.1 of the License, or (at your option) any later version.
#
# This file is distributed in the hope that it will be enlightening,
# 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 this file; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# $Id: walker,v 1.25 2004/06/03 20:21:54 jas Exp $

=head1 NAME

walker - Retrieve a DNS zone using NXT/NSEC traversal

=head1 SYNOPSIS

B<walker> S<[-y]> S<[-n]> S<[-d]> 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/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 -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 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 -d

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

=item B<@>I<nameserver>

Query I<nameserver> instead of the default nameserver.

=item zone

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

=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 $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);
$res->debug(1) if $debug;
$res->recurse(0) if $norecursivens;
my $rr;
my $keyrr;
my $sigrr;
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.25 2004/06/03 20:21:54 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;

# Get KEY for zone.
if ($verify)
{
    $query = $res->query($firstdname, "DNSKEY");
    if (defined($query) and ($query->header->ancount > 0) and
	($keyrr = ($query->answer)[0]) and ($keyrr->type eq "DNSKEY")) {
	$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)
	    and ($keyrr = ($query->answer)[0]) and ($keyrr->type eq "KEY");
	$keyrrtype = "KEY";
    }
    print "\t;; Using key RR type: $keyrrtype\n";
    print "\t;; Key used to verify signatures:\n";
    $_ = $keyrr->string;
    s/^/\t;; /;
    s/\n/\n\t;; /g;
    print $_, "\n";
    print "\n";
}

# 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";

# 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 "\t;; First SOA:\n";
print $rr->string, "\n";

# Walk the chain.
my $curdname = $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 $rr->string, "\n";

    my $type;
    foreach $type (split(' ',$rr->typelist)) {
	next if $type eq $nextrrtype;
	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";

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

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