source: trunk/DNSDB/ExportBIND.pm@ 875

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

/trunk

BIND export, unwinding dev saves, 27 of many many

  • Tweak domain record export order for consistency/predictability
  • Refine template expansion for forward zones, first iteration
  • Property svn:keywords set to Date Rev Author Id
File size: 32.2 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 875 2022-10-05 17:54:50Z 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
38## export reverse zones
39
40 my $soasth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
41 "FROM records WHERE rdns_id=? AND type=6");
42 # record order matters for reverse zones because we need to override larger templates with smaller ones.
43 my $recsth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
44 "FROM records WHERE rdns_id=? AND NOT type=6 ".
45 "ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val)");
46
47 # Fetch active zone list
48 my $revsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,revnet,status,changed,default_location FROM revzones WHERE status=1 ".
49 "ORDER BY masklen(revnet),revnet DESC, rdns_id");
50 # Unflag changed zones, so we can maybe cache the export and not redo everything every time
51 my $zonesth = $dnsdb->{dbh}->prepare("UPDATE revzones SET changed='n' WHERE rdns_id=?");
52 $revsth->execute();
53
54 my %recflags; # need this to be independent for forward vs reverse zones, as they're not merged
55
56 while (my ($revid,$revzone,$revstat,$changed,$defloc) = $revsth->fetchrow_array) {
57 my $cidr = NetAddr::IP->new($revzone);
58 my $zfile = $cidr->network->addr."-".$cidr->masklen;
59# my $cachefile = "$dnsdb->{exportcache}/$zfile";
60# my $tmpcache = "$dnsdb->{exportcache}/tmp.$zfile.$$";
61 my $tmpcache = "tmp.$zfile.$$"; # safety net. don't overwrite a previous known-good file
62
63##fixme: convert logical revzone into .arpa name? maybe take a slice of showrev_arpa?
64##fixme: need to bodge logical non-octet-boundary revzones into octet-boundary revzones
65##fixme: do we do cache files? views balloon the file count stupidly
66## foreach $octetzone $cidr->split(octet-boundary)
67## loclist = SELECT DISTINCT location FROM records WHERE rdns_id = $zid AND inetlazy(val) <<= $octetzone
68
69#printf "non-octet? %s, %i\n", $cidr->masklen, $cidr->masklen % 8;
70
71 # fetch a list of views/locations present in the zone. we need to publish a file for each one.
72 # in the event that no locations are present (~~ $viewlist is empty), /%view collapses to nothing in the zone path
73# my (@loclist) = $dnsdb->{dbh}->selectrow_array("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
74 my $tmplocs = $dnsdb->{dbh}->selectall_arrayref("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
75 my @loclist;
76 foreach my $tloc (@{$tmplocs}) {
77 push @loclist, ($tloc->[0] eq '' ? 'common' : $tloc->[0]);
78 }
79
80 my %zonefiles; # zone file handles
81
82 eval {
83
84 my $arpazone = DNSDB::_ZONE($cidr, 'ZONE', 'r', '.').($cidr->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
85
86##fixme: need to open separate zone files for aggregated metazones eg /22 or /14
87 foreach my $loc (@loclist) {
88 my $zfilepath = $dnsdb->bind_export_reverse_zone_path};
89 $zfilepath =~ s/\%view/$loc/;
90 $zfilepath =~ s/\%zone/$revzone/;
91 $zfilepath =~ s/\%arpazone/$arpazone/;
92
93 # Just In Case(TM)
94 $zfilepath =~ s,[^\w./-],_,g;
95
96# open $zonefiles{$loc}, ">", $zfilepath;
97
98 # write fresh records if:
99 # - we are not using the cache
100 # - force_refresh is set
101 # - the zone has changed
102 # - the cache file does not exist
103 # - the cache file is empty
104 if ($dnsdb->{force_refresh} || $changed || !-e $zfilepath || -z $zfilepath) {
105# if (!$dnsdb->{usecache} || $dnsdb->{force_refresh} || $changed || !-e $cachefile || -z $cachefile) {
106# if ($dnsdb->{usecache}) {
107# open ZONECACHE, ">$tmpcache" or die "Error creating temporary file $tmpcache: $!\n";
108# $zonefilehandle = *ZONECACHE;
109# }
110 open $zonefiles{$loc}, ">", $zfilepath or die "Error creating temporary file $zfilepath: $!\n";
111
112 printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime)
113 or die "Error writing header [$zone, '$loc']: $!\n";;
114
115 # need to fetch this separately since the rest of the records all (should) have real IPs in val
116 $soasth->execute($revid);
117 my (@zsoa) = $soasth->fetchrow_array();
118##fixme: do we even need @loclist passed in?
119 publishrec_bind(\%zonefiles, \@loclist, $zsoa[7], 'y', \%recflags, $cidr,
120 $zsoa[0], $zsoa[1], $zsoa[2], $zsoa[3], $zsoa[4], $zsoa[5], $zsoa[6], $loc, '');
121 } # if force_refresh etc
122
123 # tag the zonefile for publication in the view
124 push @{$viewzones{$loc}}, $arpazone;
125 } # foreach @loclist
126
127 # now the meat of the records
128 $recsth->execute($revid);
129 my $fullzone = _ZONE($tmpzone, 'ZONE', 'r', '.').($tmpzone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
130
131 while (my ($host, $type, $val, $dist, $weight, $port, $ttl, $recid, $loc, $stamp, $expires, $stampactive)
132 = $recsth->fetchrow_array) {
133 next if $recflags{$recid};
134
135 # Check for out-of-zone data
136 if ($val =~ /\.arpa$/) {
137 # val is non-IP
138 if ($val !~ /$fullzone$/) {
139 warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
140 next;
141 }
142 } else {
143 my $ipval = new NetAddr::IP $val;
144 if (!$tmpzone->contains($ipval)) {
145 warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
146 next;
147 }
148 } # is $val a raw .arpa name?
149
150 # Spaces are evil.
151 $val =~ s/^\s+//;
152 $val =~ s/\s+$//;
153 if ($typemap{$type} ne 'TXT') {
154 # Leading or trailng spaces could be legit in TXT records.
155 $host =~ s/^\s+//;
156 $host =~ s/\s+$//;
157 }
158
159 publishrec_bind(\%zonefiles, \@loclist, $recid, 'y', \%recflags, $revzone,
160 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
161
162 $recflags{$recid} = 1;
163
164 } # while ($recsth)
165
166# if ($dnsdb->{usecache}) {
167# close ZONECACHE; # force the file to be written
168# # catch obvious write errors that leave an empty temp file
169# if (-s $tmpcache) {
170# rename $tmpcache, $cachefile
171# or die "Error overwriting cache file $cachefile with temporary file: $!\n";
172# }
173# }
174
175 };
176 if ($@) {
177 die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
178 # error! something borked, and we should be able to fall back on the old cache file
179 # report the error, somehow.
180 } else {
181 # mark zone as unmodified. Only do this if no errors, that way
182 # export failures should recover a little more automatically.
183 $zonesth->execute($revid);
184 }
185
186# if ($dnsdb->{usecache}) {
187# # We've already made as sure as we can that a cached zone file is "good",
188# # although possibly stale/obsolete due to errors creating a new one.
189# eval {
190# open CACHE, "<$cachefile" or die $!;
191# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
192# close CACHE;
193# };
194# die $@ if $@;
195# }
196
197 } # revsth->fetch
198
199
200
201## and now the domains
202
203 $soasth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
204 "FROM records WHERE domain_id=? AND type=6");
205 # record order needs to match reverse zone ordering for IP values, or A+PTR
206 # template records don't cascade/expand correctly to match the reverse zones.
207 # order by record_id at least makes the zone consistent from export to export,
208 # otherwise the records could (theoretically) be returned in any old order by
209 # the DB engine
210 # ordering by nominal parent-child label hierarchy (as actually found live
211 # in some AXFRed zone files) would take a lot of chewing on data
212 $recsth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
213 "FROM records WHERE domain_id=? AND NOT type=6 ".
214 "ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val), record_id");
215# "FROM records WHERE domain_id=? AND type < 65280"); # Just exclude all types relating to rDNS
216
217 # Fetch active zone list
218 my $domsth = $dnsdb->{dbh}->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1 ORDER BY domain_id");
219 # Unflag changed zones, so we can maybe cache the export and not redo everything every time
220 $zonesth = $dnsdb->{dbh}->prepare("UPDATE domains SET changed='n' WHERE domain_id=?");
221 $domsth->execute();
222
223 # Clear %reclfags, since we explicitly want to NOT carry "I've published this
224 # record" over from rDNS, since we have to regenerate any templates for forward
225 # zones. downside: small mismatches due to overridden entries. not sure how
226 # best to manage that. :/
227##fixme: selectively delete entries to allow template_always_publish_a to flag
228# whether extra A records get published or not. should default to not (nb, of
229# *course* that's the complex case) to match original tinydns template masking behaviour
230# %recflags = ();
231
232 while (my ($domid,$dom,$domstat,$changed) = $domsth->fetchrow_array) {
233
234 # fetch a list of views/locations present in the zone. we need to publish a file for each one.
235 # in the event that no locations are present (~~ $viewlist is empty), /%view collapses to nothing in the zone path
236 my $tmplocs = $dnsdb->{dbh}->selectall_arrayref("SELECT DISTINCT location FROM records WHERE domain_id = ?", undef, $domid);
237 my @loclist;
238 foreach my $tloc (@{$tmplocs}) {
239 push @loclist, ($tloc->[0] eq '' ? 'common' : $tloc->[0]);
240 }
241 my %zonefiles; # zone file handles
242
243 eval {
244
245##fixme: use tmpfile module for more secure temp files? want the zone name at least in it anyway, not sure that works...
246 my $zfile = $dom; # can probably drop this intermediate
247 my $tmpcache = "tmp.$zfile.$$"; # safety net. don't overwrite a previous known-good file
248 foreach my $loc (@loclist) {
249 my $zfilepath = $dnsdb->{bind_export_zone_path};
250 $zfilepath =~ s/\%view/$loc/;
251 $zfilepath =~ s/\%zone/$zfile/;
252# $zfilepath =~ s/\%arpazone/$arpazone/;
253
254 # Just In Case(TM)
255 $zfilepath =~ s,[^\w./-],_,g;
256
257# open $zonefiles{$loc}, ">", $zfilepath;
258print "open zonefile for '$loc', '$zfilepath'\n";
259
260
261 # write fresh records if:
262 # - the zone contains ALIAS pseudorecords, which need to cascade changes from the upstream CNAME farm at every opportunity
263 if ( ($dnsdb->{dbh}->selectrow_array("SELECT count(*) FROM records WHERE domain_id = ? AND type=65300", undef, $domid))[0] ) {
264 $changed = 1; # abuse this flag for zones with ALIAS records
265 # also update the serial number, because while it shouldn't matter purely for serving
266 # records, it WILL matter if AXFR becomes part of the publishing infrastructure
267 $dnsdb->_updateserial(domain_id => $domid);
268 }
269 # - the zone contains records which expire in less than 10 minutes or became valid less than 10 minutes ago
270 # note, no need to multi-bump the serial
271 elsif ( ($dnsdb->{dbh}->selectrow_array("SELECT COUNT(*) FROM records WHERE domain_id = ? AND ".
272 "stampactive='t' AND @(extract(epoch from stamp-now())) < 600", undef, $domid))[0] ) {
273 $changed = 1;
274 $dnsdb->_updateserial(domain_id => $domid);
275 }
276# if (!$self->{usecache} || $self->{force_refresh} || $changed || !-e $cachefile || -z $cachefile) {
277 if ($dnsdb->{force_refresh} || $changed || !-e $zfilepath || -z $zfilepath) {
278 open $zonefiles{$loc}, ">", $zfilepath or die "Error creating temporary file $zfilepath: $!\n";
279
280# if ($self->{usecache}) {
281# open ZONECACHE, ">$tmpcache" or die "Error creating temporary file $tmpcache: $!\n";
282# $zonefilehandle = *ZONECACHE;
283# }
284
285 # need to fetch this separately so the SOA comes first in the flatfile....
286 # Just In Case we need/want to reimport from the flatfile later on.
287 $soasth->execute($domid);
288 my (@zsoa) = $soasth->fetchrow_array();
289
290 # drop in a header line so we know when things went KABOOM
291 printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime)
292 or die "Error writing header [$cidr, '$loc']: $!\n";
293
294 printrec_bind(\%zonefiles, \@loclist, $zsoa[7], 'n', \%recflags, $dom,
295 $zsoa[0], $zsoa[1], $zsoa[2], $zsoa[3], $zsoa[4], $zsoa[5], $zsoa[6], $loc, '');
296
297# $self->_printrec_tiny($zonefilehandle, $zsoa[7], 'n',\%recflags,$dom,
298# $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
299
300 } # if force_refresh etc
301
302 # tag the zonefile for publication in the view
303 push @{$viewzones{$loc}}, $arpazone;
304 } # foreach @loclist
305
306 $recsth->execute($domid);
307 while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
308##work need more subtle check - $recflags{$val} eq 'ptr' maybe?
309 next if $recflags{$recid};
310#next if $recflags{$val} && $type == 65280;# && !$dnsdb->{template_always_publish_a};
311
312 # Spaces are evil.
313 $host =~ s/^\s+//;
314 $host =~ s/\s+$//;
315 if ($typemap{$type} ne 'TXT') {
316 # Leading or trailng spaces could be legit in TXT records.
317 $val =~ s/^\s+//;
318 $val =~ s/\s+$//;
319 }
320
321 # Check for out-of-zone data
322 $host = $dom if $host eq '@';
323 if ($host !~ /$dom$/i) {
324 warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n";
325 next;
326 }
327
328 $recflags{$recid} = 1;
329
330 printrec_bind(\%zonefiles, \@loclist, $recid, 'n', \%recflags, $dom,
331 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
332
333 } # while ($recsth)
334
335 # retrieve NS records for subdomains. not strictly required in current production
336 # context but may matter sometime down the road
337 my $subnssth = $dnsdb->{dbh}->prepare("SELECT r.host,r.val,r.ttl,r.record_id,r.loc,r.stamp,r.expires,r.stampactive ".
338 "FROM records r ".
339 "JOIN domains d ON r.domain_id=d.domain_id ".
340 "WHERE r.type=2 AND d.domain LIKE ?");
341 $subnssth->execute('%.'.$dom);
342 while (my ($host,$val,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $subnssth->fetchrow_array) {
343 printrec_bind(\%zonefiles, \@loclist, $recid, 'n', \%recflags, $dom,
344 $host, 2, $val, '', '', '', $ttl, $loc, $stamp, $expires, $stampactive);
345 } # subdomain-ns-recsth
346
347
348# if ($self->{usecache}) {
349# close ZONECACHE; # force the file to be written
350# # catch obvious write errors that leave an empty temp file
351# if (-s $tmpcache) {
352# rename $tmpcache, $cachefile
353# or die "Error overwriting cache file $cachefile with temporary file: $!\n";
354# }
355# }
356
357 } # if $changed or cache filesize is 0
358
359 };
360 if ($@) {
361 die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
362 # error! something borked, and we should be able to fall back on the old cache file
363 # report the error, somehow.
364 } else {
365 # mark zone as unmodified. Only do this if no errors, that way
366 # export failures should recover a little more automatically.
367 $zonesth->execute($revid);
368 }
369
370# if ($dnsdb->{usecache}) {
371# # We've already made as sure as we can that a cached zone file is "good",
372# # although possibly stale/obsolete due to errors creating a new one.
373# eval {
374# open CACHE, "<$cachefile" or die $!;
375# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
376# close CACHE;
377# };
378# die $@ if $@;
379# }
380
381 } # domsth->fetch
382
383
384
385 # Write the view configuration last, because otherwise we have to be horribly inefficient
386 # at figuring out which zones are visible/present in which views
387 if ($viewlist) {
388 my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
389 open BINDCONF, ">", $tmpconf;
390
391 foreach my $view (@{$viewlist}, 'common') {
392#print Dumper($view);
393 print BINDCONF "view $view->{location} {\n";
394# print "view $view->{location} {\n";
395 # could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
396 # note that some semantics of data visibility need to be handled by the record export, since it's
397 # not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
398 # same as a BIND view with match-clients { any; };
399 if ($view->{iplist}) {
400 print BINDCONF " match-clients { ".join("; ", $view->{iplist})."; };\n";
401# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
402 } else {
403 print BINDCONF " match-clients { any; };\n";
404# print " match-clients { any; };\n";
405 }
406 foreach my $zone (@{$viewzones{$view->{location}}}) {
407##fixme: notify settings, maybe per-zone?
408 print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
409 }
410 print BINDCONF "};\n\n";
411 print "};\n\n";
412 } # foreach @$viewlist
413 rename $tmpconf, $dnsdb->{bind_zone_conf};
414 } # if $viewlist
415
416} # export()
417
418
419# Print individual records in BIND format
420sub publishrec_bind {
421 my $dnsdb = shift;
422
423# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
424 my ($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
425 $loc, $stamp, $expires, $stampactive) = @_;
426
427# make sure "global" records get into all the right per-view zone files, without having to do this loop in each record-print location
428##fixme: maybe exclude the template types? those may be more expensive to export
429## *ponder* may be more efficient to loop in each record print due to substitution and manipulation from stored data to formal
430## record for .arpa zones for all records
431 if ($loc eq '') {
432 foreach my $subloc (@{$loclist}) {
433 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
434 $subloc, $stamp, $expires, $stampactive);
435 }
436 }
437
438 # Just In Case something is lingering in the DB
439 $loc = '' if !$loc;
440
441 ## And now to the records!
442
443 if ($typemap{$type} eq 'SOA') {
444 # host contains pri-ns:responsible
445 # val is abused to contain refresh:retry:expire:minttl
446 # let's be explicit about abusing $host and $val
447 my ($email, $primary) = (split /:/, $host)[0,1];
448 my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
449 my $serial = 0; # fail less horribly than leaving it empty?
450 # just snarfing the right SOA serial for the zone type
451 if ($revrec eq 'y') {
452 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
453 } else {
454 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
455 } # revrec <> 'y'
456 # suppress a "uninitialized value" warning. should be impossible but...
457 # abuse hours as the last digit pair of the serial for simplicity
458##fixme?: alternate SOA serial schemes?
459 $serial = strftime("%Y%m%d%H", localtime()) if !$serial;
460 $primary .= "." if $primary !~ /\.$/;
461 $email .= "." if $email !~ /\.$/;
462# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
463# or die $!;
464# print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
465# or die "couldn't write $zone SOA: $!";
466 my $recdata = "$zone. $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n";
467 recprint($zonefiles, $loclist, $loc, $recdata);
468 } # SOA
469
470 elsif ($typemap{$type} eq 'A') {
471 ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
472# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
473# print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
474 my $recdata = "$host. $ttl IN A $val\n";
475 recprint($zonefiles, $loclist, $loc, $recdata);
476 } # A
477
478 elsif ($typemap{$type} eq 'NS') {
479 if ($revrec eq 'y') {
480 $val = NetAddr::IP->new($val);
481
482##fixme: conversion for sub-/24 delegations in reverse zones?
483# if (!$val->{isv6} && ($val->masklen > 24)) {
484# }
485
486 my $val2 = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
487 my $recdata = "$val2. $ttl IN NS $host\n";
488 recprint($zonefiles, $loclist, $loc, $recdata);
489
490 } else {
491 my $recdata = "$host. $ttl IN NS $val.\n"
492 recprint($zonefiles, $loclist, $loc, $recdata);
493 }
494 } # NS
495
496 elsif ($typemap{$type} eq 'AAAA') {
497# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
498# print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
499 my $recdata = "$host. $ttl IN AAAA $val\n";
500 recprint($zonefiles, $loclist, $loc, $recdata);
501 } # AAAA
502
503 elsif ($typemap{$type} eq 'MX') {
504# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
505# print {$zonefiles->{$loc}} "$host $ttl IN MX $distance $val\n" or die $!;
506# should arguably swap host and val first, but MX records really don't make any sense in reverse zones, so any silliness that results from finding one doesn't much matter.
507 my $recdata = "$host. $ttl IN MX $distance $val.\n";
508 recprint($zonefiles, $loclist, $loc, $recdata);
509 } # MX
510
511 elsif ($typemap{$type} eq 'TXT') {
512# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
513# print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
514 my $recdata = "$host. $ttl IN TXT \"$val\"\n";
515 recprint($zonefiles, $loclist, $loc, $recdata);
516 } # TXT
517
518 elsif ($typemap{$type} eq 'CNAME') {
519# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
520# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
521 my $recdata = "$host. $ttl IN CNAME $val.\n";
522 recprint($zonefiles, $loclist, $loc, $recdata);
523 } # CNAME
524
525 elsif ($typemap{$type} eq 'SRV') {
526# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
527# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
528 my $recdata = "$host $ttl IN SRV $distance $weight $port $val\n";
529 recprint($zonefiles, $loclist, $loc, $recdata);
530 } # SRV
531
532 elsif ($typemap{$type} eq 'RP') {
533# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
534# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
535 my $recdata = "$host $ttl IN RP $val\n";
536 recprint($zonefiles, $loclist, $loc, $recdata);
537 } # RP
538
539 elsif ($typemap{$type} eq 'PTR') {
540# $$recflags{$val}++;
541 # maybe track exclusions like this? so we can publish "all
542 # A and/or PTR records" irrespective of template records
543 $$recflags{$val} = 'ptr';
544 if ($revrec eq 'y') {
545
546 if ($val =~ /\.arpa$/) {
547 # someone put in the formal .arpa name. humor them.
548# print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
549 my $recdata = "$val. $ttl IN PTR $host.\n";
550 recprint($zonefiles, $loclist, $loc, $recdata);
551 } else {
552 $zone = NetAddr::IP->new($zone);
553 if (!$zone->{isv6} && $zone->masklen > 24) {
554 # sub-octet v4 zone
555 ($val) = ($val =~ /\.(\d+)$/);
556# print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
557# " $ttl IN PTR $host\n"
558# or die $!;
559 my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa. $ttl IN PTR $host.\n";
560 recprint($zonefiles, $loclist, $loc, $recdata);
561 } else {
562 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
563 $val = NetAddr::IP->new($val);
564# print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
565# " $ttl IN PTR $host\n"
566# or die $!;
567 my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
568 ". $ttl IN PTR $host.\n";
569 recprint($zonefiles, $loclist, $loc, $recdata);
570 }
571 } # non-".arpa" $val
572
573 } else {
574 # PTRs in forward zones are less bizarre and insane than some other record types
575 # in reverse zones... OTOH we can't validate them any which way, so we cross our
576 # fingers and close our eyes and make it Someone Else's Problem.
577# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
578 my $recdata = "$host $ttl IN PTR $val\n";
579 recprint($zonefiles, $loclist, $loc, $recdata);
580 }
581 } # PTR
582
583 elsif ($type == 65280) { # A+PTR
584 # Recurse to PTR or A as appropriate because BIND et al don't share
585 # the tinydns concept of merged forward/reverse records
586# %recflags gets updated in the PTR branch just above
587# $$recflags{$val}++;
588 if ($revrec eq 'y') {
589 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val, $distance, $weight, $port, $ttl,
590 $loc, $stamp, $expires, $stampactive);
591# ... but we need to tweak it for this case? so the A record gets published...
592#$$recflags{$val} = 'a+ptr';
593#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
594# publishrec_bind(\%zonefiles, $recid, 'y', \@loclist, $revzone,
595# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
596# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
597# $loc, $stamp, $expires, $stampactive) = @_;
598 } else {
599 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val, $distance, $weight, $port, $ttl,
600 $loc, $stamp, $expires, $stampactive);
601 # set a unique flag to skip template expansion for this IP in forward zones
602 $$recflags{$val} = 'a';
603 }
604 } # A+PTR
605
606 elsif ($type == 65282) { # PTR template
607 # only useful for v4 with standard DNS software, since this expands all
608 # IPs in $zone (or possibly $val?) with autogenerated records
609 $val = NetAddr::IP->new($val);
610 return if $val->{isv6};
611
612 if ($val->masklen <= 16) {
613 foreach my $sub ($val->split(16)) {
614 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
615 }
616 } else {
617 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
618 }
619 } # PTR template
620
621 elsif ($type == 65283) { # A+PTR template
622 $val = NetAddr::IP->new($val);
623 # Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
624 return if $val->{isv6};
625
626 if ($val->masklen < 16) {
627 foreach my $sub ($val->split(16)) {
628 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
629 }
630 } else {
631 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
632 }
633 } # A+PTR template
634
635 elsif ($type == 65284) { # AAAA+PTR template
636 # Stub for completeness. Could be exported to DNS software that supports
637 # some degree of internal automagic in generic-record-creation
638 # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
639 } # AAAA+PTR template
640
641} # publishrec_bind()
642
643
644sub __publish_template_bind {
645 my $sub = shift;
646 my $recflags = shift;
647 my $hpat = shift;
648 my $zonefiles = shift;
649 my $loclist = shift;
650 my $ttl = shift;
651 my $stamp = shift;
652 my $loc = shift;
653 my $zpass = shift;
654 my $zone = new NetAddr::IP $zpass;
655# my $zone = new NetAddr::IP shift;
656 my $revrec = shift || 'y';
657# my $ptrflag = shift || 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
658
659 # do this conversion once, not (number-of-ips-in-subnet) times
660 my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa.', 'r', '.');
661
662 my $iplist = $sub->splitref(32);
663 my $ipindex = -1;
664 foreach (@$iplist) {
665 my $ip = $_->addr;
666 $ipindex++;
667 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
668 my $lastoct = (split /\./, $ip)[3];
669
670 # Allow smaller entries to override longer ones, eg, a specific PTR will
671 # always publish, overriding any template record containing that IP.
672 # %blank% also needs to be per-IP here to properly cascade overrides with
673 # multiple nested templates
674# next if $$recflags{$ip}; # && $self->{skip_bcast_255}
675
676# next if $$recflags{$ip} && ($$recflags{$ip} eq 'ptr' || $$recflags{$ip} eq 'a+ptr');
677
678 if ($revrec eq 'y') {
679 next if $$recflags{$ip}; # blanket exclusion; we do reverse records first
680 } else {
681##fixme: A record side templates not cascading correctly
682 # excluding ptr does NOT work, as it excludes ALL previously covered A+PTR template entries.
683 # we only want to exclude the singleton (A+)PTR ones
684 #if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'ptr')) {
685 if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'atemplate' || $$recflags{$ip} eq 'ptr')) {
686 # default skip case
687 next;
688 }
689 } # revrec branch for skipping template member expansion
690
691 # set a forward/reverse-unique flag in %recflags
692 $$recflags{$ip} = ($revrec eq 'y' ? 'ptrtemplate' : 'atemplate');
693 next if $hpat eq '%blank%';
694
695 my $rec = $hpat; # start fresh with the template for each IP
696##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
697# seems less bad than some alternatives.
698 $dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
699 # _template4_expand may blank $rec; if so, don't publish a record
700 next if !$rec;
701##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
702# if ($ptrflag || $zone->masklen > 24) {
703 my $recdata;
704 if ($revrec eq 'y') {
705# || $zone->masklen > 24) {
706# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
707##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
708# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
709# if ($revrec ne 'y') {
710 # print a separate A record. Arguably we could use an = record here instead.
711# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
712# print $fh "$rec $ttl IN A $ip\n" or die $!;
713# }
714 if ($dnsdb->{bind_export_fqdn}) {
715 $recdata = "$lastoct.$arpabase $ttl IN PTR $rec.\n";
716 } else {
717 $recdata = "$lastoct $ttl IN PTR $rec.\n";
718 }
719
720 } else {
721 # A record, not merged
722# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
723# print $fh "$rec $ttl IN A $ip\n" or die $!;
724 $rec =~ s/\.$zone$// unless $dnsdb->{bind_export_fqdn};
725 $recdata = "$rec. $ttl IN A $ip\n";
726 }
727 # and finally
728 recprint($zonefiles, $loclist, $loc, $recdata);
729 } # foreach (@iplist)
730} # __publish_template_bind()
731
732
733# actual record printing sub
734# loop on the locations here so we don't end up with a huge pot of copypasta
735sub recprint {
736 my ($zonefiles, $loclist, $loc, $recdata) = @_;
737 if ($loc eq '') {
738 # "common" record visible in all locations
739 foreach my $rloc (@{$loclist}) {
740 print {$zonefiles->{$rloc}} $recdata or die $!;
741 }
742 } else {
743 # record with specific location tagged
744 print {$zonefiles->{$loc}} $recdata or die $!;
745 }
746}
747
7481;
Note: See TracBrowser for help on using the repository browser.