source: trunk/bind-import@ 816

Last change on this file since 816 was 816, checked in by Kris Deugau, 4 years ago

/trunk

Ninth sampled iteration of bind-import

File size: 10.9 KB
RevLine 
[808]1#!/usr/bin/perl
2# Import a BIND zone file
3##
4# Copyright 2020 Kris Deugau <kdeugau@deepnet.cx>
5#
6# This program is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>.
18##
19
20use strict;
21use warnings;
22use Data::Dumper;
23
24use lib '.';
25use DNSDB;
26
27my $dnsdb = new DNSDB;
[810]28my $doimport = 0;
[808]29
30#print Dumper(\%reverse_typemap);
31
32my $zname = shift @ARGV;
[813]33die "usage: bind-import zonename\n" if !$zname;
[808]34my $rev = 'n';
35my $zid;
36
[810]37my %amap;
38my %namemap;
[811]39my %cmap;
[810]40
[815]41##fixme: this is wrong, BIND zone files are generally complete and we're adding. merging records is an entire fridge full of worms.
[816]42##fixme: for import, should arguably check for zone *non*existence
[809]43if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
[808]44 $rev = 'y';
[809]45 $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
[808]46 $zid = $dnsdb->revID($zname,':ANY:');
[809]47 if ($zid) {
48 $zname = new NetAddr::IP $zname;
49 $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
50 }
[808]51} else {
52 $zid = $dnsdb->domainID($zname,':ANY:');
53}
54
55die "zone $zname not on file\n" if !$zid;
56
[810]57# still no sane way to expose a human-friendly view tag on the command line.
58my $view = shift @ARGV;
59$view = '' if !$view;
60
[808]61##fixme: retrieve defttl from SOA record
62my $zonettl = 900;
[810]63my $defttl = $zonettl;
[815]64my $origin = $zname; # to append to unqualified names
[808]65
[810]66# need to spin up a full state machine-ish thing, because BIND zone files are all about context
[812]67# see ch4, p56-72 in the grasshopper book
68my $prevlabel = '';
69my $curlabel = '';
70
[813]71my $i = 0;
72
[808]73while (<>) {
[810]74 chomp;
[808]75 next if /^\s*$/;
[813]76 next if /^\s*;/; # comments
[816]77 next if /^\s*\)/; # SOA closing (possibly other records too?)
78 # arguably should do some more targeted voodoo when parsing the SOA details
[813]79
[815]80print "($_)\n";
[812]81 if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
[810]82 # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho
83 if ($macro eq 'TTL') {
[815]84 $mdetail =~ s/\s*;.+$//;
[810]85 if ($mdetail =~ /^\d+$/) {
86 $defttl = $mdetail;
87 } else {
88 warn "invalid \$TTL: $_\n";
89 }
90 } elsif ($macro eq 'ORIGIN') {
91##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie
92# between . and the root domain we were told we're importing; anyone using such
93# a mess outside the root servers is clearly insane
[815]94
95# $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
96
97print "origin ($mdetail)\n";
98 if ($mdetail =~ /\.$/) {
99 $origin = $mdetail;
[810]100 } else {
[815]101 # append current origin to unqualified origin
102 $origin = "$mdetail.$origin";
[810]103 }
[815]104
105# if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) {
106# $origin = $mdetail;
107# } else {
108# # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
109# die "bad \$ORIGIN: $_\n";
110# }
111
[810]112 }
[812]113 # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types)
[810]114 next;
115 }
[815]116
[813]117 my $origrec = $_;
[815]118
[810]119 # skip stale records that have no value
120 next if /^ip-192-168-1(12|20)-\d+/;
121 next if /ip.add.re.\d+\s*$/;
[813]122
[815]123 # leading whitespace indicates "same label as last record"
124 if (/^\s/) {
125 $curlabel = $prevlabel;
126 } else {
127 ($curlabel) = /^([\w\@_.-]+)\s/;
128 }
129
130 # magic name!
131 $curlabel = "$zname." if $curlabel eq '@';
132
133 # append $ORIGIN if name is not fully qualified.
134 if ($curlabel !~ /\.$/) {
135 $curlabel .= $origin;
136 }
137
138 # check for zone scope. skip bad records.
139 if ($curlabel !~ /$zname.$/) {
140 warn "bad record $origrec, maybe bad \$ORIGIN?\n";
141 next;
142 }
143
144# # records must begin in the first column, no leading whitespace
145# my ($name) = /^([\w\@_.-]+)\s/;
146
[813]147# foo IN A 1.2.3.4
148# IN A 2.3.4.5
149# =
150# foo.zone. IN A 1.2.3.4
151# foo.zone. IN A 2.3.4.5
152
[815]153# # "empty" label records inherit the previous label
154# # RRs start in the first column by definition, so leading whitespace indicates an inherited label
155# if (/^\s+/) {
156# # fatal error. if there is no previous label, we can by definition not set
157# # the current label based on it. this can only happen on the very first
158# # record, following records will *ALWAYS* have a previous label
159# die "bad first record ($_): no previous label\n" if !$prevlabel;
160# $name = $prevlabel;
161# }
[813]162
[815]163print "$i ($_)\n\t$curlabel";
[814]164
[813]165
[814]166
167
[815]168# # append zone name to record name if missing AND not dot-terminated;
169# # this happens automagically for forward zones, but not reverse because Reasons. (fixme?)
170# # suck up and deal with the error if the dot-termiated name is out of zone; should be
171# # impossible with valid BIND zone file but...
172# if ($name !~ /\.$/) {
173# $name .= ".$zname" if $name !~ /$zname$/;
174# } else {
175# warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
176# next;
177# }
[813]178
[815]179last if ++$i > 5;
[813]180
181
[812]182 s/^([\w\@_.-]+)\s+//;
[813]183
[815]184my $nc = 0;
185my %seenatoms;
186my $badrec;
187my $curatom = 'class';
[816]188
[815]189##fixme: maybe wrap this in an eval() instead of the warn/badrec/last bits?
[816]190eval {
191 for (; $nc < 3; $nc++) {
192 my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
193 if ($atom =~ /^\d+$/) {
194 if (defined($seenatoms{ttl})) {
195 die "bad record ($origrec)\n";
196# warn "bad record ($origrec)\n";
197# $badrec = 1;
198# last;
199 } else {
200 if ($curatom ne 'class' && $curatom ne 'ttl') {
201 die "bad record ($origrec)\n";
202# warn "bad record ($origrec)\n";
203# $badrec = 1;
204# last;
205 }
206 $curatom = 'ttl';
207 $seenatoms{ttl} = $atom;
[815]208 }
209 }
[816]210 if ($atom =~ /^IN|CS|CH|HS$/) {
211 if ($atom =~ /CS|CH|HS/) {
212 die "unsupported class $atom in record ($origrec)\n";
213# warn "unsupported class $atom in record ($origrec)\n";
214# $badrec = 1;
215# last;
216 }
217 $curatom = 'class';
[815]218 }
[816]219 if ($reverse_typemap{$atom}) {
220 print "dbg: type $atom\n";
221 }
222# my $itype = $reverse_typemap{$type};
[815]223 }
[816]224};
225if ($@) {
226 warn $@;
227 next;
[815]228}
229
[816]230#next if $badrec;
[815]231
232
[814]233##fixme: drop curlabel? not sure it's needed
[815]234#$curlabel = $name;
[813]235$prevlabel = $curlabel;
[814]236##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not.
237
238
[815]239
[812]240# by convention the optional TTL leads the optional class, but they're apparently swappable.
241 my ($ttl) = /^(\d+)?\s/;
242 if (defined $ttl) {
243 # TTL may be zero
244 s/(\d+)?\s+//;
245 } else {
246 # Fall back to zone default TTL
247 $ttl = $zonettl;
248 }
249 my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
250 if (defined $class) {
251 if ($class =~ /\d+/) {
252
253 }
[808]254 if ($class ne 'IN') {
[813]255 warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
[808]256 next;
257 }
258 s/(IN|CS|CH|HS)\s+//;
259 } else {
[812]260 $class = 'IN';
[808]261 }
262 my ($type) = /([A-Z-]+)\s/;
263 if (!$reverse_typemap{$type}) {
[813]264 warn "Unknown type $type, skipping\n\t($_)\n";
[808]265 next;
266 }
267 my $itype = $reverse_typemap{$type};
268 s/([A-Z-]+)\s+//;
269 chomp;
270 my $rdata = $_;
271
[812]272 # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records:
273 #@ IN SOA test.example.invalid. test.example.invalid. (2020082500 7200 900 604800 3600)
274 # IN NS olddns.example.com.
275 # IN MX 1 fred.foo.bar.invalid.
276 #foo IN A 192.168.16.45
277 # AXFR'ed zone file gets written as
278 #$ORIGIN .
279 #$TTL 3600 ; 1 hour
280 #example.invalid IN SOA test.example.invalid. test.example.invalid. (
281 # 2020082500 ; serial
282 # 7200 ; refresh (2 hours)
283 # 900 ; retry (15 minutes)
284 # 604800 ; expire (1 week)
285 # 3600 ; minimum (1 hour)
286 # )
287 # NS olddns.example.com.
288 # MX 1 fred.foo.bar.invalid.
289 #$ORIGIN example.invalid.
290 #foo A 192.168.16.45
291
292 if ($type eq 'SOA') {
[813]293 my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
294 die "Can't parse gibberish SOAish record: $_\n" if !$ns;
295 $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
[812]296
[813]297 # There are probably more efficient ways to do this but the SOA record
298 # format is essentially character based, not line-based.
299 # In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
[812]300
[813]301 # Parse fields from $rdata if present
302 my @soabits;
303 my @soafirst = split /\s+/, $rdata;
304 while (my $f = shift @soafirst) {
305 last if $f !~ /^\d/;
306 push @soabits, $f;
307 }
308
309 # Read more lines if we don't have enough SOA fields filled
310 while (scalar(@soabits) < 5) {
311 my $tmp = <>;
312 $tmp =~ s/^\s*//;
313 my @tmpsoa = split /\s+/, $tmp;
314 while (my $f = shift @tmpsoa) {
315 last if $f !~ /^\d/;
316 push @soabits, $f;
317 }
318 if (scalar(@soabits) == 5) {
319 last;
320 }
321 }
322 } # SOA
323
[808]324 # Quotes may arguably be syntactically required, but they're not actually part of the record data
[813]325 elsif ($type eq 'TXT') {
[808]326 $rdata =~ s/^"//;
327 $rdata =~ s/"$//;
328 }
329
[811]330# temp hack for hosts file
[813]331elsif ($type eq 'A') {
[810]332# if ($amap{$name}) {
333# print "urp: dupe name $name $rdata\n";
334# } else {
[815]335 push @{$amap{$curlabel}}, $rdata;
[810]336# }
[815]337 push @{$namemap{$rdata}}, $curlabel;
[810]338}
[813]339elsif ($type eq 'CNAME') {
[815]340 push @{$cmap{$rdata}}, $curlabel;
[811]341}
[810]342
[808]343no warnings qw(uninitialized);
[810]344#print "parsed: '$name' '$class' '$ttl' '$type'->'$itype' '$rdata'\n";
[808]345#print;
346#;imap IN 900 CNAME deepnet.cx.
347##fixme: not sure how to handle the case where someone leaves off the class.
[810]348 if ($doimport) {
349 my ($code, $msg);
350 if ($rev eq 'n') {
[815]351 ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl);
[810]352 } else {
[815]353 ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl);
[810]354 }
355 print "$code: $msg\n";
[809]356 }
[813]357 $i++;
[808]358}
[810]359
360
361#print Dumper \%amap;
[811]362#print Dumper \%namemap;
363#print Dumper \%cmap;
364
[810]365foreach my $n (keys %amap) {
366 foreach my $ip (@{$amap{$n}}) {
367#print "$ip $n\n";
368 push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
369 }
370}
371
[811]372foreach my $c (keys %cmap) {
373 if ($amap{$c}) {
374 print Dumper(\@{$amap{$c}});
375 }
376# print $amap{$c};
[810]377}
[811]378
379# cname targ -> IP
380
381#foreach my $ip (sort keys %namemap) {
382# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
383#}
384
Note: See TracBrowser for help on using the repository browser.