#!/usr/bin/env perl

=head1 NAME

B<zonewalk> - recursive DNS zone walk

=head1 SYNOPSIS

B<zonewalk> [-d] [-l] [-4] [-6] [-s server] B<zone> 

=head1 DESCRIPTION

This script walks the given zone recursively and prints all the DWIM resource records.

As a convenience, if you specify an ip address as startzone the reverse zone is fetched, e.g.

  134.60         does the zonewalk for 60.134.in-addr.arpa
  2001:07c0:0900 does the zonewalk for 0.0.9.0.0.c.7.0.1.0.0.2.ip6.arpa

The server option is optional. If you don't specify the server, default servers are used, as defined by the resolver config file.

Keep in mind that the server must be authoritative for the zones and the client must be allowed to fetch the zones from the authoritative server via AXFR.

=head1 OPTIONS

=over 4

=item B<-d>

  Enable debug messages

=item B<-4>

  Print A records, no AAAA records

=item B<-6>

  Print AAAA records, no A records

=item B<-l>

  Long zone listing, print all resource records instead of DWIM

=item B<-s server>

  DNS server for zone transfers, must be authoritative or authorized

=back

=head1 ARGUMENTS

Define the DNS start zone.

=head1 LIMITATIONS

If IPv6 addresses are given, abbreviated forms are not allowed, .e.g.

  2001:07c0:0900     allowed
  2001:7c0:900   not allowed

=cut

package main;

use strict;
use warnings;
use feature qw(switch);

use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use Net::DNS qw();
use App::DNS::Zonewalk qw();

our $VERSION = '0.1';

our $debug;
our $v4;
our $v6;
our $long_listing;
our $server;
our $start_zone;

# make this script testable
if (caller) {
  return 1;
}
else {
  handle_options();
  my $rec_zone_listing = run_raxfr($start_zone);
  print_rec_zone($rec_zone_listing);
  exit;
}

###############################################################
#                         end of main
###############################################################

sub handle_options {

  my $memory = '';
  open( MEMORY, '>>', \$memory )
    or die "Cannot open memory file: $!,";

  my $options_result;
  {

    # bloody GetOptions, hardcoded errors to STDERR
    local *STDERR = *MEMORY;

    $options_result = GetOptions(
      'debug|d'    => \$debug,
      '4'          => \$v4,
      '6'          => \$v6,
      'long|l'     => \$long_listing,
      'server|s=s' => \$server,
    );
  }

  unless ($options_result) {
    pod2usage( -exitval => 'NOEXIT', -verbose => 1, -output => \*MEMORY );
    die "$memory\n";
  }

  # get the zone from cmdline
  $start_zone = lc shift @ARGV;
  unless ($start_zone) {
    pod2usage( -exitval => 'NOEXIT', -verbose => 1, -output => \*MEMORY );
    die "missing zone\n$memory\n";
  }

  if ( Net::DNS::Resolver::Base::_ip_is_ipv4($start_zone) ) {
    my @octets = split( /\./, $start_zone );
    $start_zone = join( '.', reverse @octets );
    $start_zone .= '.in-addr.arpa';
  }
  elsif ( Net::DNS::Resolver::Base::_ip_is_ipv6($start_zone) ) {

    # this simple algo works only for fully expanded IPv6 addresses
    $start_zone =~ s/://g;
    my @octets = split( //, $start_zone );
    $start_zone = join( '.', reverse @octets );
    $start_zone .= '.ip6.arpa';
  }

  return 1;

}

# return an array-ref of Net::DNS::RR objects for zone walk
sub run_raxfr {
  my $zone = shift;

  my $resolver = Net::DNS::Resolver->new(
    retrans     => 1,
    retry       => 1,
    tcp_timeout => 3,
    debug       => $debug,
    $server ? ( nameservers => [$server] ) : (),
  );

  my $rec_zone_listing = $resolver->raxfr($zone);
  unless (@$rec_zone_listing) {
    warn "Cannot fetch '$zone': ", $resolver->errorstring, "\n";
    exit 1;
  }

  return $rec_zone_listing;
}

sub print_rec_zone {
  my ($zone) = @_;

  foreach my $rr (@$zone) {

    if ($long_listing) {
      $rr->print;
      next;
    }

    # was this a reverse_zone walk, just print the PTR records
    if ( $start_zone =~ m/ .* \.in-addr\.arpa $ | .* \.ip6\.arpa $/ix ) {
      printf "%-30s\t%s\n", $rr->name, $rr->ptrdname
        if $rr->type eq 'PTR';
      next;
    }

    given ( $rr->type ) {

      when ('A') {
        printf "%-15s %s\n", $rr->address, $rr->name unless $v6;
      }

      when ('AAAA') {
        printf "%-40s %s\n", $rr->address, $rr->name unless $v4;

      }
    }

  }
}

=head1 AUTHOR

Karl Gaissmaier, C<< <gaissmai(at)cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-app-dns-zonewalk at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-DNS-Zonewalk>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-DNS-Zonewalk>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/App-DNS-Zonewalk>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/App-DNS-Zonewalk>

=item * Search CPAN

L<http://search.cpan.org/dist/App-DNS-Zonewalk/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Karl Gaissmaier.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

# vim: sw=2 ft=perl
