#!/usr/bin/perl
# vim:set ts=4 sw=4 ai:

=head1 NAME

dns-payload-inspection.pl - Payload inspection of DNS packets

=head1 DESCRIPTION

In conjunction with Linux iptables, IPTables::IPv4::IPQueue, and
Net::DNS::Packet, inspects inbound UDP packets with a source port of
53 to ensure that they contain legitimate DNS data, and drops packets
on the floor that do not.  This script grew out of an example I used
in two of my talks; for more information, please see:

	http://michael.toren.net/slides/ipqueue/slide019.html

and:

	http://michael.toren.net/slides/lkm-alternatives/slide016.html

=head1 COPYRIGHT

(c) Copyright 2003-2004 Michael C. Toren <mct@toren.net>

=head1 AVAILABILITY

For updates, please see:

	http://michael.toren.net/code/

=cut


use strict;
use warnings;

use IPTables::IPv4::IPQueue qw(:constants);
use NetPacket::IP qw(:ALL);
use NetPacket::UDP qw(:ALL);
use Net::DNS::Packet;

my $ipq = new IPTables::IPv4::IPQueue
		(copy_mode => IPQ_COPY_PACKET, copy_range => 1500);
	or die "Could not initialize IPQ: ", IPTables::IPv4::IPQueue->errstr, "\n";

my $default = NF_ACCEPT;

while (1)
{
	my $msg = $ipq->get_message;
	die "ipq: ", IPTables::IPv4::IPQueue->errstr, "\n"
		unless (defined $msg);
	next unless ($msg->data_len);

	my $ip = NetPacket::IP->decode($msg->payload);
	unless ($ip->{proto} == IP_PROTO_UDP) {
		$ipq->set_verdict($msg->packet_id, $accept);
		next;
	}

	my $udp = NetPacket::UDP->decode($ip->{data});
	unless ($udp->{src_port} == 53) {
		$ipq->set_verdict($msg->packet_id, $accept);
		next;
	}

	my $dns = Net::DNS::Packet->new(\$udp->{data});
	eval { $dns->string };

	unless ($@) {
		$ipq->set_verdict($msg->packet_id, NF_ACCEPT);
	} else {
		$ipq->set_verdict($msg->packet_id, NF_DROP);
	}
}