source: trunk/bind-import@ 821

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

/trunk

Fourtheenth sampled iteration of bind-import

File size: 18.6 KB
RevLine 
[808]1#!/usr/bin/perl
2# Import a BIND zone file
[818]3# Note we are not using Net:DNS::ZoneFile, because we want to convert $GENERATE
4# directives straight into PTR template or A+PTR template metarecords
[808]5##
6# Copyright 2020 Kris Deugau <kdeugau@deepnet.cx>
7#
8# This program is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation, either version 3 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program. If not, see <http://www.gnu.org/licenses/>.
20##
21
22use strict;
23use warnings;
[819]24use Getopt::Long;
25
[808]26use Data::Dumper;
27
[819]28##fixme
[808]29use lib '.';
30use DNSDB;
31
32my $dnsdb = new DNSDB;
[821]33my $dryrun = 0;
[808]34
35#print Dumper(\%reverse_typemap);
36
[817]37local $dnsdb->{dbh}->{AutoCommit} = 0;
38local $dnsdb->{dbh}->{RaiseError} = 1;
39
[819]40# from tiny-import: arguably can't use -r, -c is irrelevant. others useful?
41 # -r rewrite imported files to comment imported records
42 # -c coerce/downconvert A+PTR = records to PTR
43 # -l swallow A+PTR as-is
44 # -m merge PTR and A/AAAA as possible
45 # -t trial mode; don't commit to DB or actually rewrite flatfile (disables -r)
46 # -g import to specified group (name or ID) instead of group 1
47
[817]48##fixme: command arguments/flags to set these to alternate values
49my $group = 1;
50my $status = 1;
51my $location = '';
52# we'll update this with the actual serial number from the SOA record later
53my $serial = time();
54
[819]55my @skipdefs;
56my $skipfile;
57
58GetOptions(
59 "skip=s" => \@skipdefs,
60 "skipfile=s" => \$skipfile,
[821]61 "test|dry-run" => \$dryrun,
[819]62);
63
64my $usage = "usage: bind-import [--skip pattern [--skip pattern2 ...]] [--skipfile file]
65 zonename [zonefile]
66 --skip
67 Specify a string to skip in the records. If an IP-like string is
68 used, and the zone is a reverse zone, it will also search for the
69 octet-reversed form. Specify multiple times to skip multiple
70 different record patterns.
71 --skipfile
72 A file containing patterns to skip. Patterns from the file and
73 any --skip arguments are merged.
[821]74 --dry-run
75 Do everything except finalize the import
[819]76 zonename
77 The name of the zone to import. Required.
78 zonefile
79 Specify the zone file as an argument. If not specified, the zone
80 data will be read from STDIN.
81";
82
[808]83my $zname = shift @ARGV;
[817]84my $origzone = $zname;
[819]85die $usage if !$zname;
86
87my $zonefile = shift @ARGV;
88if(!$zonefile) {
89 $zonefile = '&STDIN';
90}
91
[808]92my $rev = 'n';
93my $zid;
[819]94my %foundtypes;
[808]95
[819]96if ($skipfile) {
97 if (-f $skipfile) {
98 open SKIP, "<$skipfile";
99 while (<SKIP>) {
[820]100 chomp;
[819]101 push @skipdefs, $_;
102 }
[820]103 close SKIP;
[819]104 } else {
105 warn "skipfile $skipfile requested but it doesn't seem to exist. Continuing.\n";
106 }
107}
108
109#sub setreplace {
110## print "dbg1: $_[0]\ndbg2: $_[1]\n";
111##($_[1] eq '' ? $replace = 1 : $replace = $_[1]);
112# if ($_[1] eq '') {
113# print "no arg value, setting 1\n";
114# $replace = 1;
115# } else {
116# print "arg value $_[1]\n";
117# $replace = $_[1];
118# }
119#}
120
121
[810]122my %amap;
123my %namemap;
[811]124my %cmap;
[810]125
[819]126# wrap all the DB stuff in eval{}, so the entire thing either succeeds or fails.
127
128eval {
129
130 local $dnsdb->{dbh}->{AutoCommit} = 0;
131 local $dnsdb->{dbh}->{RaiseError} = 1;
132
[815]133##fixme: this is wrong, BIND zone files are generally complete and we're adding. merging records is an entire fridge full of worms.
[816]134##fixme: for import, should arguably check for zone *non*existence
[821]135
[819]136 if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
137 $rev = 'y';
138 $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
139 $zid = $dnsdb->revID($zname,':ANY:');
140 if ($zid) {
141 die "zone $origzone already present, not merging records\n";
[821]142#print "dbg: skip add domain\n";
143# $zname = new NetAddr::IP $zname;
144# $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
[819]145 }
[820]146 ($zid) = $dnsdb->{dbh}->selectrow_array("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id",
[819]147 undef, ($zname, $group, $status, $location, $serial));
[817]148
[819]149 } else {
150 $zid = $dnsdb->domainID($zname,':ANY:');
151 if ($zid) {
[821]152 die "zone $origzone already present, not merging records\n";
153#print "dbg: skip add domain\n";
154 }
155 ($zid) = $dnsdb->{dbh}->selectrow_array("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id",
[820]156 undef, ($zname, $group, $status, $location, $serial));
[808]157
[819]158 }
[808]159
[819]160 die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid;
[817]161
162
[819]163##fixme: should probably make this a named argument so it doesn't get confused with the zone filename
164 # still no sane way to expose a human-friendly view tag on the command line.
165 my $view = shift @ARGV;
166 $view = '' if !$view;
[810]167
[819]168 ##fixme: retrieve defttl from SOA record
169 my $zonettl = 900;
170 my $defttl = $zonettl;
171 my $origin = "$zname."; # to append to unqualified names
[808]172
[819]173 # need to spin up a full state machine-ish thing, because BIND zone files are all about context
174 # see ch4, p56-72 in the grasshopper book
175 my $prevlabel = '';
176 my $curlabel = '';
[812]177
[819]178 my $i = 0;
[813]179
[819]180 open ZONEDATA, "<$zonefile";
181
182 while (my $rec = <ZONEDATA>) {
183 chomp $rec;
184 next if $rec =~ /^\s*$/;
185 next if $rec =~ /^\s*;/; # comments
186 next if $rec =~ /^\s*\)/; # SOA closing (possibly other records too?)
[817]187 # arguably should do some more targeted voodoo when parsing the SOA details
[813]188
[820]189##fixme: would prefer to break the loop below *AND* next; the while starting above
190 # check skiplist. do this early since it's (mostly) a simple string match against the raw record line
191 my $skipflag = 0;
192 foreach (@skipdefs) {
193#print "skipdbg: $_ =~ $rec\n" if $rec =~ /207/;
194 if ($rec =~ /\Q$_\E/) {
195 $skipflag = 1;
196# print "skip: $rec\n";
197 }
198 }
199 next if $skipflag;
200
[818]201##fixme: use external skiplist
[820]202# # skip stale records that have no value
203# next if /^ip-192-168-1(12|20)-\d+/;
204# next if /ip.add.re.\d+\s*$/;
[817]205
[820]206$i++;
207last if $i > 17;
[818]208#print "line $i: ($rec)\n";
[819]209 if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
210 # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho
211 if ($macro eq 'TTL') {
212 $mdetail =~ s/\s*;.+$//;
213 if ($mdetail =~ /^\d+$/) {
214 $defttl = $mdetail;
215 } else {
216 warn "invalid \$TTL: $rec\n";
217 }
218 } elsif ($macro eq 'ORIGIN') {
[810]219##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie
220# between . and the root domain we were told we're importing; anyone using such
221# a mess outside the root servers is clearly insane
[815]222
223# $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
224
225print "origin ($mdetail)\n";
[819]226 if ($mdetail =~ /\.$/) {
227 $origin = $mdetail;
228 } else {
229 # append current origin to unqualified origin
230 $origin = "$mdetail.$origin";
231 }
[815]232
233# if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) {
234# $origin = $mdetail;
235# } else {
236# # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
237# die "bad \$ORIGIN: $_\n";
238# }
239
[819]240 }
241 elsif ($macro eq 'GENERATE') {
[818]242# needs to generate CIDR range(s) as needed to match the start/stop points
[819]243 }
244 # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types)
245 next;
[818]246 }
[815]247
[819]248 my $origrec = $rec;
[815]249
250 # leading whitespace indicates "same label as last record"
[819]251 if ($rec =~ /^\s/) {
252 $curlabel = $prevlabel;
[820]253#print " found empty label, using previous label\n";
[819]254 } else {
255 ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
256 }
[815]257
[820]258#print " found '$curlabel'\n";
[817]259
[819]260 # magic name!
261 $curlabel = "$zname." if $curlabel eq '@';
[815]262
[819]263 # append $ORIGIN if name is not fully qualified.
264 if ($curlabel !~ /\.$/) {
265 $curlabel .= ($origin eq '.' ? '.' : ".$origin");
266 }
[820]267#print " expanded '$curlabel'\n";
[815]268
[818]269# hack pthbptt
270#$curlabel =~ s/\.\.$/./;
[819]271 # check for zone scope. skip bad records.
272 if ($curlabel !~ /$zname.$/) {
273 warn "bad record $origrec, maybe bad \$ORIGIN?\n";
274# bweh? maybe this should die()?
[817]275last;
[819]276 next;
277 }
[815]278
[819]279 # trim the label, if any
280 $rec =~ s/^([\w\@_.-]*)\s+//;
[817]281
[815]282# # records must begin in the first column, no leading whitespace
283# my ($name) = /^([\w\@_.-]+)\s/;
284
[813]285# foo IN A 1.2.3.4
286# IN A 2.3.4.5
287# =
288# foo.zone. IN A 1.2.3.4
289# foo.zone. IN A 2.3.4.5
290
[815]291# # "empty" label records inherit the previous label
292# # RRs start in the first column by definition, so leading whitespace indicates an inherited label
293# if (/^\s+/) {
294# # fatal error. if there is no previous label, we can by definition not set
295# # the current label based on it. this can only happen on the very first
296# # record, following records will *ALWAYS* have a previous label
297# die "bad first record ($_): no previous label\n" if !$prevlabel;
298# $name = $prevlabel;
299# }
[813]300
[818]301#print "$i ($rec)\n";#\t$curlabel";
[814]302
[813]303
[814]304
305
[815]306# # append zone name to record name if missing AND not dot-terminated;
307# # this happens automagically for forward zones, but not reverse because Reasons. (fixme?)
308# # suck up and deal with the error if the dot-termiated name is out of zone; should be
309# # impossible with valid BIND zone file but...
310# if ($name !~ /\.$/) {
311# $name .= ".$zname" if $name !~ /$zname$/;
312# } else {
313# warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
314# next;
315# }
[813]316
317
[819]318 my $nc = 0;
319 my $class = 'IN';
320 my $type;
321 my $ttl;
322 my $distance;
323 my $weight;
324 my $port;
325 my $badrec;
326 my $curatom = 'class';
[813]327
[819]328 # unpack the class, TTL, and type
329 eval {
330 for (; $nc < 3; $nc++) {
331 my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
332 # should be safe?
333 last if !$atom;
334 last if $type;
[817]335#print "nc:$nc: $atom\n";
[819]336 if ($atom =~ /^\d+$/) {
337 if (defined($ttl)) {
[817]338 die "bad record ($origrec)\n";
339# warn "bad record ($origrec)\n";
340# $badrec = 1;
341# last;
[819]342 } else {
343 if ($curatom ne 'class' && $curatom ne 'ttl') {
344 die "bad record ($origrec)\n";
345# warn "bad record ($origrec)\n";
346# $badrec = 1;
347# last;
348 }
349 $curatom = 'ttl';
350 $ttl = $atom;
[817]351 }
[816]352 }
[817]353
[819]354 elsif ($atom =~ /^IN|CS|CH|HS$/) {
[817]355#print "a$nc: d2: atom [$atom]\n $rec\n" if $i == $debugid;
[819]356 if ($atom =~ /CS|CH|HS/) {
357 die "unsupported class $atom in record ($origrec)\n";
358# warn "unsupported class $atom in record ($origrec)\n";
359# $badrec = 1;
360# last;
361 }
362 $curatom = 'class';
363 $class = $atom;
[817]364 }
365
[819]366 elsif ($atom =~ /^[A-Z]+/) {
[817]367# print "dbg: type $atom\n";
[819]368 if ($reverse_typemap{$atom}) {
369 $type = $atom;
370 } else {
371 die "unknown type $atom in record ($origrec)\n";
372 }
[817]373 }
[819]374 $rec =~ s/^$atom\s*//;
[817]375 }
[819]376 }; # record class/type/TTL parse
377 if ($@) {
378 warn $@;
379 next;
[815]380 }
381
[818]382##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not.
[819]383 # set default TTL here so we can detect a TTL in the loop above
384 $ttl = $defttl if !defined($ttl);
[817]385
[816]386#next if $badrec;
[815]387
[819]388 $prevlabel = $curlabel;
[815]389
[814]390
[817]391## by convention the optional TTL leads the optional class, but they're apparently swappable.
392# my ($ttl) = /^(\d+)?\s/;
393# if (defined $ttl) {
394# # TTL may be zero
395# s/(\d+)?\s+//;
396# } else {
397# # Fall back to zone default TTL
398# $ttl = $zonettl;
399# }
400# my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
401# if (defined $class) {
402# if ($class =~ /\d+/) {
403#
404# }
405# if ($class ne 'IN') {
406# warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
407# next;
408# }
409# s/(IN|CS|CH|HS)\s+//;
410# } else {
411# $class = 'IN';
412# }
413# my ($type) = /([A-Z-]+)\s/;
414# if (!$reverse_typemap{$type}) {
415# warn "Unknown type $type, skipping\n\t($rec)\n";
416# next;
417# }
418# s/([A-Z-]+)\s+//;
419# chomp;
420
421
[819]422 my $itype = $reverse_typemap{$type};
423 my $rdata = $rec;
[808]424
[812]425 # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records:
426 #@ IN SOA test.example.invalid. test.example.invalid. (2020082500 7200 900 604800 3600)
427 # IN NS olddns.example.com.
428 # IN MX 1 fred.foo.bar.invalid.
429 #foo IN A 192.168.16.45
430 # AXFR'ed zone file gets written as
431 #$ORIGIN .
432 #$TTL 3600 ; 1 hour
433 #example.invalid IN SOA test.example.invalid. test.example.invalid. (
434 # 2020082500 ; serial
435 # 7200 ; refresh (2 hours)
436 # 900 ; retry (15 minutes)
437 # 604800 ; expire (1 week)
438 # 3600 ; minimum (1 hour)
439 # )
440 # NS olddns.example.com.
441 # MX 1 fred.foo.bar.invalid.
442 #$ORIGIN example.invalid.
443 #foo A 192.168.16.45
[819]444 $foundtypes{$type}++;
[812]445
[818]446##fixme: strip trailing . here? dnsadmin's normalized internal format omits it, some validation fails or may go funky
447
[819]448 if ($type eq 'SOA') {
449 my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
450 die "Can't parse gibberish SOAish record: $rec\n" if !$ns;
451 $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
[812]452
[819]453 # There are probably more efficient ways to do this but the SOA record
454 # format is essentially character based, not line-based.
455 # In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
[812]456
[819]457 # Parse fields from $rdata if present
458 my @soabits;
459 my @soafirst = split /\s+/, $rdata;
460 while (my $f = shift @soafirst) {
[813]461 last if $f !~ /^\d/;
[819]462 push @soabits, $f;
[813]463 }
[819]464
465 # Read more lines if we don't have enough SOA fields filled
466 while (scalar(@soabits) < 5) {
467 my $tmp = <ZONEDATA>;
468 $tmp =~ s/^\s*//;
469 my @tmpsoa = split /\s+/, $tmp;
470 while (my $f = shift @tmpsoa) {
471 last if $f !~ /^\d/;
472 push @soabits, $f;
473 }
474 if (scalar(@soabits) == 5) {
475 last;
476 }
[813]477 }
[819]478 my @soavals = ($zid, "$adminmail:$ns", 6, join(':', @soabits), $ttl, $location);
479# host = $adminmail:$ns
480# val = join(':', @soabits);
481
482 if ($rev eq 'y') {
483 $dnsdb->{dbh}->do("UPDATE revzones SET zserial = ? WHERE rdns_id = ?", undef, $soabits[0], $zid);
484 $dnsdb->{dbh}->do("INSERT INTO records (rdns_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
485 } else {
486 $dnsdb->{dbh}->do("UPDATE domains SET zserial = ? WHERE domain_id = ?", undef, $soabits[0], $zid);
487 $dnsdb->{dbh}->do("INSERT INTO records (domain_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
488 }
[818]489# $dnsdb->{dbh}->do("INSERT INTO records () VALUES ()");
490# next;
491#Zfqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo
492#print "Z$zname:$ns:$adminmail:$soabits[0]:$soabits[1]:$soabits[2]:$soabits[3]:$soabits[4]:$ttl\n";
[820]493 # skip insert at end of loop; SOA records are not handled by DNSDB::addRec()
494 next;
[819]495 } # SOA
[813]496
[818]497
[819]498 # we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown
[818]499
[819]500 elsif ($type eq 'A') {
[818]501#print "+$curlabel:$rdata:$ttl\n";
[819]502 }
[818]503
[819]504 elsif ($type eq 'NS') {
[818]505#print "\&$curlabel::$rdata:$ttl\n";
[819]506 }
[818]507
[819]508 elsif ($type eq 'CNAME') {
[818]509#print "C$curlabel:$rdata:$ttl\n";
[819]510 }
[818]511
[819]512 elsif ($type eq 'PTR') {
513 }
[818]514
[819]515 elsif ($type eq 'MX') {
516 ($distance) = ($rdata =~ /^(\d+)\s+/);
517 if (!defined($distance)) {
518 warn "malformed MX record: $origrec, skipping\n";
519 next;
520 }
521 $rdata =~ s/^\d+\s+//;
[818]522 }
523
[819]524 elsif ($type eq 'TXT') {
525 # Quotes may arguably be syntactically required, but they're not actually part of the record data
526 $rdata =~ s/^"//;
527 $rdata =~ s/"$//;
[818]528#print "'$curlabel:$rdata:$ttl\n";
[819]529 }
[808]530
[819]531 elsif ($type eq 'RP') {
532 }
[810]533
[819]534 elsif ($type eq 'AAAA') {
535 }
[818]536
[819]537 elsif ($type eq 'SRV') {
538 ($distance, $weight, $port) = ($rdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+/);
539 if ( !defined($distance) || !defined($weight) || !defined($port) ) {
540 warn "malformed SRV record: $origrec, skipping\n";
541 next;
542 }
543 $rdata =~ s/^\d+\s+\d+\s+\d+\s+//;
[818]544 }
545
[819]546 # basically a dedicated clone of TXT, not sure anything actually looks up type SPF.
547 # BIND autogenerates them from SPF TXT records.
548 elsif ($type eq 'SPF') {
549 # Quotes may arguably be syntactically required, but they're not actually part of the record data
550 $rdata =~ s/^"//;
551 $rdata =~ s/"$//;
552 }
[818]553
554# elsif ($type eq 'TXT') {
555# elsif ($type eq 'TXT') {
556
[819]557 else {
558 warn "unsupported type $type, may not import correctly\n";
559 }
[818]560
[821]561##fixme: need to dig out a subtransaction widget or extract a core of addRec() that doesn't dbh->commit(), so --dry-run works
562# unless ($dryrun) {
[819]563 my ($code, $msg);
564 if ($rev eq 'n') {
565 ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl,
566 $location, undef, undef, $distance, $weight, $port);
567 } else {
568 ($code,$msg) = $dnsdb->addRec('y', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl,
569 $location, undef, undef, $distance, $weight, $port);
570 }
[820]571 print "$code: $msg\n" if $code ne 'OK';
[821]572# }
[819]573# $i++;
[809]574 }
[819]575
[821]576 if ($dryrun) {
577 $dnsdb->{dbh}->rollback;
578 } else {
579 $dnsdb->{dbh}->commit;
580 }
[819]581};
582if ($@) {
583 warn "Error parsing zonefile: $@\n";
584 $dnsdb->{dbh}->rollback;
585 exit;
[808]586}
[810]587
588#print Dumper \%amap;
[811]589#print Dumper \%namemap;
590#print Dumper \%cmap;
591
[818]592#foreach my $n (keys %amap) {
593# foreach my $ip (@{$amap{$n}}) {
594##print "$ip $n\n";
595# push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
596# }
597#}
[810]598
[818]599#foreach my $c (keys %cmap) {
600# if ($amap{$c}) {
601# print Dumper(\@{$amap{$c}});
602# }
603## print $amap{$c};
604#}
[811]605
606# cname targ -> IP
607
608#foreach my $ip (sort keys %namemap) {
609# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
610#}
611
[819]612##fixme: might not be sane, addRec() above does a commit() internally.
613#$dnsdb->{dbh}->rollback;
614$dnsdb->{dbh}->commit;
[818]615
616foreach my $t (keys %foundtypes) {
617 print "found $t: $foundtypes{$t}\n";
618}
Note: See TracBrowser for help on using the repository browser.