0: #!/usr/bin/perl -w
1: 
2: # Copyright (C) Steven Haslam 2000
3: # This is free software, distributable under the same terms as Perl
4: # itself - see the Perl source distribution for details.
5: 
6: # Generate reverse DNS zone files from forward zone files.
7: #  e.g.:
8: #   make_reverse_zones db.london.excite.com
9: #    --> updates db.194.216.238
10: 
11: require 5;
12: use strict;
13: use IO::File;
14: 
15: sub read_zonefile {
16:   my $filename = shift;
17:   my $zoneobj = shift;
18: 
19:   my $stream = IO::File->new($filename) or die "Unable to read $filename: $!\n";
20:   my $origin;
21: 
22:   my $line = 0;
23:   my $current;
24: 
25:   #print "$filename:debug: reading zone\n";
26: 
27:   while ($_ = $stream->getline) {
28:     ++$line;
29:     if (/^\$(\S+)\s+(.+)/) {
30:       my($keyword, $data) = (uc($1), $2);
31:       if ($keyword eq 'ORIGIN') {
32: 	$origin = $data;
33: 	#print "$filename:$line:debug: setting ORIGIN to \"$origin\"\n";
34:       }
35:       elsif ($keyword eq 'TTL') {
36: 	next;
37:       }
38:       else {
39: 	warn "$filename:$line:warning: unknown directive \"\$$keyword\"\n";
40:       }
41:     }
42:     my @tokens = split(/\s+/);
43:     next unless (@tokens);
44:     my $domain = shift @tokens;
45:     if ($domain eq '@') {
46:       #print "$filename:$line:debug: Using origin ($origin)\n";
47:       $current = $origin;
48:       shift @tokens;
49:     }
50:     elsif ($domain eq '') {
51:       #print "$filename:$line:debug: Sticking with current domain ($current)\n";
52:     }
53:     else {
54:       if ($domain =~ /\.$/) {
55: 	$current = $domain;
56:       }
57:       else {
58: 	# Error to not have passed a $ORIGIN statement at this point
59: 	if (!defined($origin)) {
60: 	  die "$filename:$line: No \$ORIGIN encountered by this point\n";
61: 	}
62: 	# Skip "localhost" entries.
63: 	next if (lc($domain) eq 'localhost');
64: 	$current = "$domain.$origin";
65:       }
66:     }
67:     if ($tokens[0] eq 'IN') {
68:       shift @tokens;
69:     }
70:     my $type = uc(shift @tokens);
71:     # Only interested in A types
72:     # But SOA types need special handling for this hacked-together parser
73:     # For later: AAAA types
74:     if ($type eq 'SOA') {
75:       while (!/\)/) {
76: 	$_ = $stream->getline;
77: 	++$line;
78:       }
79:       next;
80:     }
81:     elsif ($type ne 'A') {
82:       next;
83:     }
84:     my $ipaddr = shift @tokens;
85:     my $restofline = join(' ', @tokens);
86:     if ($restofline =~ /;.*:norev:/i) {
87:       next; # Admin said to skip this line
88:     }
89:     #print "$filename:$line:debug: $current $ipaddr\n";
90:     if ($ipaddr !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
91:       warn "$filename:$line:warning: Bad IP address \"$ipaddr\"\n";
92:       next;
93:     }
94:     # "What's the point of this?" - eradicate any variations in formatting
95:     # that might have slipped through the regex above- leading zeroes being
96:     # an example
97:     $ipaddr = sprintf("%d.%d.%d.%d", $1, $2, $3, $4);
98:     if (exists($$zoneobj{$ipaddr})) {
99:       warn "$filename:$line:warning: IP address \"$ipaddr\" already used ($$zoneobj{$ipaddr})- ignoring \"$current IN A $ipaddr\"\n";
100:       next;
101:     }
102:     $$zoneobj{$ipaddr} = $current;
103:   }
104: 
105:   $stream->close;
106: }
107: 
108: sub bump_serial {
109:   my $oldserial = shift;
110:   my($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
111:   my $newserial = sprintf("%04d%02d%02d%02d", $year + 1900, $mon + 1, $mday, 1);
112:   if (($newserial + 100) < $oldserial) {
113:     die "Unable to bump old serial number ($oldserial ==> $newserial): something's broken\n";
114:   }
115:   while ($newserial <= $oldserial) {
116:     ++$newserial;
117:   }
118:   return $newserial;
119: }
120: 
121: sub update_revzonefile {
122:   my $filename = shift;
123:   my $nodes = shift;
124:   my $tempfilename = "$filename.$$.tmp";
125: 
126:   my $instream = IO::File->new($filename);
127: 
128:   # Open like this because we're likely to run as root and our
129:   # tempfile naming scheme isn't really very safe
130:   my $outstream = IO::File->new($tempfilename, O_WRONLY|O_CREAT|O_EXCL);
131:   
132:   my $found_serial = 0;
133: 
134:   my $updated = 0;
135: 
136:   my %foundoldnodes;
137: 
138:   while ($_ = $instream->getline) {
139:     # REQUIRE the serial number to be recognisable as:
140:     #       2000091101 ; Serial number
141:     if (s/(\d+)(\s+; Serial number)/&bump_serial($1).$2/e) {
142:       $found_serial++;
143:       $outstream->print($_);
144:       next;
145:     }
146:     elsif (/^(\d+)\s+(IN\s+)?PTR\s+(\S+)$/) {
147:       # Found a reverse entry
148:       my($oldnode, $oldhost) = ($1, $3);
149:       #print "debug: old-reverse: $oldnode = $oldhost\n";
150:       $foundoldnodes{$oldnode} = 1;
151: 
152:       # Has it changed?
153: 
154:       # Override: if the admin says keep it, they know what they're doing :}
155:       if (/;.*:keep:/) {
156: 	$outstream->print($_);
157: 	next;
158:       }
159: 
160:       if (!exists($$nodes{$oldnode})) {
161: 	#print "debug: $oldnode is to be removed\n";
162: 	$updated = 1;
163:       }
164:       elsif (lc($$nodes{$oldnode}) ne lc($oldhost)) {
165: 	#print "debug: data for $oldnode has changed ($oldhost ==> $$nodes{$oldnode})\n";
166: 	$updated = 1;
167:       }
168:       next; # Filter out these lines...
169:     }
170:     $outstream->print($_);
171:   }
172: 
173:   while (my($node, $host) = each %$nodes) {
174:     if (!$foundoldnodes{$node}) {
175:       #print "debug: $node is new\n";
176:       $updated = 1;
177:     }
178:     $outstream->print("$node\tIN\tPTR\t$host\n");
179:   }
180:   
181:   $instream->close;
182:   $outstream->close;
183: 
184:   if ($updated) {
185:     if ($found_serial) {
186:       print " Updating $filename\n";
187:       rename($tempfilename, $filename) or warn "rename($tempfilename, $filename): $!\n";
188:     }
189:     else {
190:       print " Unable to update $filename: no serial number found\n";
191:     }
192:   }
193:   else {
194:     print " No changes.\n";
195:     unlink($tempfilename) or warn "Unable to remove temp file (\"$tempfilename\"): $!\n";
196:   }
197: }
198: 
199: use vars qw(%addrs %nets);
200: 
201: if (!@ARGV) {
202:   die <<EOF;
203: Syntax: $0 forward-zonefile...
204: 
205: This script will scan the DNS zone files named on the command line,
206: and update reverse zone files as necessary.
207: 
208: For more details, see the POD documentation.
209: 
210: EOF
211: }
212: 
213: foreach (@ARGV) {
214:   read_zonefile($_, \%addrs);
215: }
216: 
217: # OK, now have ip-addr => hostname mapping. So bin all the hosts into /24s
218: 
219: while (my($ipaddr, $domain) = each %addrs) {
220:   my($net, $node) = ($ipaddr =~ /^(\d+\.\d+\.\d+)\.(\d+)$/);
221:   if (!defined($net) || !defined($node)) {
222:     die "Hm, regexp failed on $ipaddr: this REALLY shouldn't happen!\n";
223:   }
224:   $nets{$net}->{$node} = $domain;
225: }
226: 
227: # For each /24, update the zone file as applicable
228: 
229: while (my($net, $nodes) = each %nets) {
230:   my $filename = "db.$net";
231:   if (! -f $filename) {
232:     print "*** Zone file for $net/24 ($filename) does not exist\n";
233:   }
234:   else {
235:     print "Processing $net/24...\n";
236:     update_revzonefile($filename, $nodes);
237:   }
238: }
239: 
240: =head1 NAME
241: 
242: make_reverse_zones - Update reverse DNS zone files from the forward DNS zone files
243: 
244: =head1 SYNOPSIS
245: 
246:   make_reverse_zones forward_zonefile...
247: 
248: =head1 DESCRIPTION
249: 
250: Reads the forward DNS zone files named on the command line and uses
251: them to update reverse DNS zone files. Warnings will be emitted when
252: two domains are specified to have the same IP address- this can be
253: overridden in the zone file when necessary.
254: 
255: The forward zone files may be named in any fashion. The reverse zone
256: files B<must> be named as C<db.NNN.NNN.NNN> where each NNN is an IP
257: address component. This program only supports generating reverse zones
258: in /24 blocks.
259: 
260: If the reverse zone file does not already exist, it is B<not>
261: created. This program cannot determine the correct information to put
262: in the SOA/NS records- create a "blank" reverse zone file yourself and
263: rerun this program.
264: 
265: =head2 Syntax of the forward file
266: 
267: Currently, this program does not handle entries with TTLs specified.
268: 
269: The basic entry looked for is of the form:
270: 
271:    domain   IN  A  172.18.1.2    ; comments...
272: 
273: CNAME etc. records are discarded. Entries where the domain is
274: "localhost" are discarded. The C<$ORIGIN> directive is respected- and
275: is required unless every domain in the zone file is fully-qualified.
276: 
277: If the "comments..." section contains ":norev:" then the line is
278: ignored. This allows you to override the reverse DNS generation when
279: you know what you're doing (e.g. for round-robin DNS entries).
280: 
281: =head2 Syntax of the reverse file
282: 
283: The reverse file B<must> have a serial number line looking like this:
284: 
285:        2000110901  ; Serial number
286: 
287: The comment B<is> required.
288: 
289: When processing the reverse file, all existing "IN PTR" records are
290: removed. However, you can make the program leave them alone by putting
291: ":keep:" in a comment. This is useful if there are some addresses in
292: your reverse domain that you do not have the forward zone files for.
293: 
294: =head1 EXAMPLE
295: 
296:     bash$ ./make_reverse_zones db.london.excite.com 
297:     Processing 194.216.238/24...
298:      Updating db.194.216.238
299: 
300: =head1 BUGS
301: 
302: The zone file parsers are janky. Particularly the reverse zone file
303: reader's requirement for identifying the serial number, and the
304: forward file reader's failure to recognise TTL values.
305: 
306: IPv6 not supported.
307: 
308: =head1 AUTHOR
309: 
310: Steve Haslam <araqnid@debian.org>
311: 
312: =cut