source: trunk/bind-import@ 819

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

/trunk

Twelfth sampled iteration of bind-import

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