source: trunk/DNSDB/ExportBIND.pm@ 881

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

/trunk

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

  • Check and create directory path to full zone file pathnames if needed

New(ish) work creeping in:
Clean up, sort, reorder, and otherwise harmonize revzone and domain loops:

  • Cross-copy/merge docucomments for most operational/semantic blocks
  • Reorder checks, tweaks, and cleanups
  • Make sure both loops are checking the same conditions in the same order
  • Trim data retrieval for SOA records, since they have no distance/weight/port by definition, and the type is defined. Update printrec_bind() calls to match.
  • Property svn:keywords set to Date Rev Author Id
File size: 34.0 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 881 2023-01-20 21:37:06Z 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(domain_id => $domid);
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$dnsdb->{dbh}->selectrow_array(
327 "SELECT host,val,ttl,record_id,location FROM records WHERE domain_id=? AND type=6");
328
329##fixme: do we even need @loclist passed in?
330 printrec_bind($dnsdb, \%zonefiles, \@loclist, $soa_id, 'n', \%recflags, $domain,
331 $soa_host, 6, $soa_val, 0, 0, 0, $soa_ttl, $loc, '');
332
333 } # if force_refresh etc
334
335 # tag the zonefile for publication in the view
336 push @{$viewzones{$loc}}, $domain;
337
338 } # foreach @loclist
339
340 # now the meat of the records
341 $recsth->execute($domid);
342 while (my ($host,$type,$val,$dist,$weight,$port,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $recsth->fetchrow_array) {
343##work need more subtle check - $recflags{$val} eq 'ptr' maybe?
344 next if $recflags{$recid};
345#next if $recflags{$val} && $type == 65280;# && !$dnsdb->{template_always_publish_a};
346
347 # Spaces are evil.
348 $host =~ s/^\s+//;
349 $host =~ s/\s+$//;
350 if ($typemap{$type} ne 'TXT') {
351 # Leading or trailng spaces could be legit in TXT records.
352 $val =~ s/^\s+//;
353 $val =~ s/\s+$//;
354 }
355
356 # Check for out-of-zone data
357 $host = $domain if $host eq '@';
358 if ($host !~ /$domain$/i) {
359 warn "Not exporting out-of-zone record $host $type $val, $ttl (zone $domain)\n";
360 next;
361 }
362
363 printrec_bind($dnsdb, \%zonefiles, \@loclist, $recid, 'n', \%recflags, $domain,
364 $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
365
366 $recflags{$recid} = 1;
367
368 } # while ($recsth)
369
370 # retrieve NS records for subdomains. not strictly required in current production
371 # context but may matter sometime down the road
372 my $subnssth = $dnsdb->{dbh}->prepare("SELECT r.host,r.val,r.ttl,r.record_id,r.loc,r.stamp,r.expires,r.stampactive ".
373 "FROM records r ".
374 "JOIN domains d ON r.domain_id=d.domain_id ".
375 "WHERE r.type=2 AND d.domain LIKE ?");
376 $subnssth->execute('%.'.$domain);
377 while (my ($host,$val,$ttl,$recid,$loc,$stamp,$expires,$stampactive) = $subnssth->fetchrow_array) {
378 printrec_bind($dnsdb, \%zonefiles, \@loclist, $recid, 'n', \%recflags, $domain,
379 $host, 2, $val, '', '', '', $ttl, $loc, $stamp, $expires, $stampactive);
380 } # subdomain-ns-recsth
381
382
383# if ($self->{usecache}) {
384# close ZONECACHE; # force the file to be written
385# # catch obvious write errors that leave an empty temp file
386# if (-s $tmpcache) {
387# rename $tmpcache, $cachefile
388# or die "Error overwriting cache file $cachefile with temporary file: $!\n";
389# }
390# }
391
392# } # if $changed or cache filesize is 0
393
394 };
395 if ($@) {
396 die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$domain: $@\n";
397 # error! something borked, and we should be able to fall back on the old cache file
398 # report the error, somehow.
399 } else {
400 # mark zone as unmodified. Only do this if no errors, that way
401 # export failures should recover a little more automatically.
402 $zonesth->execute($domid);
403 }
404
405# if ($dnsdb->{usecache}) {
406# # We've already made as sure as we can that a cached zone file is "good",
407# # although possibly stale/obsolete due to errors creating a new one.
408# eval {
409# open CACHE, "<$cachefile" or die $!;
410# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
411# close CACHE;
412# };
413# die $@ if $@;
414# }
415
416 } # domsth->fetch
417
418
419
420 # Write the view configuration last, because otherwise we have to be horribly inefficient
421 # at figuring out which zones are visible/present in which views
422 if ($viewlist) {
423 my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
424 open BINDCONF, ">", $tmpconf;
425
426 foreach my $view (@{$viewlist}, { location => 'common', iplist => '' }) {
427#print Dumper($view);
428 print BINDCONF "view $view->{location} {\n";
429# print "view $view->{location} {\n";
430 # could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
431 # note that some semantics of data visibility need to be handled by the record export, since it's
432 # not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
433 # same as a BIND view with match-clients { any; };
434 if ($view->{iplist}) {
435 print BINDCONF " match-clients { ".join("; ", $view->{iplist})."; };\n";
436# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
437 } else {
438 print BINDCONF " match-clients { any; };\n";
439# print " match-clients { any; };\n";
440 }
441 foreach my $zone (@{$viewzones{$view->{location}}}) {
442##fixme: notify settings, maybe per-zone?
443 print BINDCONF qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
444# print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
445 }
446 print BINDCONF "};\n\n";
447 print "};\n\n";
448 } # foreach @$viewlist
449 rename $tmpconf, $dnsdb->{bind_zone_conf};
450 } # if $viewlist
451
452} # export()
453
454
455# Print individual records in BIND format
456sub printrec_bind {
457 my $dnsdb = shift;
458
459# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
460 my ($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
461 $loc, $stamp, $expires, $stampactive) = @_;
462
463# make sure "global" records get into all the right per-view zone files, without having to do this loop in each record-print location
464##fixme: maybe exclude the template types? those may be more expensive to export
465## *ponder* may be more efficient to loop in each record print due to substitution and manipulation from stored data to formal
466## record for .arpa zones for all records
467 if ($loc eq '') {
468 foreach my $subloc (@{$loclist}) {
469 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val,
470 $distance, $weight, $port, $ttl, $subloc, $stamp, $expires, $stampactive);
471 }
472 }
473
474 # Just In Case something is lingering in the DB
475 $loc = '' if !$loc;
476
477 ## And now to the records!
478
479 if ($typemap{$type} eq 'SOA') {
480 # host contains pri-ns:responsible
481 # val is abused to contain refresh:retry:expire:minttl
482 # let's be explicit about abusing $host and $val
483 my ($email, $primary) = (split /:/, $host)[0,1];
484 my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
485 my $serial = 0; # fail less horribly than leaving it empty?
486 # just snarfing the right SOA serial for the zone type
487 if ($revrec eq 'y') {
488 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
489 } else {
490 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
491 } # revrec <> 'y'
492 # suppress a "uninitialized value" warning. should be impossible but...
493 # abuse hours as the last digit pair of the serial for simplicity
494##fixme?: alternate SOA serial schemes?
495 $serial = strftime("%Y%m%d%H", localtime()) if !$serial;
496 $primary .= "." if $primary !~ /\.$/;
497 $email .= "." if $email !~ /\.$/;
498# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
499# or die $!;
500# print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
501# or die "couldn't write $zone SOA: $!";
502
503 # Prepare the body of the record
504 my $recdata = "$ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n";
505
506 # ... and prepend the zone name FQDN
507 if ($revrec eq 'y') {
508 my $zone2 = DNSDB::_ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
509 $recdata = "$zone2. $recdata";
510 } else {
511 $recdata = "$zone. $recdata";
512 }
513
514 __recprint($zonefiles, $loclist, $loc, $recdata);
515 } # SOA
516
517 elsif ($typemap{$type} eq 'A') {
518 ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
519# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
520# print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
521 my $recdata = "$host. $ttl IN A $val\n";
522 __recprint($zonefiles, $loclist, $loc, $recdata);
523 } # A
524
525 elsif ($typemap{$type} eq 'NS') {
526 if ($revrec eq 'y') {
527 $val = NetAddr::IP->new($val);
528
529##fixme: conversion for sub-/24 delegations in reverse zones?
530# if (!$val->{isv6} && ($val->masklen > 24)) {
531# }
532
533 my $val2 = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
534 $host .= "." if $host !~ /\.$/;
535 my $recdata = "$val2. $ttl IN NS $host\n";
536 __recprint($zonefiles, $loclist, $loc, $recdata);
537
538 } else {
539 my $recdata = "$host. $ttl IN NS $val.\n";
540 __recprint($zonefiles, $loclist, $loc, $recdata);
541 }
542 } # NS
543
544 elsif ($typemap{$type} eq 'AAAA') {
545# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
546# print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
547 my $recdata = "$host. $ttl IN AAAA $val\n";
548 __recprint($zonefiles, $loclist, $loc, $recdata);
549 } # AAAA
550
551 elsif ($typemap{$type} eq 'MX') {
552# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
553# print {$zonefiles->{$loc}} "$host $ttl IN MX $distance $val\n" or die $!;
554# 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.
555 my $recdata = "$host. $ttl IN MX $distance $val.\n";
556 __recprint($zonefiles, $loclist, $loc, $recdata);
557 } # MX
558
559 elsif ($typemap{$type} eq 'TXT') {
560# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
561# print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
562 my $recdata = "$host. $ttl IN TXT \"$val\"\n";
563 __recprint($zonefiles, $loclist, $loc, $recdata);
564 } # TXT
565
566 elsif ($typemap{$type} eq 'CNAME') {
567# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
568# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
569 my $recdata = "$host. $ttl IN CNAME $val.\n";
570 __recprint($zonefiles, $loclist, $loc, $recdata);
571 } # CNAME
572
573 elsif ($typemap{$type} eq 'SRV') {
574# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
575# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
576 my $recdata = "$host $ttl IN SRV $distance $weight $port $val.\n";
577 __recprint($zonefiles, $loclist, $loc, $recdata);
578 } # SRV
579
580 elsif ($typemap{$type} eq 'RP') {
581# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
582# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
583 my $recdata = "$host. $ttl IN RP $val\n";
584 __recprint($zonefiles, $loclist, $loc, $recdata);
585 } # RP
586
587 elsif ($typemap{$type} eq 'PTR') {
588# $$recflags{$val}++;
589 # maybe track exclusions like this? so we can publish "all
590 # A and/or PTR records" irrespective of template records
591 $$recflags{$val} = 'ptr';
592 if ($revrec eq 'y') {
593
594 if ($val =~ /\.arpa$/) {
595 # someone put in the formal .arpa name. humor them.
596# print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
597 my $recdata = "$val. $ttl IN PTR $host.\n";
598 __recprint($zonefiles, $loclist, $loc, $recdata);
599 } else {
600 $zone = NetAddr::IP->new($zone);
601 if (!$zone->{isv6} && $zone->masklen > 24) {
602 # sub-octet v4 zone
603 ($val) = ($val =~ /\.(\d+)$/);
604# print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
605# " $ttl IN PTR $host\n"
606# or die $!;
607 my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa. $ttl IN PTR $host.\n";
608 __recprint($zonefiles, $loclist, $loc, $recdata);
609 } else {
610 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
611 $val = NetAddr::IP->new($val);
612# print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
613# " $ttl IN PTR $host\n"
614# or die $!;
615 my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
616 ". $ttl IN PTR $host.\n";
617 __recprint($zonefiles, $loclist, $loc, $recdata);
618 }
619 } # non-".arpa" $val
620
621 } else {
622 # PTRs in forward zones are less bizarre and insane than some other record types
623 # in reverse zones... OTOH we can't validate them any which way, so we cross our
624 # fingers and close our eyes and make it Someone Else's Problem.
625# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
626 my $recdata = "$host. $ttl IN PTR $val.\n";
627 __recprint($zonefiles, $loclist, $loc, $recdata);
628 }
629 } # PTR
630
631 elsif ($type == 65280) { # A+PTR
632 # Recurse to PTR or A as appropriate because BIND et al don't share
633 # the tinydns concept of merged forward/reverse records
634# %recflags gets updated in the PTR branch just above
635# $$recflags{$val}++;
636 if ($revrec eq 'y') {
637 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val,
638 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
639# ... but we need to tweak it for this case? so the A record gets published...
640#$$recflags{$val} = 'a+ptr';
641#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
642# printrec_bind($dnsdb, \%zonefiles, $recid, 'y', \@loclist, $revzone,
643# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
644# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
645# $loc, $stamp, $expires, $stampactive) = @_;
646 } else {
647 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val,
648 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
649 # set a unique flag to skip template expansion for this IP in forward zones
650 $$recflags{$val} = 'a';
651 }
652 } # A+PTR
653
654 elsif ($type == 65282) { # PTR template
655 # only useful for v4 with standard DNS software, since this expands all
656 # IPs in $zone (or possibly $val?) with autogenerated records
657 $val = NetAddr::IP->new($val);
658 return if $val->{isv6};
659
660 if ($val->masklen <= 16) {
661 foreach my $sub ($val->split(16)) {
662 __publish_template_bind($dnsdb, $sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
663 }
664 } else {
665 __publish_template_bind($dnsdb, $val, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
666 }
667 } # PTR template
668
669 elsif ($type == 65283) { # A+PTR template
670 $val = NetAddr::IP->new($val);
671 # Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
672 return if $val->{isv6};
673
674 if ($val->masklen < 16) {
675 foreach my $sub ($val->split(16)) {
676 __publish_template_bind($dnsdb, $sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
677 }
678 } else {
679 __publish_template_bind($dnsdb, $val, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
680 }
681 } # A+PTR template
682
683 elsif ($type == 65284) { # AAAA+PTR template
684 # Stub for completeness. Could be exported to DNS software that supports
685 # some degree of internal automagic in generic-record-creation
686 # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
687 } # AAAA+PTR template
688
689} # printrec_bind()
690
691
692sub __publish_template_bind {
693 my $dnsdb = shift;
694 my $sub = shift;
695 my $recflags = shift;
696 my $hpat = shift;
697 my $zonefiles = shift;
698 my $loclist = shift;
699 my $ttl = shift;
700 my $stamp = shift;
701 my $loc = shift;
702 my $zpass = shift;
703 my $zone = new NetAddr::IP $zpass;
704# my $zone = new NetAddr::IP shift;
705 my $revrec = shift || 'y';
706# my $ptrflag = shift || 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
707
708 # do this conversion once, not (number-of-ips-in-subnet) times
709 my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa.', 'r', '.');
710
711 my $iplist = $sub->splitref(32);
712 my $ipindex = -1;
713 foreach (@$iplist) {
714 my $ip = $_->addr;
715 $ipindex++;
716 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
717 my $lastoct = (split /\./, $ip)[3];
718
719 # Allow smaller entries to override longer ones, eg, a specific PTR will
720 # always publish, overriding any template record containing that IP.
721 # %blank% also needs to be per-IP here to properly cascade overrides with
722 # multiple nested templates
723# next if $$recflags{$ip}; # && $self->{skip_bcast_255}
724
725# next if $$recflags{$ip} && ($$recflags{$ip} eq 'ptr' || $$recflags{$ip} eq 'a+ptr');
726
727 if ($revrec eq 'y') {
728 next if $$recflags{$ip}; # blanket exclusion; we do reverse records first
729 } else {
730##fixme: A record side templates not cascading correctly
731 # excluding ptr does NOT work, as it excludes ALL previously covered A+PTR template entries.
732 # we only want to exclude the singleton (A+)PTR ones
733 #if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'ptr')) {
734 if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'atemplate' || $$recflags{$ip} eq 'ptr')) {
735 # default skip case
736 next;
737 }
738 } # revrec branch for skipping template member expansion
739
740 # set a forward/reverse-unique flag in %recflags
741 $$recflags{$ip} = ($revrec eq 'y' ? 'ptrtemplate' : 'atemplate');
742 next if $hpat eq '%blank%';
743
744 my $rec = $hpat; # start fresh with the template for each IP
745##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
746# seems less bad than some alternatives.
747 $dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
748 # _template4_expand may blank $rec; if so, don't publish a record
749 next if !$rec;
750##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
751# if ($ptrflag || $zone->masklen > 24) {
752 my $recdata;
753 if ($revrec eq 'y') {
754# || $zone->masklen > 24) {
755# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
756##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
757# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
758# if ($revrec ne 'y') {
759 # print a separate A record. Arguably we could use an = record here instead.
760# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
761# print $fh "$rec $ttl IN A $ip\n" or die $!;
762# }
763 if ($dnsdb->{bind_export_fqdn}) {
764 $recdata = "$lastoct.$arpabase $ttl IN PTR $rec.\n";
765 } else {
766 $recdata = "$lastoct $ttl IN PTR $rec.\n";
767 }
768
769 } else {
770 # A record, not merged
771# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
772# print $fh "$rec $ttl IN A $ip\n" or die $!;
773 $rec =~ s/\.$zone$// unless $dnsdb->{bind_export_fqdn};
774 $recdata = "$rec. $ttl IN A $ip\n";
775 }
776 # and finally
777 __recprint($zonefiles, $loclist, $loc, $recdata);
778 } # foreach (@iplist)
779} # __publish_template_bind()
780
781
782# actual record printing sub
783# loop on the locations here so we don't end up with a huge pot of copypasta
784sub __recprint {
785 my ($zonefiles, $loclist, $loc, $recdata) = @_;
786 if ($loc eq '') {
787 # "common" record visible in all locations
788 foreach my $rloc (@{$loclist}) {
789 print {$zonefiles->{$rloc}} $recdata or die $!;
790 }
791 } else {
792 # record with specific location tagged
793 print {$zonefiles->{$loc}} $recdata or die $!;
794 }
795}
796
7971;
Note: See TracBrowser for help on using the repository browser.