source: trunk/DNSDB/ExportBIND.pm@ 863

Last change on this file since 863 was 863, checked in by Kris Deugau, 20 months ago

/trunk

BIND export, unwinding dev saves, 15 of many many

  • Refine PTR record printing to actually print BIND-format records
  • Add A+PTR output, which just calls recursively for A or PTR records
  • Property svn:keywords set to Date Rev Author Id
File size: 15.1 KB
Line 
1# dns/trunk/DNSDB/ExportBIND.pm
2# BIND data export/publication
3# Call through DNSDB.pm's export() sub
4##
5# $Id: ExportBIND.pm 863 2022-09-20 20:25:48Z kdeugau $
6# Copyright 2022 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
22package DNSDB::ExportBIND;
23
24use strict;
25use warnings;
26
27sub export {
28 # expected to be a DNSDB object
29 my $dnsdb = shift;
30
31 # to be a hash of views/locations, containing lists of zones
32 my %viewzones;
33
34 # allow for future exports of subgroups of records
35 my $viewlist = $dnsdb->getLocList(curgroup => 1);
36
37 my $soasth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
38 "FROM records WHERE rdns_id=? AND type=6");
39 my $recsth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
40 "FROM records WHERE rdns_id=? AND NOT type=6 ".
41 "ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val)");
42
43 # Fetch active zone list
44 my $revsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,revnet,status,changed,default_location FROM revzones WHERE status=1 ".
45 "ORDER BY masklen(revnet) DESC, rdns_id");
46 # Unflag changed zones, so we can maybe cache the export and not redo everything every time
47 my $zonesth = $dnsdb->{dbh}->prepare("UPDATE revzones SET changed='n' WHERE rdns_id=?");
48 $revsth->execute();
49 while (my ($revid,$revzone,$revstat,$changed,$defloc) = $revsth->fetchrow_array) {
50 my $cidr = NetAddr::IP->new($revzone);
51 my $zfile = $cidr->network->addr."-".$cidr->masklen;
52# my $cachefile = "$dnsdb->{exportcache}/$zfile";
53# my $tmpcache = "$dnsdb->{exportcache}/tmp.$zfile.$$";
54 my $tmpcache = "tmp.$zfile.$$"; # safety net. don't overwrite a previous known-good file
55
56##fixme: convert logical revzone into .arpa name? maybe take a slice of showrev_arpa?
57##fixme: need to bodge logical non-octet-boundary revzones into octet-boundary revzones
58##fixme: do we do cache files? views balloon the file count stupidly
59## foreach $octetzone $cidr->split(octet-boundary)
60## loclist = SELECT DISTINCT location FROM records WHERE rdns_id = $zid AND inetlazy(val) <<= $octetzone
61
62#printf "non-octet? %s, %i\n", $cidr->masklen, $cidr->masklen % 8;
63
64
65 eval {
66
67 my $arpazone = DNSDB::_ZONE($cidr, 'ZONE', 'r', '.').($cidr->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
68
69 # write fresh records if:
70 # - we are not using the cache
71 # - force_refresh is set
72 # - the zone has changed
73 # - the cache file does not exist
74 # - the cache file is empty
75 if (!$dnsdb->{usecache} || $dnsdb->{force_refresh} || $changed || !-e $cachefile || -z $cachefile) {
76 if ($dnsdb->{usecache}) {
77 open ZONECACHE, ">$tmpcache" or die "Error creating temporary file $tmpcache: $!\n";
78 $zonefilehandle = *ZONECACHE;
79 }
80
81 # fetch a list of views/locations present in the zone. we need to publish a file for each one.
82 # in the event that no locations are present (~~ $viewlist is empty), /%view collapses to nothing in the zone path
83 my (@loclist) = $dnsdb->{dbh}->selectrow_array("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
84 push @loclist, $defloc unless grep /$defloc/, @loclist;
85 my $zonepath = $dnsdb->{bind_export_reverse_zone_path};
86 my %zonefiles; # to be a hash of file handles.
87##fixme: need to open separate zone files for aggregated metazones eg /22 or /14
88 foreach my $loc (@loclist) {
89 my $zfilepath = $zonepath;
90 $zfilepath =~ s/\%view/$loc/;
91 $zfilepath =~ s/\%zone/$revzone/;
92 $zfilepath =~ s/\%arpazone/$arpazone/;
93 # Just In Case(TM)
94 $zfilepath =~ s,[^\w./-],_,g;
95 open $zonefiles{$loc}, ">", $zfilepath;
96 printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime);
97print "open zonefile for '$loc', '$zfilepath'\n";
98 }
99
100 # need to fetch this separately since the rest of the records all (should) have real IPs in val
101 $soasth->execute($revid);
102 my (@zsoa) = $soasth->fetchrow_array();
103 printrec_bind(\%zonefiles, $zsoa[7], 'y', \@loclist, $revzone,
104 $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
105
106 $recsth->execute($revid);
107 my $fullzone = _ZONE($tmpzone, 'ZONE', 'r', '.').($tmpzone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
108
109 while (my ($host, $type, $val, $dist, $weight, $port, $ttl, $recid, $loc, $stamp, $expires, $stampactive)
110 = $recsth->fetchrow_array) {
111 next if $recflags{$recid};
112
113 # Check for out-of-zone data
114 if ($val =~ /\.arpa$/) {
115 # val is non-IP
116 if ($val !~ /$fullzone$/) {
117 warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
118 next;
119 }
120 } else {
121 my $ipval = new NetAddr::IP $val;
122 if (!$tmpzone->contains($ipval)) {
123 warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
124 next;
125 }
126 } # is $val a raw .arpa name?
127
128 # Spaces are evil.
129 $val =~ s/^\s+//;
130 $val =~ s/\s+$//;
131 if ($typemap{$type} ne 'TXT') {
132 # Leading or trailng spaces could be legit in TXT records.
133 $host =~ s/^\s+//;
134 $host =~ s/\s+$//;
135 }
136
137 printrec_bind($zonefilehandle, $recid, 'y', \%recflags, $revzone,
138 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
139
140 $recflags{$recid} = 1;
141
142 } # while ($recsth)
143
144 if ($dnsdb->{usecache}) {
145 close ZONECACHE; # force the file to be written
146 # catch obvious write errors that leave an empty temp file
147 if (-s $tmpcache) {
148 rename $tmpcache, $cachefile
149 or die "Error overwriting cache file $cachefile with temporary file: $!\n";
150 }
151 }
152
153 } # if $changed or cache filesize is 0
154
155 };
156 if ($@) {
157 die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
158 # error! something borked, and we should be able to fall back on the old cache file
159 # report the error, somehow.
160 } else {
161 # mark zone as unmodified. Only do this if no errors, that way
162 # export failures should recover a little more automatically.
163 $zonesth->execute($revid);
164 }
165
166# if ($dnsdb->{usecache}) {
167# # We've already made as sure as we can that a cached zone file is "good",
168# # although possibly stale/obsolete due to errors creating a new one.
169# eval {
170# open CACHE, "<$cachefile" or die $!;
171# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
172# close CACHE;
173# };
174# die $@ if $@;
175# }
176
177
178
179 } # revsth->fetch
180
181
182 # Write the view configuration last, because otherwise we have to be horribly inefficient
183 # at figuring out which zones are visible/present in which views
184 if ($viewlist) {
185 my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
186 open BINDCONF, ">", $tmpconf;
187
188 foreach my $view (@{$viewlist}) {
189#print Dumper($view);
190 print BINDCONF "view $view->{location} {\n";
191# print "view $view->{location} {\n";
192 # could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
193 # note that some semantics of data visibility need to be handled by the record export, since it's
194 # not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
195 # same as a BIND view with match-clients { any; };
196 if ($view->{iplist}) {
197 print BINDCONF " match-clients { ".join("; ", $view->iplist)."; };\n";
198# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
199 } else {
200 print BINDCONF " match-clients { any; };\n";
201# print " match-clients { any; };\n";
202 }
203 foreach my $zone (@{$viewzones{$view->{location}}}) {
204##fixme: notify settings, maybe per-zone?
205 print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
206 }
207 print "};\n\n";
208 } # foreach @$viewlist
209 rename $tmpconf, $dnsdb->{bind_zone_conf};
210 } # if $viewlist
211
212} # export()
213
214
215# Print individual records in BIND format
216sub printrec_bind {
217 my $dnsdb = shift;
218 my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
219 $loc, $stamp, $expires, $stampactive) = @_;
220
221 # Just In Case something is lingering in the DB
222 $loc = '' if !$loc;
223
224 ## And now to the records!
225
226 if ($typemap{$type} eq 'SOA') {
227 # host contains pri-ns:responsible
228 # val is abused to contain refresh:retry:expire:minttl
229 # let's be explicit about abusing $host and $val
230 my ($email, $primary) = (split /:/, $host)[0,1];
231 my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
232 my $serial = 0; # fail less horribly than leaving it empty?
233 # just snarfing the right SOA serial for the zone type
234 if ($revrec eq 'y') {
235 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
236 } else {
237 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
238 } # revrec <> 'y'
239 # suppress a "uninitialized value" warning. should be impossible but...
240 # abuse hours as the last digit pair of the serial for simplicity
241##fixme?: alternate SOA serial schemes?
242 $serial = strftime("%Y%m%d%H", localtime()) if !$serial;
243 $primary .= "." if $primary !~ /\.$/;
244 $email .= "." if $email !~ /\.$/;
245# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
246# or die $!;
247 print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
248 or die "couldn't write $zone SOA: $!";
249 } # SOA
250
251 elsif ($typemap{$type} eq 'A') {
252# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
253# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
254 print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
255 } # A
256
257 elsif ($typemap{$type} eq 'NS') {
258 if ($revrec eq 'y') {
259 $val = NetAddr::IP->new($val);
260
261##fixme: conversion for sub-/24 delegations in reverse zones?
262# if (!$val->{isv6} && ($val->masklen > 24)) {
263# }
264
265# print {$zonefiles->{$loc}} "$zone $ttl IN NS $host\n";
266 print "$zone $ttl IN NS $host\n" or die $!;
267
268 } else {
269# print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
270 }
271 } # NS
272
273 elsif ($typemap{$type} eq 'AAAA') {
274# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
275 my $altgrp = 0;
276 my @altconv;
277 # Split in to up to 8 groups of hex digits (allows for IPv6 :: 0-collapsing)
278 foreach (split /:/, $val) {
279 if (/^$/) {
280 # flag blank entry; this is a series of 0's of (currently) unknown length
281 $altconv[$altgrp++] = 's';
282 } else {
283 # call sub to convert 1-4 hex digits to 2 string-rep octal bytes
284 $altconv[$altgrp++] = octalize($_)
285 }
286 }
287 my $prefix = ":$host:28:";
288 foreach my $octet (@altconv) {
289 # if not 's', output
290 $prefix .= $octet unless $octet =~ /^s$/;
291 # if 's', output (9-array length)x literal '\000\000'
292 $prefix .= '\000\000'x(9-$altgrp) if $octet =~ /^s$/;
293 }
294 print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
295 } # AAAA
296
297 elsif ($typemap{$type} eq 'TXT') {
298# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
299 print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
300 } # TXT
301
302 elsif ($typemap{$type} eq 'CNAME') {
303# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
304 print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
305 } # CNAME
306
307 elsif ($typemap{$type} eq 'SRV') {
308# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
309 print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
310 } # SRV
311
312 elsif ($typemap{$type} eq 'RP') {
313# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
314 print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
315 } # RP
316
317
318 elsif ($typemap{$type} eq 'PTR') {
319# $$recflags{$val}++;
320 if ($revrec eq 'y') {
321
322 if ($val =~ /\.arpa$/) {
323 # someone put in the formal .arpa name. humor them.
324 print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
325 } else {
326 $zone = NetAddr::IP->new($zone);
327 if (!$zone->{isv6} && $zone->masklen > 24) {
328 # sub-octet v4 zone
329 ($val) = ($val =~ /\.(\d+)$/);
330 print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
331 " $ttl IN PTR $host\n"
332 or die $!;
333 } else {
334 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
335 $val = NetAddr::IP->new($val);
336 print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
337 " $ttl IN PTR $host\n"
338 or die $!;
339
340 }
341 } # non-".arpa" $val
342
343 } else {
344 # PTRs in forward zones are less bizarre and insane than some other record types
345 # in reverse zones... OTOH we can't validate them any which way, so we cross our
346 # fingers and close our eyes and make it Someone Else's Problem.
347 print {$zonefiles->{$loc}} "^$host:$val:$ttl:$stamp:$loc\n" or die $!;
348 }
349 } # PTR
350
351 elsif ($type == 65280) { # A+PTR
352 # Recurse to PTR or A as appropriate because BIND et al don't share
353 # the tinydns concept of merged forward/reverse records
354# $$recflags{$val}++;
355 if ($revrec eq 'y') {
356 printrec_bind($zonefiles, $recid, $revrec, $loclist, $zone, $host, 12, $val, $distance, $weight, $port, $ttl,
357 $loc, $stamp, $expires, $stampactive);
358#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
359# printrec_bind(\%zonefiles, $recid, 'y', \@loclist, $revzone,
360# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
361# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
362# $loc, $stamp, $expires, $stampactive) = @_;
363 } else {
364 printrec_bind($zonefiles, $recid, $revrec, $loclist, $zone, $host, 1, $val, $distance, $weight, $port, $ttl,
365 $loc, $stamp, $expires, $stampactive);
366 }
367 } # A+PTR
368
369} # printrec_bind()
370
371
3721;
Note: See TracBrowser for help on using the repository browser.