source: trunk/bind-import@ 871

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

/trunk

Apply wandering execute bits on bind-import

  • Property svn:executable set to *
File size: 16.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;
[822]33
[821]34my $dryrun = 0;
[808]35
36#print Dumper(\%reverse_typemap);
37
[817]38local $dnsdb->{dbh}->{AutoCommit} = 0;
39local $dnsdb->{dbh}->{RaiseError} = 1;
40
[819]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
[817]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
[819]56my @skipdefs;
57my $skipfile;
58
59GetOptions(
60 "skip=s" => \@skipdefs,
61 "skipfile=s" => \$skipfile,
[821]62 "test|dry-run" => \$dryrun,
[819]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.
[821]75 --dry-run
76 Do everything except finalize the import
[819]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
[808]84my $zname = shift @ARGV;
[817]85my $origzone = $zname;
[819]86die $usage if !$zname;
87
88my $zonefile = shift @ARGV;
89if(!$zonefile) {
90 $zonefile = '&STDIN';
91}
92
[808]93my $rev = 'n';
94my $zid;
[819]95my %foundtypes;
[808]96
[819]97if ($skipfile) {
98 if (-f $skipfile) {
99 open SKIP, "<$skipfile";
100 while (<SKIP>) {
[820]101 chomp;
[819]102 push @skipdefs, $_;
103 }
[820]104 close SKIP;
[819]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
[810]123my %amap;
124my %namemap;
[811]125my %cmap;
[810]126
[819]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
[815]134##fixme: this is wrong, BIND zone files are generally complete and we're adding. merging records is an entire fridge full of worms.
[816]135##fixme: for import, should arguably check for zone *non*existence
[821]136
[819]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";
[822]143#print "dbg: skip add revzone\n";
[821]144# $zname = new NetAddr::IP $zname;
145# $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
[819]146 }
[820]147 ($zid) = $dnsdb->{dbh}->selectrow_array("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id",
[819]148 undef, ($zname, $group, $status, $location, $serial));
[817]149
[819]150 } else {
151 $zid = $dnsdb->domainID($zname,':ANY:');
152 if ($zid) {
[822]153# die "zone $origzone already present, not merging records\n";
[821]154#print "dbg: skip add domain\n";
155 }
[822]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));
[808]158
[819]159 }
[808]160
[819]161 die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid;
[817]162
163
[819]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;
[810]168
[819]169 ##fixme: retrieve defttl from SOA record
170 my $zonettl = 900;
171 my $defttl = $zonettl;
172 my $origin = "$zname."; # to append to unqualified names
[808]173
[819]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 = '';
[812]178
[819]179 my $i = 0;
[813]180
[819]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?)
[817]188 # arguably should do some more targeted voodoo when parsing the SOA details
[813]189
[820]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 if ($rec =~ /\Q$_\E/) {
194 $skipflag = 1;
[824]195 # might want to do something with the skipped records someday
[820]196 }
197 }
198 next if $skipflag;
199
[817]200
[820]201$i++;
[822]202#last if $i > 17;
[818]203#print "line $i: ($rec)\n";
[819]204 if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
205 # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho
206 if ($macro eq 'TTL') {
207 $mdetail =~ s/\s*;.+$//;
208 if ($mdetail =~ /^\d+$/) {
209 $defttl = $mdetail;
210 } else {
211 warn "invalid \$TTL: $rec\n";
212 }
213 } elsif ($macro eq 'ORIGIN') {
[824]214 # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
[819]215 if ($mdetail =~ /\.$/) {
216 $origin = $mdetail;
217 } else {
218 # append current origin to unqualified origin
219 $origin = "$mdetail.$origin";
220 }
221 }
222 elsif ($macro eq 'GENERATE') {
[818]223# needs to generate CIDR range(s) as needed to match the start/stop points
[819]224 }
[824]225##fixme: should arguably handle $INCLUDE
[819]226 next;
[818]227 }
[815]228
[819]229 my $origrec = $rec;
[815]230
231 # leading whitespace indicates "same label as last record"
[819]232 if ($rec =~ /^\s/) {
233 $curlabel = $prevlabel;
[820]234#print " found empty label, using previous label\n";
[819]235 } else {
236 ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
237 }
[815]238
[824]239 # yay for special cases
240 $origin = '' if $origin eq '.';
[817]241
[824]242 # leading whitespace indicates "same label as last record"
243 if ($rec =~ /^\s/) {
244 $curlabel = $prevlabel;
245 } else {
246 ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
247 }
248
[819]249 # magic name!
250 $curlabel = "$zname." if $curlabel eq '@';
[815]251
[819]252 # append $ORIGIN if name is not fully qualified.
253 if ($curlabel !~ /\.$/) {
[824]254 $curlabel .= ".$origin";
[819]255 }
[815]256
[819]257 # check for zone scope. skip bad records.
258 if ($curlabel !~ /$zname.$/) {
259 warn "bad record $origrec, maybe bad \$ORIGIN?\n";
260# bweh? maybe this should die()?
[817]261last;
[819]262 next;
263 }
[815]264
[819]265 # trim the label, if any
266 $rec =~ s/^([\w\@_.-]*)\s+//;
[817]267
[824]268 # now that we've collected and trimmed off the record's label, unpack the class, TTL, and type.
269 # class and TTL may be omitted, and may appear in either class,TTL or TTL,class order.
[819]270 my $nc = 0;
[824]271 # we don't actually use these but we have to recognize them
[819]272 my $class = 'IN';
[824]273 # not preset as we need to detect whether it's present in the record
274 my $ttl;
[819]275 my $type;
276 my $badrec;
277 my $curatom = 'class';
278 eval {
279 for (; $nc < 3; $nc++) {
[824]280 last if $type; # short-circuit if we've got a type, further data is record-specific.
[819]281 my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
282 # should be safe?
283 last if !$atom;
284 if ($atom =~ /^\d+$/) {
285 if (defined($ttl)) {
[824]286 # we already have a TTL, so another all-numeric field is invalid.
[817]287 die "bad record ($origrec)\n";
[819]288 } else {
289 if ($curatom ne 'class' && $curatom ne 'ttl') {
290 die "bad record ($origrec)\n";
291 }
292 $curatom = 'ttl';
293 $ttl = $atom;
[817]294 }
[816]295 }
[819]296 elsif ($atom =~ /^IN|CS|CH|HS$/) {
297 if ($atom =~ /CS|CH|HS/) {
298 die "unsupported class $atom in record ($origrec)\n";
299 }
300 $curatom = 'class';
301 $class = $atom;
[817]302 }
[824]303 elsif ($atom =~ /^[A-Z\d-]+/) {
304 # check against dnsadmin's internal list of known DNS types.
[819]305 if ($reverse_typemap{$atom}) {
306 $type = $atom;
307 } else {
308 die "unknown type $atom in record ($origrec)\n";
309 }
[824]310 $curatom = 'type';
[817]311 }
[819]312 $rec =~ s/^$atom\s*//;
[817]313 }
[824]314 }; # record class/type/TTL loop
[819]315 if ($@) {
316 warn $@;
317 next;
[815]318 }
319
[818]320##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not.
[819]321 # set default TTL here so we can detect a TTL in the loop above
322 $ttl = $defttl if !defined($ttl);
[817]323
[816]324#next if $badrec;
[815]325
[824]326
327 # Just In Case we need the original rdata after we've sliced off more pieces
328 my $rdata = $rec;
[819]329 $prevlabel = $curlabel;
[815]330
[824]331 # part of the record data, when present
332 my $distance;
333 my $weight;
334 my $port;
[814]335
[824]336 my $itype = $reverse_typemap{$type};
[817]337
338
[824]339# See RFC1035 and successors for the canonical zone file format reference. We'll
340# ignore a number of edge cases because they're quite horrible to parse.
341# Of particular note is use of () to continue entries across multiple lines. Use
342# outside of SOA records is quite rare, although some compliant zone file
343# *writers* may use it on TXT records.
344# We'll also ignore the strict interpretation in SOA records in favour of spotting
345# the more standard pattern where the SOA serial, refresh, retry, expire, and minttl
346# numbers are in ():
[808]347
[824]348#example.invalid IN SOA test.example.invalid. test.example.invalid. (
349# 2020082500 ; serial
350# 7200 ; refresh (2 hours)
351# 900 ; retry (15 minutes)
352# 604800 ; expire (1 week)
353# 3600 ; minimum (1 hour)
354# )
[812]355
[824]356 $foundtypes{$type}++;
357
[818]358##fixme: strip trailing . here? dnsadmin's normalized internal format omits it, some validation fails or may go funky
359
[819]360 if ($type eq 'SOA') {
361 my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
362 die "Can't parse gibberish SOAish record: $rec\n" if !$ns;
363 $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
[812]364
[819]365 # Parse fields from $rdata if present
366 my @soabits;
367 my @soafirst = split /\s+/, $rdata;
368 while (my $f = shift @soafirst) {
[813]369 last if $f !~ /^\d/;
[819]370 push @soabits, $f;
[813]371 }
[819]372
373 # Read more lines if we don't have enough SOA fields filled
374 while (scalar(@soabits) < 5) {
375 my $tmp = <ZONEDATA>;
376 $tmp =~ s/^\s*//;
377 my @tmpsoa = split /\s+/, $tmp;
378 while (my $f = shift @tmpsoa) {
379 last if $f !~ /^\d/;
380 push @soabits, $f;
381 }
382 if (scalar(@soabits) == 5) {
383 last;
384 }
[813]385 }
[819]386 my @soavals = ($zid, "$adminmail:$ns", 6, join(':', @soabits), $ttl, $location);
387# host = $adminmail:$ns
388# val = join(':', @soabits);
389
390 if ($rev eq 'y') {
391 $dnsdb->{dbh}->do("UPDATE revzones SET zserial = ? WHERE rdns_id = ?", undef, $soabits[0], $zid);
392 $dnsdb->{dbh}->do("INSERT INTO records (rdns_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
393 } else {
394 $dnsdb->{dbh}->do("UPDATE domains SET zserial = ? WHERE domain_id = ?", undef, $soabits[0], $zid);
395 $dnsdb->{dbh}->do("INSERT INTO records (domain_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
396 }
[820]397 # skip insert at end of loop; SOA records are not handled by DNSDB::addRec()
398 next;
[819]399 } # SOA
[813]400
[818]401
[819]402 # we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown
[818]403
[819]404 elsif ($type eq 'A') {
[818]405#print "+$curlabel:$rdata:$ttl\n";
[819]406 }
[818]407
[819]408 elsif ($type eq 'NS') {
[818]409#print "\&$curlabel::$rdata:$ttl\n";
[819]410 }
[818]411
[819]412 elsif ($type eq 'CNAME') {
[818]413#print "C$curlabel:$rdata:$ttl\n";
[819]414 }
[818]415
[819]416 elsif ($type eq 'PTR') {
417 }
[818]418
[819]419 elsif ($type eq 'MX') {
420 ($distance) = ($rdata =~ /^(\d+)\s+/);
421 if (!defined($distance)) {
422 warn "malformed MX record: $origrec, skipping\n";
423 next;
424 }
425 $rdata =~ s/^\d+\s+//;
[818]426 }
427
[819]428 elsif ($type eq 'TXT') {
429 # Quotes may arguably be syntactically required, but they're not actually part of the record data
430 $rdata =~ s/^"//;
431 $rdata =~ s/"$//;
[818]432#print "'$curlabel:$rdata:$ttl\n";
[819]433 }
[808]434
[819]435 elsif ($type eq 'RP') {
436 }
[810]437
[819]438 elsif ($type eq 'AAAA') {
439 }
[818]440
[819]441 elsif ($type eq 'SRV') {
442 ($distance, $weight, $port) = ($rdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+/);
443 if ( !defined($distance) || !defined($weight) || !defined($port) ) {
444 warn "malformed SRV record: $origrec, skipping\n";
445 next;
446 }
447 $rdata =~ s/^\d+\s+\d+\s+\d+\s+//;
[818]448 }
449
[819]450 # basically a dedicated clone of TXT, not sure anything actually looks up type SPF.
451 # BIND autogenerates them from SPF TXT records.
452 elsif ($type eq 'SPF') {
453 # Quotes may arguably be syntactically required, but they're not actually part of the record data
454 $rdata =~ s/^"//;
455 $rdata =~ s/"$//;
456 }
[818]457
458# elsif ($type eq 'TXT') {
459# elsif ($type eq 'TXT') {
460
[819]461 else {
462 warn "unsupported type $type, may not import correctly\n";
463 }
[818]464
[821]465##fixme: need to dig out a subtransaction widget or extract a core of addRec() that doesn't dbh->commit(), so --dry-run works
466# unless ($dryrun) {
[819]467 my ($code, $msg);
[822]468
469# swap curlabel/rdata for revzones, because our internal metastorage only knows about "host" and "val"
470# keep the originals Just In Case(TM)
471$curlabel =~ s/\.$//; # dnsadmin doesn't store trailing dots
472my $inshost = $curlabel;
473my $insval = $rdata;
474if ($rev eq 'y') {
475 $inshost = $rdata;
476 $insval = $curlabel;
477}
478print "dbg: maybeip next ($insval)\n";
479my $addr = NetAddr::IP->new($insval) if DNSDB::_maybeip(\$insval);
480my $fields;
481my @vallist;
482
483($code,$msg) = $validators{$itype}($dnsdb, defrec => 'n', revrec => $rev, id => $zid,
484 host => \$inshost, rectype => \$itype, val => \$insval, addr => $addr,
485 dist => \$distance, port => \$port, weight => \$weight,
486 fields => \$fields, vallist => \@vallist);
487
488# Add standard common fields
489$fields .= "host,type,val,ttl,".DNSDB::_recparent('n',$rev);
490push @vallist, ($inshost,$itype,$insval,$ttl,$zid);
491
492my $vallen = '?'.(',?'x$#vallist);
493
494print "INSERT INTO records ($fields) VALUES ($vallen);\n".join("','", @vallist)."\n";
495
496# if ($rev eq 'n') {
497# ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl,
498# $location, undef, undef, $distance, $weight, $port);
499# } else {
500# ($code,$msg) = $dnsdb->addRec('y', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl,
501# $location, undef, undef, $distance, $weight, $port);
502# }
[820]503 print "$code: $msg\n" if $code ne 'OK';
[821]504# }
[819]505# $i++;
[809]506 }
[819]507
[821]508 if ($dryrun) {
509 $dnsdb->{dbh}->rollback;
510 } else {
511 $dnsdb->{dbh}->commit;
512 }
[819]513};
514if ($@) {
515 warn "Error parsing zonefile: $@\n";
516 $dnsdb->{dbh}->rollback;
517 exit;
[808]518}
[810]519
520#print Dumper \%amap;
[811]521#print Dumper \%namemap;
522#print Dumper \%cmap;
523
[818]524#foreach my $n (keys %amap) {
525# foreach my $ip (@{$amap{$n}}) {
526##print "$ip $n\n";
527# push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
528# }
529#}
[810]530
[818]531#foreach my $c (keys %cmap) {
532# if ($amap{$c}) {
533# print Dumper(\@{$amap{$c}});
534# }
535## print $amap{$c};
536#}
[811]537
538# cname targ -> IP
539
540#foreach my $ip (sort keys %namemap) {
541# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
542#}
543
[819]544##fixme: might not be sane, addRec() above does a commit() internally.
545#$dnsdb->{dbh}->rollback;
546$dnsdb->{dbh}->commit;
[818]547
548foreach my $t (keys %foundtypes) {
549 print "found $t: $foundtypes{$t}\n";
550}
Note: See TracBrowser for help on using the repository browser.