source: trunk/DNSDB/ExportBIND.pm@ 891

Last change on this file since 891 was 891, checked in by Kris Deugau, 6 days ago

/trunk

Fill in most bits of record "expiry"/"valid-after" for BIND-style zone
export, including a config option for the small TTL records will be set
to when actually preparing to "expire"
  • Property svn:keywords set to Date Rev Author Id
File size: 34.3 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 891 2025-06-25 21:27:31Z 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 ## Records that are valid only before or after a set time
465 # Note that BIND-style zone files fundamentally don't support this directly
466 # unlike tinydns, as it's not a native feature/function. Dropping TTLs to
467 # 15s or so is the best we can do for expiry. "Valid-after" is only as good
468 # as the export cron job timing.
469 if ($stampactive) {
470 my $now = time();
471 if ($expires) {
472 # record expires at $stamp; decide if we need to keep the TTL on file
473 # or set it to 15 so the record falls out of caches quickly sometime
474 # around the nominal expiry time.
475
476 # For weirdos who set huge TTLs, cap the TTL at one day. 30+ years ago
477 # long TTLs made sense when even DNS had a measurable cost in small
478 # networks; today DNS is below the noise floor in all but the largest
479 # networks and systems.
480 my $ahead = (86400 < $ttl*2 ? 86400 : $ttl*2);
481 if (($now + $ahead) < $stamp) {
482 # more than 2x TTL OR more than one day (whichever is less) from expiry time; publish normal record
483 } elsif ($now > $stamp) {
484 # record has expired; return early as we don't need to publish anything
485 return;
486 } else {
487 # less than 2x TTL from expiry time, set a short TTL
488 $ttl = $dnsdb->{bind_export_autoexpire_ttl};
489 }
490 } else {
491 # record is "active after"; return unless it's now after the nominal validity timestamp.
492 return unless $now >= $stamp;
493 }
494 } # if $stampactive
495
496 ## And now to the records!
497
498 if ($typemap{$type} eq 'SOA') {
499 # host contains pri-ns:responsible
500 # val is abused to contain refresh:retry:expire:minttl
501 # let's be explicit about abusing $host and $val
502 my ($email, $primary) = (split /:/, $host)[0,1];
503 my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
504 my $serial = 0; # fail less horribly than leaving it empty?
505 # just snarfing the right SOA serial for the zone type
506 if ($revrec eq 'y') {
507 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
508 } else {
509 ($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
510 } # revrec <> 'y'
511 # suppress a "uninitialized value" warning. should be impossible but...
512 # abuse hours as the last digit pair of the serial for simplicity
513##fixme?: alternate SOA serial schemes?
514 $serial = strftime("%Y%m%d%H", localtime()) if !$serial;
515 $primary .= "." if $primary !~ /\.$/;
516 $email .= "." if $email !~ /\.$/;
517# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
518# or die $!;
519# print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
520# or die "couldn't write $zone SOA: $!";
521
522 # Prepare the body of the record
523 my $recdata = "$ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n";
524
525 # ... and prepend the zone name FQDN
526 if ($revrec eq 'y') {
527 my $zone2 = DNSDB::_ZONE($zone, 'ZONE', 'r', '.').($zone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
528 $recdata = "$zone2. $recdata";
529 } else {
530 $recdata = "$zone. $recdata";
531 }
532
533 __recprint($zonefiles, $loclist, $loc, $recdata);
534 } # SOA
535
536 elsif ($typemap{$type} eq 'A') {
537 ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
538# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
539# print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
540 my $recdata = "$host. $ttl IN A $val\n";
541 __recprint($zonefiles, $loclist, $loc, $recdata);
542 } # A
543
544 elsif ($typemap{$type} eq 'NS') {
545 if ($revrec eq 'y') {
546 $val = NetAddr::IP->new($val);
547
548##fixme: conversion for sub-/24 delegations in reverse zones?
549# if (!$val->{isv6} && ($val->masklen > 24)) {
550# }
551
552 my $val2 = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
553 $host .= "." if $host !~ /\.$/;
554 my $recdata = "$val2. $ttl IN NS $host\n";
555 __recprint($zonefiles, $loclist, $loc, $recdata);
556
557 } else {
558 my $recdata = "$host. $ttl IN NS $val.\n";
559 __recprint($zonefiles, $loclist, $loc, $recdata);
560 }
561 } # NS
562
563 elsif ($typemap{$type} eq 'AAAA') {
564# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
565# print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
566 my $recdata = "$host. $ttl IN AAAA $val\n";
567 __recprint($zonefiles, $loclist, $loc, $recdata);
568 } # AAAA
569
570 elsif ($typemap{$type} eq 'MX') {
571# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
572# print {$zonefiles->{$loc}} "$host $ttl IN MX $distance $val\n" or die $!;
573# 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.
574 my $recdata = "$host. $ttl IN MX $distance $val.\n";
575 __recprint($zonefiles, $loclist, $loc, $recdata);
576 } # MX
577
578 elsif ($typemap{$type} eq 'TXT') {
579# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
580# print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
581 my $recdata = "$host. $ttl IN TXT \"$val\"\n";
582 __recprint($zonefiles, $loclist, $loc, $recdata);
583 } # TXT
584
585 elsif ($typemap{$type} eq 'CNAME') {
586# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
587# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
588 my $recdata = "$host. $ttl IN CNAME $val.\n";
589 __recprint($zonefiles, $loclist, $loc, $recdata);
590 } # CNAME
591
592 elsif ($typemap{$type} eq 'SRV') {
593# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
594# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
595 my $recdata = "$host $ttl IN SRV $distance $weight $port $val.\n";
596 __recprint($zonefiles, $loclist, $loc, $recdata);
597 } # SRV
598
599 elsif ($typemap{$type} eq 'RP') {
600# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
601# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
602 my $recdata = "$host. $ttl IN RP $val\n";
603 __recprint($zonefiles, $loclist, $loc, $recdata);
604 } # RP
605
606 elsif ($typemap{$type} eq 'PTR') {
607# $$recflags{$val}++;
608 # maybe track exclusions like this? so we can publish "all
609 # A and/or PTR records" irrespective of template records
610 $$recflags{$val} = 'ptr';
611 return if $host eq '%blank%';
612
613 if ($revrec eq 'y') {
614
615 if ($val =~ /\.arpa$/) {
616 # someone put in the formal .arpa name. humor them.
617 my $recdata = "$val. $ttl IN PTR $host.\n";
618 __recprint($zonefiles, $loclist, $loc, $recdata);
619 } else {
620 $zone = NetAddr::IP->new($zone);
621 if (!$zone->{isv6} && $zone->masklen > 24) {
622 # sub-octet v4 zone
623 ($val) = ($val =~ /\.(\d+)$/);
624 my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa. $ttl IN PTR $host.\n";
625 __recprint($zonefiles, $loclist, $loc, $recdata);
626 } else {
627 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
628 $val = NetAddr::IP->new($val);
629 my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
630 ". $ttl IN PTR $host.\n";
631 __recprint($zonefiles, $loclist, $loc, $recdata);
632 }
633 } # non-".arpa" $val
634
635 } else {
636 # PTRs in forward zones are less bizarre and insane than some other record types
637 # in reverse zones... OTOH we can't validate them any which way, so we cross our
638 # fingers and close our eyes and make it Someone Else's Problem.
639# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
640 my $recdata = "$host. $ttl IN PTR $val.\n";
641 __recprint($zonefiles, $loclist, $loc, $recdata);
642 }
643 } # PTR
644
645 elsif ($type == 65280) { # A+PTR
646 # Recurse to PTR or A as appropriate because BIND et al don't share
647 # the tinydns concept of merged forward/reverse records
648# %recflags gets updated in the PTR branch just above
649# $$recflags{$val}++;
650 if ($revrec eq 'y') {
651 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val,
652 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
653# ... but we need to tweak it for this case? so the A record gets published...
654#$$recflags{$val} = 'a+ptr';
655#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
656# printrec_bind($dnsdb, \%zonefiles, $recid, 'y', \@loclist, $revzone,
657# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
658# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
659# $loc, $stamp, $expires, $stampactive) = @_;
660 } else {
661 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val,
662 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
663 # set a unique flag to skip template expansion for this IP in forward zones
664 $$recflags{$val} = 'a';
665 }
666 } # A+PTR
667
668 elsif ($type == 65282) { # PTR template
669 # only useful for v4 with standard DNS software, since this expands all
670 # IPs in $zone (or possibly $val?) with autogenerated records
671 $val = NetAddr::IP->new($val);
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 } # PTR template
682
683 elsif ($type == 65283) { # A+PTR template
684 $val = NetAddr::IP->new($val);
685 # Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
686 return if $val->{isv6};
687
688 if ($val->masklen < 16) {
689 foreach my $sub ($val->split(16)) {
690 __publish_template_bind($dnsdb, $sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
691 }
692 } else {
693 __publish_template_bind($dnsdb, $val, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
694 }
695 } # A+PTR template
696
697 elsif ($type == 65284) { # AAAA+PTR template
698 # Stub for completeness. Could be exported to DNS software that supports
699 # some degree of internal automagic in generic-record-creation
700 # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
701 } # AAAA+PTR template
702
703} # printrec_bind()
704
705
706sub __publish_template_bind {
707 my $dnsdb = shift;
708 my $sub = shift;
709 my $recflags = shift;
710 my $hpat = shift;
711 my $zonefiles = shift;
712 my $loclist = shift;
713 my $ttl = shift;
714 my $stamp = shift;
715 my $loc = shift;
716 my $zpass = shift;
717 my $zone = new NetAddr::IP $zpass;
718# my $zone = new NetAddr::IP shift;
719 my $revrec = shift || 'y';
720# my $ptrflag = shift || 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
721
722 # do this conversion once, not (number-of-ips-in-subnet) times
723 my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa.', 'r', '.');
724
725 my $iplist = $sub->splitref(32);
726 my $ipindex = -1;
727 foreach (@$iplist) {
728 my $ip = $_->addr;
729 $ipindex++;
730 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
731 my $lastoct = (split /\./, $ip)[3];
732
733 # Allow smaller entries to override longer ones, eg, a specific PTR will
734 # always publish, overriding any template record containing that IP.
735 # %blank% also needs to be per-IP here to properly cascade overrides with
736 # multiple nested templates
737# next if $$recflags{$ip}; # && $self->{skip_bcast_255}
738
739# next if $$recflags{$ip} && ($$recflags{$ip} eq 'ptr' || $$recflags{$ip} eq 'a+ptr');
740
741 if ($revrec eq 'y') {
742 next if $$recflags{$ip}; # blanket exclusion; we do reverse records first
743 } else {
744##fixme: A record side templates not cascading correctly
745 # excluding ptr does NOT work, as it excludes ALL previously covered A+PTR template entries.
746 # we only want to exclude the singleton (A+)PTR ones
747 #if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'ptr')) {
748 if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'atemplate' || $$recflags{$ip} eq 'ptr')) {
749 # default skip case
750 next;
751 }
752 } # revrec branch for skipping template member expansion
753
754 # set a forward/reverse-unique flag in %recflags
755 $$recflags{$ip} = ($revrec eq 'y' ? 'ptrtemplate' : 'atemplate');
756 next if $hpat eq '%blank%';
757
758 my $rec = $hpat; # start fresh with the template for each IP
759##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
760# seems less bad than some alternatives.
761 $dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
762 # _template4_expand may blank $rec; if so, don't publish a record
763 next if !$rec;
764##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
765# if ($ptrflag || $zone->masklen > 24) {
766 my $recdata;
767 if ($revrec eq 'y') {
768# || $zone->masklen > 24) {
769# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
770##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
771# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
772# if ($revrec ne 'y') {
773 # print a separate A record. Arguably we could use an = record here instead.
774# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
775# print $fh "$rec $ttl IN A $ip\n" or die $!;
776# }
777 if ($dnsdb->{bind_export_fqdn}) {
778 $recdata = "$lastoct.$arpabase $ttl IN PTR $rec.\n";
779 } else {
780 $recdata = "$lastoct $ttl IN PTR $rec.\n";
781 }
782
783 } else {
784 # A record, not merged
785# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
786# print $fh "$rec $ttl IN A $ip\n" or die $!;
787 $rec =~ s/\.$zone$// unless $dnsdb->{bind_export_fqdn};
788 $recdata = "$rec. $ttl IN A $ip\n";
789 }
790 # and finally
791 __recprint($zonefiles, $loclist, $loc, $recdata);
792 } # foreach (@iplist)
793} # __publish_template_bind()
794
795
796# actual record printing sub
797# loop on the locations here so we don't end up with a huge pot of copypasta
798sub __recprint {
799 my ($zonefiles, $loclist, $loc, $recdata) = @_;
800 if ($loc eq '') {
801 # "common" record visible in all locations
802 foreach my $rloc (@{$loclist}) {
803 print {$zonefiles->{$rloc}} $recdata or die $!;
804 }
805 } else {
806 # record with specific location tagged
807 print {$zonefiles->{$loc}} $recdata or die $!;
808 }
809}
810
8111;
Note: See TracBrowser for help on using the repository browser.