source: trunk/bind-import@ 843

Last change on this file since 843 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
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 # 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;
195 # might want to do something with the skipped records someday
196 }
197 }
198 next if $skipflag;
199
200
201$i++;
202#last if $i > 17;
203#print "line $i: ($rec)\n";
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') {
214 # $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
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') {
223# needs to generate CIDR range(s) as needed to match the start/stop points
224 }
225##fixme: should arguably handle $INCLUDE
226 next;
227 }
228
229 my $origrec = $rec;
230
231 # leading whitespace indicates "same label as last record"
232 if ($rec =~ /^\s/) {
233 $curlabel = $prevlabel;
234#print " found empty label, using previous label\n";
235 } else {
236 ($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
237 }
238
239 # yay for special cases
240 $origin = '' if $origin eq '.';
241
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
249 # magic name!
250 $curlabel = "$zname." if $curlabel eq '@';
251
252 # append $ORIGIN if name is not fully qualified.
253 if ($curlabel !~ /\.$/) {
254 $curlabel .= ".$origin";
255 }
256
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()?
261last;
262 next;
263 }
264
265 # trim the label, if any
266 $rec =~ s/^([\w\@_.-]*)\s+//;
267
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.
270 my $nc = 0;
271 # we don't actually use these but we have to recognize them
272 my $class = 'IN';
273 # not preset as we need to detect whether it's present in the record
274 my $ttl;
275 my $type;
276 my $badrec;
277 my $curatom = 'class';
278 eval {
279 for (; $nc < 3; $nc++) {
280 last if $type; # short-circuit if we've got a type, further data is record-specific.
281 my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
282 # should be safe?
283 last if !$atom;
284 if ($atom =~ /^\d+$/) {
285 if (defined($ttl)) {
286 # we already have a TTL, so another all-numeric field is invalid.
287 die "bad record ($origrec)\n";
288 } else {
289 if ($curatom ne 'class' && $curatom ne 'ttl') {
290 die "bad record ($origrec)\n";
291 }
292 $curatom = 'ttl';
293 $ttl = $atom;
294 }
295 }
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;
302 }
303 elsif ($atom =~ /^[A-Z\d-]+/) {
304 # check against dnsadmin's internal list of known DNS types.
305 if ($reverse_typemap{$atom}) {
306 $type = $atom;
307 } else {
308 die "unknown type $atom in record ($origrec)\n";
309 }
310 $curatom = 'type';
311 }
312 $rec =~ s/^$atom\s*//;
313 }
314 }; # record class/type/TTL loop
315 if ($@) {
316 warn $@;
317 next;
318 }
319
320##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not.
321 # set default TTL here so we can detect a TTL in the loop above
322 $ttl = $defttl if !defined($ttl);
323
324#next if $badrec;
325
326
327 # Just In Case we need the original rdata after we've sliced off more pieces
328 my $rdata = $rec;
329 $prevlabel = $curlabel;
330
331 # part of the record data, when present
332 my $distance;
333 my $weight;
334 my $port;
335
336 my $itype = $reverse_typemap{$type};
337
338
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 ():
347
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# )
355
356 $foundtypes{$type}++;
357
358##fixme: strip trailing . here? dnsadmin's normalized internal format omits it, some validation fails or may go funky
359
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*//;
364
365 # Parse fields from $rdata if present
366 my @soabits;
367 my @soafirst = split /\s+/, $rdata;
368 while (my $f = shift @soafirst) {
369 last if $f !~ /^\d/;
370 push @soabits, $f;
371 }
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 }
385 }
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 }
397 # skip insert at end of loop; SOA records are not handled by DNSDB::addRec()
398 next;
399 } # SOA
400
401
402 # we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown
403
404 elsif ($type eq 'A') {
405#print "+$curlabel:$rdata:$ttl\n";
406 }
407
408 elsif ($type eq 'NS') {
409#print "\&$curlabel::$rdata:$ttl\n";
410 }
411
412 elsif ($type eq 'CNAME') {
413#print "C$curlabel:$rdata:$ttl\n";
414 }
415
416 elsif ($type eq 'PTR') {
417 }
418
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+//;
426 }
427
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/"$//;
432#print "'$curlabel:$rdata:$ttl\n";
433 }
434
435 elsif ($type eq 'RP') {
436 }
437
438 elsif ($type eq 'AAAA') {
439 }
440
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+//;
448 }
449
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 }
457
458# elsif ($type eq 'TXT') {
459# elsif ($type eq 'TXT') {
460
461 else {
462 warn "unsupported type $type, may not import correctly\n";
463 }
464
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) {
467 my ($code, $msg);
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# }
503 print "$code: $msg\n" if $code ne 'OK';
504# }
505# $i++;
506 }
507
508 if ($dryrun) {
509 $dnsdb->{dbh}->rollback;
510 } else {
511 $dnsdb->{dbh}->commit;
512 }
513};
514if ($@) {
515 warn "Error parsing zonefile: $@\n";
516 $dnsdb->{dbh}->rollback;
517 exit;
518}
519
520#print Dumper \%amap;
521#print Dumper \%namemap;
522#print Dumper \%cmap;
523
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#}
530
531#foreach my $c (keys %cmap) {
532# if ($amap{$c}) {
533# print Dumper(\@{$amap{$c}});
534# }
535## print $amap{$c};
536#}
537
538# cname targ -> IP
539
540#foreach my $ip (sort keys %namemap) {
541# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
542#}
543
544##fixme: might not be sane, addRec() above does a commit() internally.
545#$dnsdb->{dbh}->rollback;
546$dnsdb->{dbh}->commit;
547
548foreach my $t (keys %foundtypes) {
549 print "found $t: $foundtypes{$t}\n";
550}
Note: See TracBrowser for help on using the repository browser.