source: trunk/bind-import@ 813

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

/trunk

Sixth sampled iteration of bind-import

File size: 8.5 KB
Line 
1#!/usr/bin/perl
2# Import a BIND zone file
3##
4# Copyright 2020 Kris Deugau <kdeugau@deepnet.cx>
5#
6# This program is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>.
18##
19
20use strict;
21use warnings;
22use Data::Dumper;
23
24use lib '.';
25use DNSDB;
26
27my $dnsdb = new DNSDB;
28my $doimport = 0;
29
30#print Dumper(\%reverse_typemap);
31
32my $zname = shift @ARGV;
33die "usage: bind-import zonename\n" if !$zname;
34my $rev = 'n';
35my $zid;
36
37my %amap;
38my %namemap;
39my %cmap;
40
41if ($zname =~ /\.arpa\.?$/ || $zname =~ m,^[\d./]+$,) {
42 $rev = 'y';
43 $zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
44 $zid = $dnsdb->revID($zname,':ANY:');
45 if ($zid) {
46 $zname = new NetAddr::IP $zname;
47 $zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
48 }
49} else {
50 $zid = $dnsdb->domainID($zname,':ANY:');
51}
52
53die "zone $zname not on file\n" if !$zid;
54
55# still no sane way to expose a human-friendly view tag on the command line.
56my $view = shift @ARGV;
57$view = '' if !$view;
58
59##fixme: retrieve defttl from SOA record
60my $zonettl = 900;
61my $defttl = $zonettl;
62my $recbase = $zname; # to append to unqualified names
63
64# need to spin up a full state machine-ish thing, because BIND zone files are all about context
65# see ch4, p56-72 in the grasshopper book
66my $prevlabel = '';
67my $curlabel = '';
68
69my $i = 0;
70
71while (<>) {
72 chomp;
73 next if /^\s*$/;
74 next if /^\s*;/; # comments
75 next if /^\s*\(/; # SOA closing. arguably should do some more targeted voodoo when parsing the SOA details
76
77 if (my ($macro,$mdetail) = (/^\s*\$(TTL|ORIGIN|INCLUDE|GENERATE)\s+(.+)/) ) {
78 # macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho
79 if ($macro eq 'TTL') {
80 if ($mdetail =~ /^\d+$/) {
81 $defttl = $mdetail;
82 } else {
83 warn "invalid \$TTL: $_\n";
84 }
85 } elsif ($macro eq 'ORIGIN') {
86##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie
87# between . and the root domain we were told we're importing; anyone using such
88# a mess outside the root servers is clearly insane
89# handled cases:
90# $ORIGIN .
91# $ORIGIN [zonedomain].
92# $ORIGIN [subdomain.zonedomain].
93 if ($mdetail eq '.' || $mdetail =~ /$zname\.$/ || $zname =~ /$mdetail\.$/) {
94 $recbase = $mdetail;
95 } else {
96 # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
97 die "bad \$ORIGIN: $_\n";
98 }
99 }
100 # not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types)
101 next;
102 }
103 my $origrec = $_;
104 # skip stale records that have no value
105 next if /^ip-192-168-1(12|20)-\d+/;
106 next if /ip.add.re.\d+\s*$/;
107 # records must begin in the first column, no leading whitespace
108 my ($name) = /^([\w\@_.-]+)\s/;
109
110print "$i ($_)\n\t$name";
111# foo IN A 1.2.3.4
112# IN A 2.3.4.5
113# =
114# foo.zone. IN A 1.2.3.4
115# foo.zone. IN A 2.3.4.5
116
117
118 # magic name!
119 $name = $zname if $name eq '@';
120
121 # append zone name to record name if missing AND not dot-terminated;
122 # this happens automagically for forward zones, but not reverse because Reasons. (fixme?)
123 # suck up and deal with the error if the dot-termiated name is out of zone; should be
124 # impossible with valid BIND zone file but...
125 if ($name !~ /\.$/) {
126 $name .= ".$zname" if $name !~ /$zname$/;
127 } else {
128 warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
129 next;
130 }
131
132 # fatal error. if there is no previous label, we can by definition not set
133 # the current label based on it. this can only happen on the very first
134 # record, following records will *ALWAYS* have a previous label
135 if (/^\s+[A-Z]/) {
136 die "bad first record ($_): no previous label\n" if !$prevlabel;
137 $name = $prevlabel;
138 }
139
140last if $i > 2;
141
142 s/^([\w\@_.-]+)\s+//;
143
144$prevlabel = $curlabel;
145# by convention the optional TTL leads the optional class, but they're apparently swappable.
146 my ($ttl) = /^(\d+)?\s/;
147 if (defined $ttl) {
148 # TTL may be zero
149 s/(\d+)?\s+//;
150 } else {
151 # Fall back to zone default TTL
152 $ttl = $zonettl;
153 }
154 my ($class) = /^(IN|CS|CH|HS|\d+)\s/;
155 if (defined $class) {
156 if ($class =~ /\d+/) {
157
158 }
159 if ($class ne 'IN') {
160 warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
161 next;
162 }
163 s/(IN|CS|CH|HS)\s+//;
164 } else {
165 $class = 'IN';
166 }
167 my ($type) = /([A-Z-]+)\s/;
168 if (!$reverse_typemap{$type}) {
169 warn "Unknown type $type, skipping\n\t($_)\n";
170 next;
171 }
172 my $itype = $reverse_typemap{$type};
173 s/([A-Z-]+)\s+//;
174 chomp;
175 my $rdata = $_;
176
177 # SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records:
178 #@ IN SOA test.example.invalid. test.example.invalid. (2020082500 7200 900 604800 3600)
179 # IN NS olddns.example.com.
180 # IN MX 1 fred.foo.bar.invalid.
181 #foo IN A 192.168.16.45
182 # AXFR'ed zone file gets written as
183 #$ORIGIN .
184 #$TTL 3600 ; 1 hour
185 #example.invalid IN SOA test.example.invalid. test.example.invalid. (
186 # 2020082500 ; serial
187 # 7200 ; refresh (2 hours)
188 # 900 ; retry (15 minutes)
189 # 604800 ; expire (1 week)
190 # 3600 ; minimum (1 hour)
191 # )
192 # NS olddns.example.com.
193 # MX 1 fred.foo.bar.invalid.
194 #$ORIGIN example.invalid.
195 #foo A 192.168.16.45
196
197 if ($type eq 'SOA') {
198 my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
199 die "Can't parse gibberish SOAish record: $_\n" if !$ns;
200 $rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
201
202 # There are probably more efficient ways to do this but the SOA record
203 # format is essentially character based, not line-based.
204 # In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
205
206 # Parse fields from $rdata if present
207 my @soabits;
208 my @soafirst = split /\s+/, $rdata;
209 while (my $f = shift @soafirst) {
210 last if $f !~ /^\d/;
211 push @soabits, $f;
212 }
213
214 # Read more lines if we don't have enough SOA fields filled
215 while (scalar(@soabits) < 5) {
216 my $tmp = <>;
217 $tmp =~ s/^\s*//;
218 my @tmpsoa = split /\s+/, $tmp;
219 while (my $f = shift @tmpsoa) {
220 last if $f !~ /^\d/;
221 push @soabits, $f;
222 }
223 if (scalar(@soabits) == 5) {
224 last;
225 }
226 }
227 } # SOA
228
229 # Quotes may arguably be syntactically required, but they're not actually part of the record data
230 elsif ($type eq 'TXT') {
231 $rdata =~ s/^"//;
232 $rdata =~ s/"$//;
233 }
234
235# temp hack for hosts file
236elsif ($type eq 'A') {
237# if ($amap{$name}) {
238# print "urp: dupe name $name $rdata\n";
239# } else {
240 push @{$amap{$name}}, $rdata;
241# }
242 push @{$namemap{$rdata}}, $name;
243}
244elsif ($type eq 'CNAME') {
245 push @{$cmap{$rdata}}, $name;
246}
247
248no warnings qw(uninitialized);
249#print "parsed: '$name' '$class' '$ttl' '$type'->'$itype' '$rdata'\n";
250#print;
251#;imap IN 900 CNAME deepnet.cx.
252##fixme: not sure how to handle the case where someone leaves off the class.
253 if ($doimport) {
254 my ($code, $msg);
255 if ($rev eq 'n') {
256 ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$name, \$itype, \$rdata, $ttl);
257 } else {
258 ($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$rdata, \$itype, \$name, $ttl);
259 }
260 print "$code: $msg\n";
261 }
262 $i++;
263}
264
265
266#print Dumper \%amap;
267#print Dumper \%namemap;
268#print Dumper \%cmap;
269
270foreach my $n (keys %amap) {
271 foreach my $ip (@{$amap{$n}}) {
272#print "$ip $n\n";
273 push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
274 }
275}
276
277foreach my $c (keys %cmap) {
278 if ($amap{$c}) {
279 print Dumper(\@{$amap{$c}});
280 }
281# print $amap{$c};
282}
283
284# cname targ -> IP
285
286#foreach my $ip (sort keys %namemap) {
287# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
288#}
289
Note: See TracBrowser for help on using the repository browser.