#!/usr/bin/perl # Import a BIND zone file ## # Copyright 2020 Kris Deugau # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ## use strict; use warnings; use Data::Dumper; use lib '.'; use DNSDB; my $dnsdb = new DNSDB; my $doimport = 0; #print Dumper(\%reverse_typemap); my $zname = shift @ARGV; die "usage: bind-import zonename\n" if !$zname; my $rev = 'n'; my $zid; my %amap; my %namemap; my %cmap; if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) { $rev = 'y'; $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/; $zid = $dnsdb->revID($zname,':ANY:'); if ($zid) { $zname = new NetAddr::IP $zname; $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa'); } } else { $zid = $dnsdb->domainID($zname,':ANY:'); } die "zone $zname not on file\n" if !$zid; # still no sane way to expose a human-friendly view tag on the command line. my $view = shift @ARGV; $view = '' if !$view; ##fixme: retrieve defttl from SOA record my $zonettl = 900; my $defttl = $zonettl; my $recbase = $zname; # to append to unqualified names # need to spin up a full state machine-ish thing, because BIND zone files are all about context # see ch4, p56-72 in the grasshopper book my $prevlabel = ''; my $curlabel = ''; my $i = 0; while (<>) { chomp; next if /^\s*$/; next if /^\s*;/; # comments next if /^\s*\(/; # SOA closing. arguably should do some more targeted voodoo when parsing the SOA details if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) { # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho if ($macro eq 'TTL') { if ($mdetail =~ /^\d+$/) { $defttl = $mdetail; } else { warn "invalid \$TTL: $_\n"; } } elsif ($macro eq 'ORIGIN') { ##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie # between . and the root domain we were told we're importing; anyone using such # a mess outside the root servers is clearly insane # handled cases: # $ORIGIN . # $ORIGIN [zonedomain]. # $ORIGIN [subdomain.zonedomain]. if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) { $recbase = $mdetail; } else { # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records. die "bad \$ORIGIN: $_\n"; } } # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types) next; } my $origrec = $_; # skip stale records that have no value next if /^ip-192-168-1(12|20)-\d+/; next if /ip.add.re.\d+\s*$/; # records must begin in the first column, no leading whitespace my ($name) = /^([\w\@_.-]+)\s/; # foo IN A 1.2.3.4 # IN A 2.3.4.5 # = # foo.zone. IN A 1.2.3.4 # foo.zone. IN A 2.3.4.5 # "empty" label records inherit the previous label # RRs start in the first column by definition, so leading whitespace indicates an inherited label if (/^\s+/) { # fatal error. if there is no previous label, we can by definition not set # the current label based on it. this can only happen on the very first # record, following records will *ALWAYS* have a previous label die "bad first record ($_): no previous label\n" if !$prevlabel; $name = $prevlabel; } print "$i ($_)\n\t$name"; # magic name! $name = $zname if $name eq '@'; # append zone name to record name if missing AND not dot-terminated; # this happens automagically for forward zones, but not reverse because Reasons. (fixme?) # suck up and deal with the error if the dot-termiated name is out of zone; should be # impossible with valid BIND zone file but... if ($name !~ /\.$/) { $name .= ".$zname" if $name !~ /$zname$/; } else { warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/; next; } last if $i > 5; s/^([\w\@_.-]+)\s+//; ##fixme: drop curlabel? not sure it's needed $curlabel = $name; $prevlabel = $curlabel; ##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not. # by convention the optional TTL leads the optional class, but they're apparently swappable. my ($ttl) = /^(\d+)?\s/; if (defined $ttl) { # TTL may be zero s/(\d+)?\s+//; } else { # Fall back to zone default TTL $ttl = $zonettl; } my ($class) = /^(IN|CS|CH|HS|\d+)\s/; if (defined $class) { if ($class =~ /\d+/) { } if ($class ne 'IN') { warn "Non-Internet class ($class) records not supported:\n\t$origrec\n"; next; } s/(IN|CS|CH|HS)\s+//; } else { $class = 'IN'; } my ($type) = /([A-Z-]+)\s/; if (!$reverse_typemap{$type}) { warn "Unknown type $type, skipping\n\t($_)\n"; next; } my $itype = $reverse_typemap{$type}; s/([A-Z-]+)\s+//; chomp; my $rdata = $_; # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records: #@ IN SOA test.example.invalid. test.example.invalid. (2020082500 7200 900 604800 3600) # IN NS olddns.example.com. # IN MX 1 fred.foo.bar.invalid. #foo IN A 192.168.16.45 # AXFR'ed zone file gets written as #$ORIGIN . #$TTL 3600 ; 1 hour #example.invalid IN SOA test.example.invalid. test.example.invalid. ( # 2020082500 ; serial # 7200 ; refresh (2 hours) # 900 ; retry (15 minutes) # 604800 ; expire (1 week) # 3600 ; minimum (1 hour) # ) # NS olddns.example.com. # MX 1 fred.foo.bar.invalid. #$ORIGIN example.invalid. #foo A 192.168.16.45 if ($type eq 'SOA') { my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/); die "Can't parse gibberish SOAish record: $_\n" if !$ns; $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//; # There are probably more efficient ways to do this but the SOA record # format is essentially character based, not line-based. # In theory the SOA serial etc may be spread over up to 5 lines, in any combination. # Parse fields from $rdata if present my @soabits; my @soafirst = split /\s+/, $rdata; while (my $f = shift @soafirst) { last if $f !~ /^\d/; push @soabits, $f; } # Read more lines if we don't have enough SOA fields filled while (scalar(@soabits) < 5) { my $tmp = <>; $tmp =~ s/^\s*//; my @tmpsoa = split /\s+/, $tmp; while (my $f = shift @tmpsoa) { last if $f !~ /^\d/; push @soabits, $f; } if (scalar(@soabits) == 5) { last; } } } # SOA # Quotes may arguably be syntactically required, but they're not actually part of the record data elsif ($type eq 'TXT') { $rdata =~ s/^"//; $rdata =~ s/"$//; } # temp hack for hosts file elsif ($type eq 'A') { # if ($amap{$name}) { # print "urp: dupe name $name $rdata\n"; # } else { push @{$amap{$name}}, $rdata; # } push @{$namemap{$rdata}}, $name; } elsif ($type eq 'CNAME') { push @{$cmap{$rdata}}, $name; } no warnings qw(uninitialized); #print "parsed: '$name' '$class' '$ttl' '$type'->'$itype' '$rdata'\n"; #print; #;imap IN 900 CNAME deepnet.cx. ##fixme: not sure how to handle the case where someone leaves off the class. if ($doimport) { my ($code, $msg); if ($rev eq 'n') { ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$name, \$itype, \$rdata, $ttl); } else { ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$name, $ttl); } print "$code: $msg\n"; } $i++; } #print Dumper \%amap; #print Dumper \%namemap; #print Dumper \%cmap; foreach my $n (keys %amap) { foreach my $ip (@{$amap{$n}}) { #print "$ip $n\n"; push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}}; } } foreach my $c (keys %cmap) { if ($amap{$c}) { print Dumper(\@{$amap{$c}}); } # print $amap{$c}; } # cname targ -> IP #foreach my $ip (sort keys %namemap) { # print "$ip ".join(' ', @{$namemap{$ip}})."\n"; #}