File: digparse

package info (click to toggle)
dlint 1.3.2-2
  • links: PTS
  • area: main
  • in suites: slink
  • size: 144 kB
  • ctags: 10
  • sloc: sh: 361; perl: 83; makefile: 68
file content (164 lines) | stat: -rwxr-xr-x 4,025 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
#!/usr/bin/perl
#
# digparse
#
# 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
#
# Paul Balyoz <pab@domtools.com>
# September 25, 1998
#

# 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;