source: trunk/DNSDB/ExportBIND.pm@ 882

Last change on this file since 882 was 882, checked in by Kris Deugau, 22 months ago

/trunk

BIND export, unwinding dev saves, 30 of ~35?

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