#! /usr/bin/perl
#
# $Id$
# Copyright (C) 2004-2005 Jan Kratochvil <project-netdnsspoof@jankratochvil.net>
# 
# This program 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; exactly version 2 of June 1991 is required
# 
# This program is distributed in the hope that it will be useful,
# 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 program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


use strict;
use warnings;
use Getopt::Long;
require IO::Socket::INET;
require Net::DNS::Packet;
use Fcntl;
use Carp qw(cluck confess);
use Socket;
use Socket::MsgHdr;
require "linux/in.ph";


my $V=1;
$|=1;

my $D;
my $opt_addr;
my $opt_port=5353;
my $opt_forward_addr="localhost";
my $opt_forward_port=53;
my $opt_spoof_ip="192.168.1.1";
die if !GetOptions(
		"a|addr=s",\$opt_addr,
		"p|port=s",\$opt_port,
		  "forward-addr=s",\$opt_forward_addr,
		  "forward-port=s",\$opt_forward_port,
		"i|spoof-ip=s",\$opt_spoof_ip,
		"d|debug+",\$D,
		);
my $forward_host=gethostbyname($opt_forward_addr) or die "resolving $opt_forward_addr: $!";
my $forward_addr=sockaddr_in($opt_forward_port,$forward_host) or die "assembling $opt_forward_addr:$opt_forward_port";

my $sock_udp=IO::Socket::INET->new(
		LocalAddr=>$opt_addr,
		LocalPort=>$opt_port,
		Proto=>"udp",
		) or die "socket(): $!";
my $sock_udp_priv=IO::Socket::INET->new(
		Proto=>"udp",
		) or die "socket(): $!";
###fcntl($sock_udp,F_SETFL,O_NONBLOCK) or die "fnctl(sock_udp,F_SETFL,O_NONBLOCK)";

my $ip_pktinfo_got=setsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO(),pack("i",1);
# FIXME: Why Linux kernel 2.6.9-1.678_FC3 returns 1 instead of 0?
confess 'setsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO,&1)='.$ip_pktinfo_got
		if !defined $ip_pktinfo_got || 0>$ip_pktinfo_got;
my $ip_pktinfo_val=getsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO();
confess 'getsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO)!=1'
		if 1!=unpack("i",$ip_pktinfo_val);


sub id_next()
{
	our $id;
	$id=int(rand(0x10000)) if !defined $id;
	$id++;
	$id&=0xFFFF;
	return $id;
}

my %sent;

sub got_query($$$)
{
my($msg,$from_addr,$pktinfo_data)=@_;

	my $query=Net::DNS::Packet->new(\$msg);
	# FIXME: It really occured on hoteltest.
	do { warn "Failed to parse DNS packet query: ".unpack("H*",$msg); return; } if !$query;
	my $query_id_orig=$query->header()->id();
	my $query_id=id_next();
	$query->header()->id($query_id);
	my $msg_forward=$query->data();
	$query->header()->id($query_id_orig);	# fix-up back
	$sent{$query_id}={
		"msg"=>$msg,
		"from_addr"=>$from_addr,
		"pktinfo_data"=>$pktinfo_data,
		"query"=>$query,
		};
	warn "registered pending query id $query_id..." if $D;
	warn "sending forwarded DNS query (mapped id $query_id_orig -> $query_id)..." if $D;
	send $sock_udp_priv,$msg_forward,0,$forward_addr or cluck "send(): $!";
}

sub check_spoofable($$)
{
my($reply,$query)=@_;

	warn "checking packet spoofability from the reply... (non-spoofable if silent)" if $D;
	my @questions=$query->question();
	return 0 if 1!=@questions;
	my $question=$questions[0];
	return 0 if $question->qtype() ne "A"
	         && $question->qtype() ne "ANY";
	return 0 if $reply->header()->rcode() ne "NXDOMAIN";
	warn "packet considered as spoofable." if $D;
	return 1;
}

sub reply_spoof($$)
{
my($query_from_addr,$query)=@_;

	warn "assembling spoof reply..." if $D;
	my $question=($query->question())[0];
	my $spoof=Net::DNS::Packet->new($question->qname(),$question->qclass(),$question->qtype());
	$spoof->push("answer",Net::DNS::RR->new(join(" ",
			$question->qname(),
			3600,	# ttl
			$question->qclass(),
			"A",	# qtype
			$opt_spoof_ip,	# rdata
			)));
	$spoof->header()->rcode("NOERROR");
	$spoof->header()->aa(0);
	$spoof->header()->qr(1);
	$spoof->header()->ra(1);
	$spoof->header()->rd($query->header()->rd());
	$spoof->header()->id($query->header()->id());
	my $msg_spoof=$spoof->data();
	warn "sending spoof reply..." if $D;
	if ($V) {
		my($query_from_addr_port,$query_from_addr_host)=sockaddr_in($query_from_addr);
		my $query_from_addr_name=inet_ntoa $query_from_addr_host;
		print localtime()." spoof:"
				." from=$query_from_addr_name:$query_from_addr_port"
				." qname=".$question->qname()
				." ip=".$opt_spoof_ip
				."\n";
		}
	return $msg_spoof;
}

sub got_forward_reply($)
{
my($msg)=@_;

	warn "parsing reply from our forwarded DNS..." if $D;
	my $reply=Net::DNS::Packet->new(\$msg);
	my $reply_id=$reply->header()->id();
	my($query_msg,$query_from_addr,$query_pktinfo_data,$query);
	if (my $hash=$sent{$reply_id}) {
		delete $sent{$reply_id};
		$query_msg         =$hash->{"msg"};
		$query_from_addr   =$hash->{"from_addr"};
		$query_pktinfo_data=$hash->{"pktinfo_data"};
		$query             =$hash->{"query"};
		warn "deleted pending record with id $reply_id." if $D;
		}
	else {
		warn "Got DNS reply for unknown packet id $reply_id";
		return;
		}
	my $reply_back;
	if (check_spoofable($reply,$query)) {
		$reply_back=reply_spoof $query_from_addr,$query or return;
		}
	else {
		$reply->header()->id($query->header()->id());
		$reply_back=$reply->data();
		warn "passing reply back to the original query host..." if $D;
		}
	my $msghdr=Socket::MsgHdr->new();
	$msghdr->buf($reply_back);
	$msghdr->name($query_from_addr);
	$msghdr->cmsghdr(IPPROTO_IP(),IP_PKTINFO(),$query_pktinfo_data);
	sendmsg $sock_udp,$msghdr or cluck "sendmsg(): $!";
}

$V and print localtime()." START\n";
for (;;) {
	my $rfds="";
	vec($rfds,fileno($sock_udp),1)=1;
	vec($rfds,fileno($sock_udp_priv),1)=1;
	warn "select(2)..." if $D;
	my $got=select $rfds,undef(),undef(),undef();
	warn "got from select." if $D;
	die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;

	if (vec($rfds,fileno($sock_udp_priv),1)) {{
		my $msg;
		defined(my $from_addr=recv $sock_udp_priv,$msg,0x10000,0) or do { cluck "recv(sock_udp_priv): $!"; next; };
		warn "got packet from forwarding DNS..." if $D;
		my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);

		if ($from_addr_host ne $forward_host || $from_addr_port ne $opt_forward_port) {
			warn "original query forbidden from the private forwarding socket";
			next;
			}
		got_forward_reply $msg;
		}}
	if (vec($rfds,fileno($sock_udp),1)) {{
		# "namelen"=>0x10 to prevent: Bad arg length for Socket::unpack_sockaddr_in, length is 4096, should be 16 at /usr/lib/perl5/5.8.5/i386-linux-thread-multi/Socket.pm line 370.
		my $msghdr=Socket::MsgHdr->new("buflen"=>0x10000,"namelen"=>0x10,"controllen"=>0x1000);
		defined(recvmsg($sock_udp,$msghdr,0)) or do { cluck "recvmsg(sock_udp): $!"; next; };
		warn "got packet as original query..." if $D;
		my $msg=$msghdr->buf();
		my $pktinfo_data;
		my @cmsg=$msghdr->cmsghdr();
		while (my($level,$type,$data)=splice(@cmsg,0,3)) {
			do { warn "unknown cmsg level $level"; next; } if $level!=IPPROTO_IP();
			do { warn "unknown cmsg level $type";  next; } if $type !=IP_PKTINFO();
			$pktinfo_data=$data;
			}
		do { warn "IP_PKTINFO not found for a packet"; next; } if !defined $pktinfo_data;
		my $from_addr=$msghdr->name();
		my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);

		if ($from_addr_host eq $forward_host && $from_addr_port eq $opt_forward_port) {
			warn "packet returned from forwarding DNS forbidden from the main listening socket";
			next;
			}
		got_query $msg,$from_addr,$pktinfo_data;
		}}
	}