#!/usr/local/bin/perl5.00502
#
# digparse
#
# Domtools release 1.5.0
#
# Perl code that converts DiG output (version 2.1 or 8.1) into
# an easily parsable form:
#
#	HOST	RR	RR-ARGS
# i.e.
#	hip024.ch.intel.com.  A  143.182.204.227
#	hip024.ch.intel.com.  MX  10  sedona.intel.com.
#
# It understands $ORIGIN and @ and can expand @, blank LHS's, and non-dot-terminated
# LHS and RHSs.  No comments or blank lines are printed.
#
# There is 1 minor output difference between DiG 2.1 and DiG 8.1:
# the SOA record metrics are printed as-is, so they look different.  Example:
#    Dig 8.1:    cse.nau.edu. SOA warspite.cse.nau.edu. root.warspite.cse.nau.edu. \
#			1000742 8H 1H 1W 1D
#    Dig 2.1:    cse.nau.edu. SOA warspite.cse.nau.edu. root.warspite.cse.nau.edu. \
#			1000742 28800 3600 604800 86400
#
# usage:  dig @server.dom.ain. AXFR dom.ain. +ret=2 +pfset=0x2024 | digparse > file
#
#
# Copyright (C) 1993-2000 Paul A. Balyoz <pab@domtools.com>
#
#    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; either version 2 of the License, or
#    (at your option) any later version.
#
#    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., 675 Mass Ave, Cambridge, MA 02139, USA.
#

# RRs that have a domain name for their rightmost field
# (we tack the default domain onto domains that don't end in ".")
%rhs_is_domain = (
	"NS"=>1,
	"PTR"=>1,
	"MX"=>1,
	"CNAME"=>1,
);

# DNS Class Table
%classes = (
	"IN"=>1,	# Internet
	"CH"=>1,	# Chaos
);


# Main Loop - input lines, handle them.

while (<>) {

	chop;
	next if /^\s*;/;		# skip blank & comment lines
	next if /^\s*$/;

	@f = split;

	if ($f[0] eq '$ORIGIN') {		# literally the string '$ORIGIN'
		$origin = $f[1];
		$origin .= "." if $origin !~ /\.$/;	# append "." if missing
		$origin = "" if $origin eq ".";		# use "" for root domain
		next;
	}
	elsif ($f[0] !~ /\.$/) {
		if ($f[0] eq "@") {
			$f[0] = "$origin";	# expand "@" into origin
		} else {
			$f[0] .= ".$origin";	# append origin
		}
	}

	if (/^\s/) {				# empty LHS, use curr. domain name
		unshift @f, $domain;
	}
	else {
		$domain = $f[0];		# memorize this LHS for future lines
	}

	splice(@f,2,1)  if $classes{uc($f[2])};	# Get rid of Class if exists (DiG 8 & newer)


# By this point the records have been standardized.
#	$f[0] = LHS
#	$f[1] = TTL
#	$f[2] = RRTYPE
#	$f[3]..$f[$#f] = data (1 or more fields)

	$rr = uc($f[2]);

	if ($rhs_is_domain{$rr} && $f[$#f] !~ /\.$/) {		# empty RHS domain name
		if ($f[$#f] eq "@") {
			$f[$#f] = "$origin";			# "@" is just the origin
		} else {
			$f[$#f] .= ".$origin";			# otherwise append origin
		}
	}

#
# If we see a RR continuation marker (left-paren)
# then read and parse the rest of the continuation lines.
# The line looked like this:
# @                       4H IN SOA       pallas hostmaster.pallas (
#
	if (/\(\s*$/) {
		undef($f[$#f]);			# remove the "(" thing
		while (<STDIN>) {
			chop;

# Remove comments from the line.  DiG 2.1 puts parentheses in the comments!

			s/;.*//;

# Next, handle all other data lines in the continuation,
# including the right-paren line.  Expect no comments.
# Those lines look like this:
#                                         712120828       ; serial
#                                         1H              ; refresh
#                                         5M              ; retry
#                                         1W              ; expiry
#                                         4H )            ; minimum

#			if (/\s*([^\);\s]+)\s*\)?\s*;?.*/) {
#} ugh
			if (/\s*([^\)\s]+)\s*\)?.*/) {
				$f[$#f+1] = $1;
			}
			last if /\)/;		# end continuation line
		}
	}

	if ($rr eq "SOA") {
		if ($f[3] !~ /\.$/) {
			if ($f[3] eq "@") {
				$f[3] = "$origin";	# expand "@" into origin
			} else {
				$f[3] .= ".$origin";	# append origin
			}
		}
		if ($f[4] !~ /\.$/) {
			if ($f[4] eq "@") {
				$f[4] = "$origin";	# expand "@" into origin
			} else {
				$f[4] .= ".$origin";	# append origin
			}
		}
	}

# Print resulting data line

	$nspaces = 32 - length($f[0]);
	$nspaces = 1 if $nspaces < 1;
	print $f[0], " " x $nspaces;

	#$str = "$f[1] $f[2]";
	$str = "$f[2]";			# don't bother printing TTL
	$nspaces = 8 - length($str);
	$nspaces = 1 if $nspaces < 1;
	print "$str", " " x $nspaces;

	for ($i=3; $i<=$#f; $i++) {
		print " ",$f[$i];
	}
	print "\n";

}

exit 0;
