#!/usr/local/bin/perl
# $Id: scavenge,v 1.2 2007/10/01 04:30:56 mdf Exp $
# dns_scavenge - find missing, mismatched & stale forward/reverse DNS record.
# (Optional) Use nmap scan a given range.
# Parse the output inline or later, classifying the following:
# 1. Missing forward addresses (A records) and reverse (PTR) records for hosts that are UP
# 2. Stale forward addresses (A records) and reverse (PTR) records for hosts that are DOWN
use Getopt::Std;
use Net::DNS;
use Net::Ping;
use strict;


# Parse command line arguments
use vars qw/ $opt_d $opt_h $opt_r $opt_f $opt_n/;
my $ok = getopts('dhr:f:n:');
if ( (!$ok) || $opt_h ) {
	print <<EOF;
Usage: scavenge [-r ip-range]|[-f zone] [-n nameserver] [-d]
  -r ip-range e.g. 192.168.0.1-255
                or 192.168.0.0/16 
	             or '192.88-90.*.*'
     This is a reverse+forward audit
  -f zone does forward+reverse audit
  -n sets a nameserver to query directly
  -d turn on debugging
  -h this help message

  Note that this command reads from STDIN unless -r or -f is used. 
  The reverse input format should be the greppable-format produced by nmap -oG 

  See `perldoc scavenge` for more information.
EOF
 exit(1);
}

my $debug = $opt_d; #If -d was passed, set the debug flag
my $range = $opt_r || undef; 
my $zone = $opt_f || undef;
my $ns = $opt_n || undef;

# Setup handle to DNS resolver
my $res = Net::DNS::Resolver->new;
if ($ns) {  $res->nameservers($ns); };

if ($range) {
	print STDOUT "DEBUG: nmap -sP -R $range -oG -\n" if $debug;
	open(NMAPOUT, "nmap -sP -R $range -oG - |") or die "Cannot open NMAP output for read: $!";
	# Associate NMAPOUT with STDIN
	open(MYFH, "<&=NMAPOUT") or die "Couldn't alias NMAPOUT : $!";
} elsif ($zone) {
   # User wants to try a zone transfer and audit A records (and their PTRs)
   # do a zone transfer
   # Audit each a record, and it's corresponding PTR
   # Begin pseudocode
   my $rr;
   my @zonedata = $res->axfr("$zone");
   unless (@zonedata) {
      die "xfer failed: ", $res->errorstring, "\n";
   }
	if ($debug) { print STDOUT "DEBUG: got zone xfer ok! #Records=", $#zonedata, "\n"; };
	my $pingh = Net::Ping->new("icmp");
   foreach my $rr (@zonedata) {
      next unless $rr->type eq "A";
      print STDOUT ("DEBUG: name->", $rr->name, "\t", "address->",  $rr->address, "\n") if $debug;
		my $case = ""; # transitory case indicator
		my @cases = (); # collector for case matches
      my $updown;
      if ($pingh->ping($rr->address,2)) {
         $updown = "Up";
      } else {
         $updown = "Down";
      }
      # Determine PTR records from discovered hostname
   	my $r_name = ""; #reversed name
   	my @ptr = &i2h($rr->address);
 		$r_name  = join(",", @ptr) ;
  		print ("DEBUG: r_name=", $r_name, "\n") if $debug;

	   # Case Stale A - host is down but resolves
		# Box B
		if ($updown eq 'Down') {
			my $buf .= "Stale A"; 
			# Since down, check for  Stale PTR also
			if (lc($r_name) eq lc($rr->name)) {
				$buf .= "+PTR";
			}
			
			
			push @cases, $buf; undef $buf; 
		} else { # Host is up 
			# Box D
			# this needs to check if name is contained in r_name
			my @rval = grep($rr->name, $r_name);
  			print ("DEBUG: grep rval=", join(',',@rval), "\n") if $debug;

			# Case Missing PTR
			if ($r_name eq 'NXDOMAIN') {
				push @cases, "Missing PTR";
			}
			# Case Mismatch PTR
			elsif (lc($rr->name) ne lc($r_name)) { 
				push @cases,  "Mismatch PTR";
			}	
		}
		# If case has not been identified, assume it's Good
		if (@cases > 0) {
			$case = join(",", @cases);
			print "$updown\t$case\t", $rr->name, " => (", $rr->address, ") => $r_name\n";
		} else {
			# record OK, nothing to report
			#print "No cases for ", $rr->address, "\n";
		}
	}
	$pingh->close();
} else {
	print STDOUT "DEBUG: input range empty, reading from STDIN\n" if $debug;
	open(MYFH,  "<&=STDIN")  or die "Couldn't alias STDIN : $!";
}

while (<MYFH>) {
	next if /^#/;
	my ($hostlabel, $ip, $hostname, $statuslabel, $updown) = split(/\s/, $_);
	# Identification of records with problems are assigned a "case" which is correspondent
	# to a category such as Stale PTR or Missing A
	my $case = ""; # transitory case indicator
	my @cases = (); # collector for case matches
	# Scrub some data
	$hostname =~ s/[\(\)]//g;

	# if down and there is no $hostname, move along, nothing to see
	# Box A
	next if ( ($updown eq 'Down') && ($hostname eq '') );

	# Determine A records from discovered hostname
	my $r_ip = "";
	if ($hostname  && ($hostname ne '') ) {
		my @ips = &h2i($hostname);
		$r_ip  = join(",", @ips) ;
		print ("DEBUG: r_ip=", $r_ip, "\n") if $debug;
	} 
	
	if ($hostname ne '') {
		# Case Stale PTR - host is down but ip resolves
		# Box B
		if ($updown eq 'Down') {
			my $buf .= "Stale PTR"; 
			# Since down, check for  Stale A also
			if ($r_ip ne 'NXDOMAIN') {
			 	$buf .= "+A";
			}
			push @cases, $buf; undef $buf;
		} else { # Host is up 
			# Box D
			# Case Missing A
			if ($r_ip eq 'NXDOMAIN') {
				push @cases, "Missing A";
			}
			# Case Mismatch A
			elsif (lc($ip) ne lc($r_ip)) { 
				push @cases,  "Mismatch A";
			}	
		}
	}
	else { # $hostname blank but Host is UP
		# Case Missing PTR
		# Box C
		push @cases, "Missing PTR";
	}
	# If case has not been identified, assume it's Good
	if (@cases > 0) {
		$case = join(",", @cases);
		print "$updown\t$case\t$ip => ($hostname) => $r_ip\n";
	}
}


# Given an IP address (dotted-quad) return an array of hostnames (PTR records)
sub h2i {
	my $ip = shift;
	my @result = ();
	my $query = $res->search($ip);
	if ($query) {
		foreach my $rr ($query->answer) {
			next unless $rr->type eq "A";
			print ("DEBUG: ", $rr->address, "\n") if $debug;
			push(@result, $rr->address);
		}
	} else {
		if ($debug) {
			warn "query failed: ", $res->errorstring, "\n";
		}
		if ($res->errorstring =~ /NXDOMAIN/) {
			push(@result, 'NXDOMAIN');
		} else {
			push(@result, $res->errorstring);
		}
	} 
	return @result;
}

# Given hostname, return a list of (dotted-quad) IP addresses (A records)
sub i2h {
	my $hname = shift;
	my @result = ();
	my $query = $res->search($hname);
	if ($query) {
		foreach my $rr ($query->answer) {
			next unless $rr->type eq "PTR";
			print ("DEBUG: ", $rr->ptrdname, "\n") if $debug;
			push(@result, $rr->ptrdname);
		}
	} else {
		if ($debug) {
			warn "query failed: ", $res->errorstring, "\n";
		}
		if ($res->errorstring =~ /NXDOMAIN/) {
			push(@result, 'NXDOMAIN');
		} else {
			push(@result, $res->errorstring);
		}
	}
	return @result;
}



# Parseable lines
# Host: 172.16.100.245 (dnsslave.portseattle.org) Status: Down
# This is a stale PTR

# Host: 172.16.100.246 () Status: Down
# This is fine (ignorable)

# Host: 172.16.100.233 (p69msitc147.portseattle.org)      Status: Up
# This is fine unless there is no such A record
# Or the A record p69msitc147.portseattle.org resolves to a different IP

# Host: 172.16.100.201 () Status: Up
# This is a missing PTR record


# Begin perldoc 
=pod

=head1 NAME

Scavenge - find stale, outdated and incorrect DNS records

=head1 DESCRIPTION

Using scavenge can help enable a DNS administrator in the task of cleaning up or auditing the DNS namespace.

Scavenge is a perl script that can be used to find old, outdated and incorrect DNS records. This is done in one of two ways. 

Reverse: by enumerating a network range such as 10.1.0.0/16, it 
         inspects the namespace from the reverse (PTR) perspective. 

Forward: perform a zone transfer (axfr) and enumerating all the 
         A records found.

In either case, a double-back-check is done (A->PTR->A or PTR->A->PTR).

=head1 USAGE

  scavenge [-r ip-range]|[-f zone] [-n nameserver] [-d]
  -r ip-range e.g. 192.168.0.1-255
                or 192.168.0.0/16 
                or "192.88-90.*.*"
     This is a reverse+forward audit
  -f zone does forward+reverse audit
  -n sets a nameserver to query directly (use for forward inspection)
  -d turn on debugging
  -h this help message

If neither -r or -f are specified, scavenge expects input (STDIN) in 
the format produced by L<nmap> -oG  (greppable).

=head1 DEPENDENCIES

scavenge needs L<nmap> and the perl module L<Net::DNS> to be fully functional.

=head1 AUTHOR

Written by Mark D. Foster (2005)

=head1 REPORTING BUGS

Please send any bug reports and patches to <mark@foster.cc>

=head1 LICENSE

scavenge is licensed under the GPL.

=head1 SEE ALSO

For more information about this program see
L<http://mark.foster.cc/wiki/index.php/Scavenge>

=pod
