source: trunk/DNSDB/ExportBIND.pm@ 878

Last change on this file since 878 was 878, checked in by Kris Deugau, 16 months ago

/trunk

BIND export, unwinding dev saves, intermediate cleanup

Do a "does this run without execution errors?" pass over BIND export.

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