#!/usr/bin/perl

# $Id: dnsdump,v 1.1 2006/08/15 00:15:16 wessels Exp $

# Copyright (c) 2006, The Measurement Factory, Inc.  All rights
# reserved.

# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:

# Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# Neither the name of The Measurement Factory nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

use warnings;
use strict;

use Data::Dumper;
use Getopt::Std;
use Net::Pcap;
use IO::Socket::INET;
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP qw(:strip);
use NetPacket::UDP qw(:strip);
use Net::DNS::Packet;
use Net::DNS::Header;
use Net::DNS::RR;

my %opts;
getopts('i:', \%opts);
usage() unless $opts{i};
my $format = join(' ', @ARGV) || "%time %src %dst %qtype? %qname %ans\n";

my $err;
my $pcap = Net::Pcap::open_live($opts{i}, 1500, 0, 1000, \$err);
unless (defined ($pcap)) {
	print STDERR "$err\n";
	exit(1);
}

my $filter;
my $filter_str = 'udp port 53';
die if (Net::Pcap::compile($pcap, \$filter, $filter_str, 0, 0));
Net::Pcap::setfilter($pcap, $filter);

while (1) {
	Net::Pcap::loop($pcap, 100, \&process_pkt, undef);
}
exit(0);

sub process_pkt {
        my($user_data, $pcap_hdr, $pkt) = @_;

	my $rec = grok_pkt($pkt);
	return unless $rec;
	$rec->{time} = sprintf "%d.%06d", $pcap_hdr->{tv_sec}, $pcap_hdr->{tv_usec};
	#print Dumper($rec);
	foreach my $t (split(/%/, $format)) {
		next unless $t;
		die "t=$t" unless ($t =~ /^([-\d]*)([\(\[\{\<]*)([a-zA-Z_]+)([\]\)\>\}]*)(.*)/);
		my $width = $1;
		my $od = $2;
		my $key = $3;
		my $cd = $4;
		my $literal = $5;
		my $isarray = 0;
		$isarray = 1 if (ref($rec->{$key}) eq 'ARRAY');

		if ($isarray) {
			push(@{$rec->{$key}}, '') unless $rec->{$key};
			printf "%${width}s", join(' ', map {$od . $_ . $cd} @{$rec->{$key}});
		} elsif (defined($rec->{$key})) {
			printf "%${width}s", $rec->{$key};
		} else {
			printf "%${width}s", "- ";
		}
		print $literal;
	}
	print "\n";
}

sub grok_pkt {
	my $pkt = shift;
	my $rec;
        my $ip_obj = NetPacket::IP->decode(eth_strip($pkt));
	return $rec unless $ip_obj;
	$rec->{src} = $ip_obj->{src_ip};
	$rec->{dst} = $ip_obj->{dest_ip};
        return $rec unless ($ip_obj->{proto} == 17);

        my $udp_obj = NetPacket::UDP->decode($ip_obj->{data});
	return $rec unless $udp_obj;
	$rec->{sport} = $udp_obj->{src_port};
	$rec->{dport} = $udp_obj->{dest_port};
        return $rec unless ($udp_obj->{data});

        my $dns = Net::DNS::Packet->new(\$udp_obj->{data});
        unless ($dns) {
                warn "Net::DNS::Packet->new: $!";
                return $rec;
        }

	my $hdr = $dns->header;
	$rec->{id} = $hdr->id;
	$rec->{qr} = $hdr->qr;
	$rec->{opcode} = $hdr->opcode;
	$rec->{rcode} = $hdr->rcode;
	$rec->{aa} = $hdr->aa;
	$rec->{tc} = $hdr->tc;
	$rec->{rd} = $hdr->rd;
	$rec->{ra} = $hdr->ra;
	$rec->{ad} = $hdr->ad;
	$rec->{qdcount} = $hdr->qdcount;
	$rec->{ancount} = $hdr->ancount;
	$rec->{nscount} = $hdr->nscount;
	$rec->{adcount} = $hdr->adcount;

	if ($dns->question) {
		foreach my $rr ($dns->question) {
			push(@{$rec->{question}}, rr_munge($rr->string, $rr->qtype));
			$rec->{qname} = $rr->qname unless defined $rec->{qname};
			$rec->{qtype} = $rr->qtype unless defined $rec->{qtype};
		}
	}
	if ($dns->answer) {
		foreach my $rr ($dns->answer) {
			push(@{$rec->{answer}}, rr_munge($rr->string, $rr->type));
			push(@{$rec->{ans}}, rr_munge($rr->rdatastr, $rr->type));
		}
	}
	if ($dns->authority) {
		foreach my $rr ($dns->authority) {
			push(@{$rec->{authority}}, rr_munge($rr->string, $rr->type));
			push(@{$rec->{auth}}, rr_munge($rr->rdatastr, $rr->type));
		}
	}
	if ($dns->additional) {
		foreach my $rr ($dns->additional) {
			push(@{$rec->{additional}}, rr_munge($rr->string, $rr->type));
			push(@{$rec->{addl}}, rr_munge($rr->rdatastr, $rr->type));
		}
	}
	return $rec;
}

# consolidate whitespace, remove comments from SOA and OPT RRs
#
sub rr_munge {
	my $x = shift;
	my $t = shift;
	$x =~ s/;.*$//mg if ($t eq 'SOA');
	$x =~ s/;.*$// if ($t eq 'OPT');
	$x =~ s/\s+/ /g;
	#$x =~ s/ /\//g;
	return $x;
}

sub usage {
	print STDERR "$0 -i ifname \"%field %field ...\"\n";
	print STDERR "\n";
	print STDERR "Fields are:\n";
	print STDERR "\ttime\t\tTime that the packet was received\n";
	print STDERR "\tsrc\t\tSource IP address\n";
	print STDERR "\tdst\t\tDestination IP address\n";
	print STDERR "\tsport\t\tSource port\n";
	print STDERR "\tdport\t\tDestination port\n";
	print STDERR "\tid\t\tQuery ID\n";
	print STDERR "\tqr\t\tQuery or Response (Query = 0, Response = 1)\n";
	print STDERR "\topcode\t\tOpcode (QUERY, NOTIFY, UPDATE, etc)\n";
	print STDERR "\trcode\t\tResponse code (NOERROR, NXDOMAIN, REFUSED, etc)\n";
	print STDERR "\taa\t\tAuthoritative Answer bit\n";
	print STDERR "\ttc\t\tTruncation bit \n";
	print STDERR "\trd\t\tRecursion Desired bit\n";
	print STDERR "\tra\t\tRecrusion Available bit\n";
	print STDERR "\tad\t\tAuthenticated Data bit\n";
	print STDERR "\tqcount\t\tCount of records in the Question section\n";
	print STDERR "\tancount\t\tCount of records in the Answer section\n";
	print STDERR "\tnscount\t\tCount of records in the Authority section\n";
	print STDERR "\tadcount\t\tCount of records in the Additional section\n";
	print STDERR "\tqname\t\tQuery Name (first Question only)\n";
	print STDERR "\tqtype\t\tQuery Type (first Question only)\n";
	print STDERR "\tans\t\tList of Answers (short form)\n";
	print STDERR "\tauth\t\tList of Authority records (short form)\n";
	print STDERR "\taddl\t\tList of Additional records (short form)\n";
	print STDERR "\tquestion\tList of Questions (long form)\n";
	print STDERR "\tanswer\t\tList of Answers (long form)\n";
	print STDERR "\tauthority\tList of Authority records (long form)\n";
	print STDERR "\tadditional\tList of Additional records (long form)\n";
	exit 1;
}