source: trunk/bind-import@ 822

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

/trunk

Fifteenth sampled iteration of bind-import

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