source: trunk/DNSDB/ExportBIND.pm@ 874

Last change on this file since 874 was 874, checked in by Kris Deugau, 2 years ago

/trunk

BIND export, unwinding dev saves, 26 of many many

  • Pass $cidr to publishrec_bind() for SOA records so lower layers can more easily use the CIDR
  • Add some commented pondering on %recflags around suppressing extra A records that may pop up in forward zones due to possible repeat template expansion in forward zones
  • Add a block to explicitly retrieve NS records from subdomains to ensure they get published in their parent zones when present locally
  • Property svn:keywords set to Date Rev Author Id
File size: 30.6 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 874 2022-10-04 21:08:17Z 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 doesn't strictly matter, but ordering by conventional zone
206 # file order doesn't really have a lever without tweaking the table structure.
207 # ordering by nominal parent-child label hierarchy (as actually found live
208 # in some AXFRed zone files) would be even hairier.
209 # ordering by record_id has the advantage of consistent order export to export
210 $recsth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
211 "FROM records WHERE domain_id=? AND NOT type=6 ORDER BY record_id");
212# "FROM records WHERE domain_id=? AND type < 65280"); # Just exclude all types relating to rDNS
213
214 # Fetch active zone list
215 my $domsth = $dnsdb->{dbh}->prepare("SELECT domain_id,domain,status,changed FROM domains WHERE status=1 ORDER BY domain_id");
216 # Unflag changed zones, so we can maybe cache the export and not redo everything every time
217 $zonesth = $dnsdb->{dbh}->prepare("UPDATE domains SET changed='n' WHERE domain_id=?");
218 $domsth->execute();
219
220 # Clear %reclfags, since we explicitly want to NOT carry "I've published this
221 # record" over from rDNS, since we have to regenerate any templates for forward
222 # zones. downside: small mismatches due to overridden entries. not sure how
223 # best to manage that. :/
224##fixme: selectively delete entries to allow template_always_publish_a to flag
225# whether extra A records get published or not. should default to not (nb, of
226# *course* that's the complex case) to match original tinydns template masking behaviour
227# %recflags = ();
228
229 while (my ($domid,$dom,$domstat,$changed) = $domsth->fetchrow_array) {
230
231 # fetch a list of views/locations present in the zone. we need to publish a file for each one.
232 # in the event that no locations are present (~~ $viewlist is empty), /%view collapses to nothing in the zone path
233 my $tmplocs = $dnsdb->{dbh}->selectall_arrayref("SELECT DISTINCT location FROM records WHERE domain_id = ?", undef, $domid);
234 my @loclist;
235 foreach my $tloc (@{$tmplocs}) {
236 push @loclist, ($tloc->[0] eq '' ? 'common' : $tloc->[0]);
237 }
238 my %zonefiles; # zone file handles
239
240 eval {
241
242##fixme: use tmpfile module for more secure temp files? want the zone name at least in it anyway, not sure that works...
243 my $zfile = $dom; # can probably drop this intermediate
244 my $tmpcache = "tmp.$zfile.$$"; # safety net. don't overwrite a previous known-good file
245 foreach my $loc (@loclist) {
246 my $zfilepath = $dnsdb->{bind_export_zone_path};
247 $zfilepath =~ s/\%view/$loc/;
248 $zfilepath =~ s/\%zone/$zfile/;
249# $zfilepath =~ s/\%arpazone/$arpazone/;
250
251 # Just In Case(TM)
252 $zfilepath =~ s,[^\w./-],_,g;
253
254# open $zonefiles{$loc}, ">", $zfilepath;
255print "open zonefile for '$loc', '$zfilepath'\n";
256
257
258 # write fresh records if:
259 # - the zone contains ALIAS pseudorecords, which need to cascade changes from the upstream CNAME farm at every opportunity
260 if ( ($dnsdb->{dbh}->selectrow_array("SELECT count(*) FROM records WHERE domain_id = ? AND type=65300", undef, $domid))[0] ) {
261 $changed = 1; # abuse this flag for zones with ALIAS records
262 # also update the serial number, because while it shouldn't matter purely for serving
263 # records, it WILL matter if AXFR becomes part of the publishing infrastructure
264 $dnsdb->_updateserial(domain_id => $domid);
265 }
266 # - the zone contains records which expire in less than 10 minutes or became valid less than 10 minutes ago
267 # note, no need to multi-bump the serial
268 elsif ( ($dnsdb->{dbh}->selectrow_array("SELECT COUNT(*) FROM records WHERE domain_id = ? AND ".
269 "stampactive='t' AND @(extract(epoch from stamp-now())) < 600", undef, $domid))[0] ) {
270 $changed = 1;
271 $dnsdb->_updateserial(domain_id => $domid);
272 }
273# if (!$self->{usecache} || $self->{force_refresh} || $changed || !-e $cachefile || -z $cachefile) {
274 if ($dnsdb->{force_refresh} || $changed || !-e $zfilepath || -z $zfilepath) {
275 open $zonefiles{$loc}, ">", $zfilepath or die "Error creating temporary file $zfilepath: $!\n";
276
277# if ($self->{usecache}) {
278# open ZONECACHE, ">$tmpcache" or die "Error creating temporary file $tmpcache: $!\n";
279# $zonefilehandle = *ZONECACHE;
280# }
281
282 # need to fetch this separately so the SOA comes first in the flatfile....
283 # Just In Case we need/want to reimport from the flatfile later on.
284 $soasth->execute($domid);
285 my (@zsoa) = $soasth->fetchrow_array();
286
287 # drop in a header line so we know when things went KABOOM
288 printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime)
289 or die "Error writing header [$cidr, '$loc']: $!\n";
290
291 printrec_bind(\%zonefiles, \@loclist, $zsoa[7], 'n', \%recflags, $dom,
292 $zsoa[0], $zsoa[1], $zsoa[2], $zsoa[3], $zsoa[4], $zsoa[5], $zsoa[6], $loc, '');
293
294# $self->_printrec_tiny($zonefilehandle, $zsoa[7], 'n',\%recflags,$dom,
295# $zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
296
297 } # if force_refresh etc
298
299 # tag the zonefile for publication in the view
300 push @{$viewzones{$loc}}, $arpazone;
301 } # foreach @loclist
302
303 $recsth->execute($domid);
304 while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
305 next if $recflags{$recid};
306
307 # Spaces are evil.
308 $host =~ s/^\s+//;
309 $host =~ s/\s+$//;
310 if ($typemap{$type} ne 'TXT') {
311 # Leading or trailng spaces could be legit in TXT records.
312 $val =~ s/^\s+//;
313 $val =~ s/\s+$//;
314 }
315
316 # Check for out-of-zone data
317 $host = $dom if $host eq '@';
318 if ($host !~ /$dom$/i) {
319 warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $dom)\n";
320 next;
321 }
322
323 $recflags{$recid} = 1;
324
325 printrec_bind(\%zonefiles, \@loclist, $recid, 'n', \%recflags, $dom,
326 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
327
328 } # while ($recsth)
329
330 # retrieve NS records for subdomains. not strictly required in current production
331 # context but may matter sometime down the road
332 my $subnssth = $dnsdb->{dbh}->prepare("SELECT r.host,r.val,r.ttl,r.record_id,r.loc,r.stamp,r.expires,r.stampactive ".
333 "FROM records r ".
334 "JOIN domains d ON r.domain_id=d.domain_id ".
335 "WHERE r.type=2 AND d.domain LIKE ?");
336 $subnssth->execute('%.'.$dom);
337 while (my ($host,$val,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $subnssth->fetchrow_array) {
338 printrec_bind(\%zonefiles, \@loclist, $recid, 'n', \%recflags, $dom,
339 $host, 2, $val, '', '', '', $ttl, $loc, $stamp, $expires, $stampactive);
340 } # subdomain-ns-recsth
341
342
343# if ($self->{usecache}) {
344# close ZONECACHE; # force the file to be written
345# # catch obvious write errors that leave an empty temp file
346# if (-s $tmpcache) {
347# rename $tmpcache, $cachefile
348# or die "Error overwriting cache file $cachefile with temporary file: $!\n";
349# }
350# }
351
352 } # if $changed or cache filesize is 0
353
354 };
355 if ($@) {
356 die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
357 # error! something borked, and we should be able to fall back on the old cache file
358 # report the error, somehow.
359 } else {
360 # mark zone as unmodified. Only do this if no errors, that way
361 # export failures should recover a little more automatically.
362 $zonesth->execute($revid);
363 }
364
365# if ($dnsdb->{usecache}) {
366# # We've already made as sure as we can that a cached zone file is "good",
367# # although possibly stale/obsolete due to errors creating a new one.
368# eval {
369# open CACHE, "<$cachefile" or die $!;
370# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
371# close CACHE;
372# };
373# die $@ if $@;
374# }
375
376 } # domsth->fetch
377
378
379
380 # Write the view configuration last, because otherwise we have to be horribly inefficient
381 # at figuring out which zones are visible/present in which views
382 if ($viewlist) {
383 my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
384 open BINDCONF, ">", $tmpconf;
385
386 foreach my $view (@{$viewlist}, 'common') {
387#print Dumper($view);
388 print BINDCONF "view $view->{location} {\n";
389# print "view $view->{location} {\n";
390 # could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
391 # note that some semantics of data visibility need to be handled by the record export, since it's
392 # not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
393 # same as a BIND view with match-clients { any; };
394 if ($view->{iplist}) {
395 print BINDCONF " match-clients { ".join("; ", $view->{iplist})."; };\n";
396# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
397 } else {
398 print BINDCONF " match-clients { any; };\n";
399# print " match-clients { any; };\n";
400 }
401 foreach my $zone (@{$viewzones{$view->{location}}}) {
402##fixme: notify settings, maybe per-zone?
403 print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
404 }
405 print BINDCONF "};\n\n";
406 print "};\n\n";
407 } # foreach @$viewlist
408 rename $tmpconf, $dnsdb->{bind_zone_conf};
409 } # if $viewlist
410
411} # export()
412
413
414# Print individual records in BIND format
415sub publishrec_bind {
416 my $dnsdb = shift;
417
418# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
419 my ($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
420 $loc, $stamp, $expires, $stampactive) = @_;
421
422# make sure "global" records get into all the right per-view zone files, without having to do this loop in each record-print location
423##fixme: maybe exclude the template types? those may be more expensive to export
424## *ponder* may be more efficient to loop in each record print due to substitution and manipulation from stored data to formal
425## record for .arpa zones for all records
426 if ($loc eq '') {
427 foreach my $subloc (@{$loclist}) {
428 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
429 $subloc, $stamp, $expires, $stampactive);
430 }
431 }
432
433 # Just In Case something is lingering in the DB
434 $loc = '' if !$loc;
435
436 ## And now to the records!
437
438 if ($typemap{$type} eq 'SOA') {
439 # host contains pri-ns:responsible
440 # val is abused to contain refresh:retry:expire:minttl
441 # let's be explicit about abusing $host and $val
442 my ($email, $primary) = (split /:/, $host)[0,1];
443 my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
444 my $serial = 0; # fail less horribly than leaving it empty?
445 # just snarfing the right SOA serial for the zone type
446 if ($revrec eq 'y') {
447 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
448 } else {
449 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
450 } # revrec <> 'y'
451 # suppress a "uninitialized value" warning. should be impossible but...
452 # abuse hours as the last digit pair of the serial for simplicity
453##fixme?: alternate SOA serial schemes?
454 $serial = strftime("%Y%m%d%H", localtime()) if !$serial;
455 $primary .= "." if $primary !~ /\.$/;
456 $email .= "." if $email !~ /\.$/;
457# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
458# or die $!;
459# print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
460# or die "couldn't write $zone SOA: $!";
461 my $recdata = "$zone. $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n";
462 recprint($zonefiles, $loclist, $loc, $recdata);
463 } # SOA
464
465 elsif ($typemap{$type} eq 'A') {
466 ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
467# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
468# print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
469 my $recdata = "$host. $ttl IN A $val\n";
470 recprint($zonefiles, $loclist, $loc, $recdata);
471 } # A
472
473 elsif ($typemap{$type} eq 'NS') {
474 if ($revrec eq 'y') {
475 $val = NetAddr::IP->new($val);
476
477##fixme: conversion for sub-/24 delegations in reverse zones?
478# if (!$val->{isv6} && ($val->masklen > 24)) {
479# }
480
481 my $val2 = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
482 my $recdata = "$val2. $ttl IN NS $host\n";
483 recprint($zonefiles, $loclist, $loc, $recdata);
484
485 } else {
486 my $recdata = "$host. $ttl IN NS $val.\n"
487 recprint($zonefiles, $loclist, $loc, $recdata);
488 }
489 } # NS
490
491 elsif ($typemap{$type} eq 'AAAA') {
492# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
493# print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
494 my $recdata = "$host. $ttl IN AAAA $val\n";
495 recprint($zonefiles, $loclist, $loc, $recdata);
496 } # AAAA
497
498 elsif ($typemap{$type} eq 'MX') {
499# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
500# print {$zonefiles->{$loc}} "$host $ttl IN MX $distance $val\n" or die $!;
501# 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.
502 my $recdata = "$host. $ttl IN MX $distance $val.\n";
503 recprint($zonefiles, $loclist, $loc, $recdata);
504 } # MX
505
506 elsif ($typemap{$type} eq 'TXT') {
507# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
508# print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
509 my $recdata = "$host. $ttl IN TXT \"$val\"\n";
510 recprint($zonefiles, $loclist, $loc, $recdata);
511 } # TXT
512
513 elsif ($typemap{$type} eq 'CNAME') {
514# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
515# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
516 my $recdata = "$host. $ttl IN CNAME $val.\n";
517 recprint($zonefiles, $loclist, $loc, $recdata);
518 } # CNAME
519
520 elsif ($typemap{$type} eq 'SRV') {
521# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
522# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
523 my $recdata = "$host $ttl IN SRV $distance $weight $port $val\n";
524 recprint($zonefiles, $loclist, $loc, $recdata);
525 } # SRV
526
527 elsif ($typemap{$type} eq 'RP') {
528# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
529# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
530 my $recdata = "$host $ttl IN RP $val\n";
531 recprint($zonefiles, $loclist, $loc, $recdata);
532 } # RP
533
534 elsif ($typemap{$type} eq 'PTR') {
535 $$recflags{$val}++;
536 if ($revrec eq 'y') {
537
538 if ($val =~ /\.arpa$/) {
539 # someone put in the formal .arpa name. humor them.
540# print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
541 my $recdata = "$val. $ttl IN PTR $host.\n";
542 recprint($zonefiles, $loclist, $loc, $recdata);
543 } else {
544 $zone = NetAddr::IP->new($zone);
545 if (!$zone->{isv6} && $zone->masklen > 24) {
546 # sub-octet v4 zone
547 ($val) = ($val =~ /\.(\d+)$/);
548# print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
549# " $ttl IN PTR $host\n"
550# or die $!;
551 my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa. $ttl IN PTR $host.\n";
552 recprint($zonefiles, $loclist, $loc, $recdata);
553 } else {
554 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
555 $val = NetAddr::IP->new($val);
556# print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
557# " $ttl IN PTR $host\n"
558# or die $!;
559 my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
560 ". $ttl IN PTR $host.\n";
561 recprint($zonefiles, $loclist, $loc, $recdata);
562 }
563 } # non-".arpa" $val
564
565 } else {
566 # PTRs in forward zones are less bizarre and insane than some other record types
567 # in reverse zones... OTOH we can't validate them any which way, so we cross our
568 # fingers and close our eyes and make it Someone Else's Problem.
569# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
570 my $recdata = "$host $ttl IN PTR $val\n";
571 recprint($zonefiles, $loclist, $loc, $recdata);
572 }
573 } # PTR
574
575 elsif ($type == 65280) { # A+PTR
576 # Recurse to PTR or A as appropriate because BIND et al don't share
577 # the tinydns concept of merged forward/reverse records
578 $$recflags{$val}++;
579 if ($revrec eq 'y') {
580 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val, $distance, $weight, $port, $ttl,
581 $loc, $stamp, $expires, $stampactive);
582#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
583# publishrec_bind(\%zonefiles, $recid, 'y', \@loclist, $revzone,
584# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
585# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
586# $loc, $stamp, $expires, $stampactive) = @_;
587 } else {
588 publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val, $distance, $weight, $port, $ttl,
589 $loc, $stamp, $expires, $stampactive);
590 }
591 } # A+PTR
592
593 elsif ($type == 65282) { # PTR template
594 # only useful for v4 with standard DNS software, since this expands all
595 # IPs in $zone (or possibly $val?) with autogenerated records
596 $val = NetAddr::IP->new($val);
597 return if $val->{isv6};
598
599 if ($val->masklen <= 16) {
600 foreach my $sub ($val->split(16)) {
601 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
602 }
603 } else {
604 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
605 }
606 } # PTR template
607
608 elsif ($type == 65283) { # A+PTR template
609 $val = NetAddr::IP->new($val);
610 # Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
611 return if $val->{isv6};
612
613 if ($val->masklen < 16) {
614 foreach my $sub ($val->split(16)) {
615 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
616 }
617 } else {
618 __publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
619 }
620 } # A+PTR template
621
622 elsif ($type == 65284) { # AAAA+PTR template
623 # Stub for completeness. Could be exported to DNS software that supports
624 # some degree of internal automagic in generic-record-creation
625 # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
626 } # AAAA+PTR template
627
628} # publishrec_bind()
629
630
631sub __publish_template_bind {
632 my $sub = shift;
633 my $recflags = shift;
634 my $hpat = shift;
635 my $zonefiles = shift;
636 my $loclist = shift;
637 my $ttl = shift;
638 my $stamp = shift;
639 my $loc = shift;
640 my $zone = new NetAddr::IP shift;
641 my $revrec = shift || 'y';
642# my $ptrflag = shift || 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
643
644 # do this conversion once, not (number-of-ips-in-subnet) times
645 my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa.', 'r', '.');
646
647 my $iplist = $sub->splitref(32);
648 my $ipindex = -1;
649 foreach (@$iplist) {
650 my $ip = $_->addr;
651 $ipindex++;
652 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
653 my $lastoct = (split /\./, $ip)[3];
654
655 # Allow smaller entries to override longer ones, eg, a specific PTR will
656 # always publish, overriding any template record containing that IP.
657 # %blank% also needs to be per-IP here to properly cascade overrides with
658 # multiple nested templates
659 next if $$recflags{$ip}; # && $self->{skip_bcast_255}
660 $$recflags{$ip}++;
661 next if $hpat eq '%blank%';
662
663 my $rec = $hpat; # start fresh with the template for each IP
664##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
665# seems less bad than some alternatives.
666 $dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
667 # _template4_expand may blank $rec; if so, don't publish a record
668 next if !$rec;
669##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
670# if ($ptrflag || $zone->masklen > 24) {
671 my $recdata;
672 if ($revrec eq 'y') {
673# || $zone->masklen > 24) {
674# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
675##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
676# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
677# if ($revrec ne 'y') {
678 # print a separate A record. Arguably we could use an = record here instead.
679# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
680# print $fh "$rec $ttl IN A $ip\n" or die $!;
681# }
682 if ($dnsdb->{bind_export_fqdn}) {
683 $recdata = "$lastoct.$arpabase $ttl IN PTR $rec.\n";
684 } else {
685 $recdata = "$lastoct $ttl IN PTR $rec.\n";
686 }
687
688 } else {
689 # A record, not merged
690# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
691# print $fh "$rec $ttl IN A $ip\n" or die $!;
692 $rec =~ s/\.$zone$// unless $dnsdb->{bind_export_fqdn};
693 $recdata = "$rec. $ttl IN A $ip\n";
694 }
695 # and finally
696 recprint($zonefiles, $loclist, $loc, $recdata);
697 } # foreach (@iplist)
698} # __publish_template_bind()
699
700
701# actual record printing sub
702# loop on the locations here so we don't end up with a huge pot of copypasta
703sub recprint {
704 my ($zonefiles, $loclist, $loc, $recdata) = @_;
705 if ($loc eq '') {
706 # "common" record visible in all locations
707 foreach my $rloc (@{$loclist}) {
708 print {$zonefiles->{$rloc}} $recdata or die $!;
709 }
710 } else {
711 # record with specific location tagged
712 print {$zonefiles->{$loc}} $recdata or die $!;
713 }
714}
715
7161;
Note: See TracBrowser for help on using the repository browser.