#!/usr/local/bin/perl5.8.5

# fast-rdns.pl -  rdns-scan the living shit out of other networks
# V1.0  - 20060729
# V1.01 - 20060731 chop off trailing dot in output of all hostnames
# V1.02 - 20060809 only return PTR records, not CNAME (classless delegations)
# V1.1  - 20070211 accept single IP numbers and entire /8 (was /9) as argument, check sanity of argument
#		   add -b (batch mode) and -w (write-to-file) output modes
# V1.2  - 20070430 new -i and -s options (the latter remains to be tested on machines with multiple IPs)

# fast rDNS scanner - (C)2006,2007 Kai Schlichting/spamshield.org
#	no warranties
#	no liabilities
#	this program is a loaded, unsecured firearm with hairline trigger
#	this program will negatively effect or destroy everything it gets in contact with
#	   when run - including, but not limited to the universe its presently in
#	you've been warned.


use Net::DNS;   # if you don't have this, you are not the target audience for this program
use Net::CIDR;  # 'perl -MCPAN -e shell' and enter 'install Net::CIDR' if you don't have this
select(STDOUT); $| = 1; # unbuffered output

# DNS resolver parameters
my $retries = 4; # number of tries
my $retrans = 3; # retransmission interval in secs
my $timeout_block = 10; # don't take longer than this for any answer in entire /24
# my $timeout = 6; # UDP timeout
my $interval = 1; # chunking interval

my $block;
local $res;
my $net;
my $prefix;
local $loop_inc = 1; # default
local $verbose = 1; # default

my $Usage = "usage: $0 [-w] [-q] [-i <secs>] [-t <secs>] [-s src_ip] [-b <file>] [-f <N>] [network/prefix]\n" .
		"\tnetwork/prefix example: 192.168.0.0/24 will scan 192.168.0.0 - 192.168.0.255\n" .
		"\t-q : do not print errors like SERVFAIL or TIMEOUT\n" .
		"\t-t <secs> : timeout in seconds for for any given lookup: \(default:$timeout_block\)\n" .
		"\t-i <secs> : wait time before checking for anwers in /24 block \(default:$interval\)\n" .
		"\t-f <N> : will look up every Nth \(default:1\) IP, only\n" .
		"\t-b <file> : Batch mode. Implies -w . Read network/prefixes list from <file> only.\n" .
		"\t-s src_ip : use given source IP for queries\n" .
		"\t-w : write output to files in current working directory.\n" .
		"\t	Example: 192.168.0.0/24 will be written to 192.168.0.0_24.rdns\n" ;

use Getopt::Std;
my %opts;

getopts('qf:t:b:ws:i:', %opts) or die $Usage;

$loop_inc = $opt_f if $opt_f;
$verbose = 0 if $opt_q;
$timeout_block = $opt_t if $opt_t;
$file_in = $opt_b if $opt_b;
# $opt_w is true for -w mode
$interval = $opt_i if $opt_i;
$src_ip = $opt_s if $opt_s;

my $netblock;
my @lines;

if ($opt_b) {
	# we are in batch mode
	if (-r $file_in) {
		print "Starting in batch mode, reading from file $file_in\n";
		if ( open (FH, "< $file_in") ) {
			my $line;
			while ($line = <FH>) {
				chomp $line;
				# print "Read from file: $line\n";
				push @lines, $line;
			}
			close FH;
		} else {
			die "Tried to open, but can't read file $file_in\n";
		}
	} else {
		die "Input file $file_in is not readable for you - permissions?\n";
	}
} else {
	# no batchmode - use netblock given on command line
	if ($#ARGV != 0) {
	        print $Usage;
		exit 1;
	}
	push @lines,$ARGV[0] ; # our list is only the command-line argument
}


$res = Net::DNS::Resolver->new(
	recurse => 1,
	retry => $retries,
	retrans => $retrans,
	# udp_timeout => $timeout,
	persistent_udp => 1,
	srcaddr => $src_ip,
	);


NETBLOCK:
foreach $netblock (@lines) {

	($net,$prefix) = split ('/',$netblock);

	unless ($net =~ /^\d+\.\d+\.\d+\.\d+$/) {
		print "$net is not an IP or network number - skipping $netblock\n";
		next NETBLOCK;
	}

	if ($prefix == 0) {
		# it's a host
		$prefix = 32;
		$netblock .= "/32";
	}

	if ($prefix < 8) {
		print "Scanning blocks larger than /8 not supported: $netblock skipped.";
		next NETBLOCK;
	}

	if ($prefix > 32) {
		print "What do you mean, with /$prefix? $netblock skipped";
		next NETBLOCK;
	}

	print "Now working on: $net/$prefix\n";

	if (($opt_b) || ($opt_w) ) {
		# output to file
		my $out_file = $net."_".$prefix.".rdns";
		if (open (FH , "> $out_file")) {
			print "Writing output to $out_file\n" if $verbose;
		} else {
			print "Could not open file for output: $out_file - skipping $netblock\n";
			next NETBLOCK;
		}
		select (FH); $| = 1; # unbuffered output
	}

	print STDOUT "# Stepping through $netblock every $loop_inc IPs\n" if $verbose;

	if ($opt_b || $opt_w) {
		print "# Stepping through $netblock every $loop_inc IPs\n" if $verbose;
	}

	my $s_time = time;

	&explode_range($netblock); # recursive explosion of CIDR block

	my $elap = (time) - $s_time;

	print STDOUT "# Took $elap seconds to scan $netblock with stepsize $loop_inc\n" if $verbose;
	if ($opt_b || $opt_w) {
		print "# Took $elap seconds to scan $netblock with stepsize $loop_inc\n" if $verbose;
	}

	if ($opt_b || $opt_w) {
		select (STDOUT); # switch back
		close FH;
	}

} # foreach $netblock	

exit 0;

##############

sub explode_range {

 my $block = $_[0];
 my ($network,$prefix) = split ('/',$block);
 my @list;
 my $net;
 my $loc;
 my $ans;
 my @query;
 my @query_in;
 my $out;
 my $data;
 my $start;
 my $loop_x;
 
 if ($prefix < 17) {
	# getting a list of "A.B" (/16) prefixes out of this
	@list = Net::CIDR::cidr2octets($block);
	foreach $net (@list) {
		# print "Exploding block $block to /24's\n";
		&explode_range("$net.0.0/17"); # that'll get us /24's
		&explode_range("$net.128.0/17"); # that'll get us /24's
	}
	return 0;
 }

 if ($prefix < 24) {
	# getting a list of "A.B.C" (/24) prefixes out of this
	@list = Net::CIDR::cidr2octets($block);
	foreach $net (@list) {
		# print "Exploding $block to /24's\n";
		&explode_range("$net.0/24"); # that'll get us /24's
	}
	return 0;
 }

 if ($prefix == 24) {
	# generate list of 256 /32's
	if ( $network =~ /^(\d+\.\d+\.\d+)\.(\d+)$/ ) {
		my $net = $1; # the first 3 octets: A.B.C
		@list = Net::CIDR::cidr2octets("$net.0/25");
		push @list, Net::CIDR::cidr2octets("$net.128/25");
	}
 } else {
	 # ok, we are at the lowest level (/25 or longer prefix - will get all /32's
	 @list = Net::CIDR::cidr2octets($block);
 }

 # send all queries in background /w async DNS

 $loop_x = 1; # skip possible IPs

 QUERY:
 foreach $net (@list) {

	$loop_x -= 1;
	if (! $loop_x) {
		# do this run, reset counter
		$loop_x = $loop_inc;
	} else {
		# skip this run
		next QUERY;
	}

	if ( $net =~ /^(\d+\.\d+\.\d+)\.(\d+)$/ ) {
		$loc = $2; # last octet
		# print "working: octet $loc, sending query $net\n";
		$query_in[$loc] = $net;
		$query[$loc] = $res->bgsend($net);
	} else {
		print "# could not extract last octet from IP $net\n" if $verbose;
	}
 }

 $start = time;
 
 # now retrieve DNS answers - sending hopefully took at least as long to get the answers

 $loop_x = 1; # skip possible IPs

 RESOLVE:
 foreach $net (@list) {

	$loop_x -= 1;
	if (! $loop_x) {
		# do this run, reset counter
		$loop_x = $loop_inc;
	} else {
		# skip this run
		next RESOLVE;
	}

	$net =~ /^(\d+\.\d+\.\d+)\.(\d+)$/ ;
	$loc = $2;

	while (! $res->bgisready($query[$loc]) ) {
		# print "Still waiting for query $loc\n";
		if ( ( ( (time) - $start ) ) >= $timeout_block ) {
			# print "aborting wait for query $net\n";
			print "$net  (ERROR:TIMEOUT)\n" if $verbose;
			next RESOLVE;
		}
		sleep $interval;
	}

	$ans = $res->bgread($query[$loc]);
	# $ans->print; # debug from hell

	if (defined $ans) {
		my $had_any = 0;
		foreach $out ($ans->answer) {
			my $type = $out->type;
			  # print "$loc: type: $type\n";
			  # @txt = $out->string;
			unless ($type eq "PTR")  {
				# it's a CNAME record (classful delegation) - skip this, we get the PTR as the next answer
				next;
			}
			my @txt = $out->rdatastr;
			foreach $data (@txt) {
				# print "$query_in[$loc]: type: $type data: $data\n";
				$data =~ s/\.$// ;
				print "$net  $data\n";
				$had_any = 1;
			}
		}
		unless ($had_any) {
			my $err = $res->errorstring;
			if ($err eq "NXDOMAIN") {
				# print "$net\n";
			} else {
				print "$net  (ERROR:$err)\n" if $verbose;
			}
		}
	} else {
		my $err = $res->errorstring;
		if ($err eq "NXDOMAIN") {
			# print "$net\n";
		} else {
			print "$net  (ERROR:$err)\n" if $verbose;
		}
		# print "$net  (SRVFAIL)\n";
	}

 } 

}

########################