source: trunk/DNSDB/ExportBIND.pm@ 895

Last change on this file since 895 was 895, checked in by Kris Deugau, 4 days ago

/trunk

Commit some tagalongs in ExportBIND.pm that go along with the general
validator update and tinydns export tweak for RPZ zones from r888
  • Property svn:keywords set to Date Rev Author Id
File size: 34.6 KB
Line 
1# dns/trunk/DNSDB/ExportBIND.pm
2# BIND data export/publication
3# Call through DNSDB.pm's export() sub
4##
5# $Id: ExportBIND.pm 895 2025-06-27 18:08:46Z 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 ($domain !~ /\.rpz$/ && $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 # Clean up some lingering tinydns/VegaDNSisms
582 DNSDB::_deoctal(\$val);
583 my $recdata = "$host. $ttl IN TXT \"$val\"\n";
584 __recprint($zonefiles, $loclist, $loc, $recdata);
585 } # TXT
586
587 elsif ($typemap{$type} eq 'CNAME') {
588# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
589# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
590 my $recdata;
591 if ($zone =~ /\.rpz$/) {
592 # RPZ data stored and published as-is
593 $recdata = "$host $ttl IN CNAME $val\n";
594 } else {
595 $recdata = "$host. $ttl IN CNAME $val.\n";
596 }
597 __recprint($zonefiles, $loclist, $loc, $recdata);
598 } # CNAME
599
600 elsif ($typemap{$type} eq 'SRV') {
601# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
602# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
603 my $recdata = "$host $ttl IN SRV $distance $weight $port $val.\n";
604 __recprint($zonefiles, $loclist, $loc, $recdata);
605 } # SRV
606
607 elsif ($typemap{$type} eq 'RP') {
608# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
609# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
610 my $recdata = "$host. $ttl IN RP $val\n";
611 __recprint($zonefiles, $loclist, $loc, $recdata);
612 } # RP
613
614 elsif ($typemap{$type} eq 'PTR') {
615# $$recflags{$val}++;
616 # maybe track exclusions like this? so we can publish "all
617 # A and/or PTR records" irrespective of template records
618 $$recflags{$val} = 'ptr';
619 return if $host eq '%blank%';
620
621 if ($revrec eq 'y') {
622
623 if ($val =~ /\.arpa$/) {
624 # someone put in the formal .arpa name. humor them.
625 my $recdata = "$val. $ttl IN PTR $host.\n";
626 __recprint($zonefiles, $loclist, $loc, $recdata);
627 } else {
628 $zone = NetAddr::IP->new($zone);
629 if (!$zone->{isv6} && $zone->masklen > 24) {
630 # sub-octet v4 zone
631 ($val) = ($val =~ /\.(\d+)$/);
632 my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa. $ttl IN PTR $host.\n";
633 __recprint($zonefiles, $loclist, $loc, $recdata);
634 } else {
635 # not going to care about strange results if $val is not an IP value and is resolveable in DNS
636 $val = NetAddr::IP->new($val);
637 my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
638 ". $ttl IN PTR $host.\n";
639 __recprint($zonefiles, $loclist, $loc, $recdata);
640 }
641 } # non-".arpa" $val
642
643 } else {
644 # PTRs in forward zones are less bizarre and insane than some other record types
645 # in reverse zones... OTOH we can't validate them any which way, so we cross our
646 # fingers and close our eyes and make it Someone Else's Problem.
647# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
648 my $recdata = "$host. $ttl IN PTR $val.\n";
649 __recprint($zonefiles, $loclist, $loc, $recdata);
650 }
651 } # PTR
652
653 elsif ($type == 65280) { # A+PTR
654 # Recurse to PTR or A as appropriate because BIND et al don't share
655 # the tinydns concept of merged forward/reverse records
656# %recflags gets updated in the PTR branch just above
657# $$recflags{$val}++;
658 if ($revrec eq 'y') {
659 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val,
660 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
661# ... but we need to tweak it for this case? so the A record gets published...
662#$$recflags{$val} = 'a+ptr';
663#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
664# printrec_bind($dnsdb, \%zonefiles, $recid, 'y', \@loclist, $revzone,
665# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
666# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
667# $loc, $stamp, $expires, $stampactive) = @_;
668 } else {
669 printrec_bind($dnsdb, $zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val,
670 $distance, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
671 # set a unique flag to skip template expansion for this IP in forward zones
672 $$recflags{$val} = 'a';
673 }
674 } # A+PTR
675
676 elsif ($type == 65282) { # PTR template
677 # only useful for v4 with standard DNS software, since this expands all
678 # IPs in $zone (or possibly $val?) with autogenerated records
679 $val = NetAddr::IP->new($val);
680 return if $val->{isv6};
681
682 if ($val->masklen <= 16) {
683 foreach my $sub ($val->split(16)) {
684 __publish_template_bind($dnsdb, $sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
685 }
686 } else {
687 __publish_template_bind($dnsdb, $val, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
688 }
689 } # PTR template
690
691 elsif ($type == 65283) { # A+PTR template
692 $val = NetAddr::IP->new($val);
693 # Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
694 return if $val->{isv6};
695
696 if ($val->masklen < 16) {
697 foreach my $sub ($val->split(16)) {
698 __publish_template_bind($dnsdb, $sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
699 }
700 } else {
701 __publish_template_bind($dnsdb, $val, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
702 }
703 } # A+PTR template
704
705 elsif ($type == 65284) { # AAAA+PTR template
706 # Stub for completeness. Could be exported to DNS software that supports
707 # some degree of internal automagic in generic-record-creation
708 # (eg http://search.cpan.org/dist/AllKnowingDNS/ )
709 } # AAAA+PTR template
710
711} # printrec_bind()
712
713
714sub __publish_template_bind {
715 my $dnsdb = shift;
716 my $sub = shift;
717 my $recflags = shift;
718 my $hpat = shift;
719 my $zonefiles = shift;
720 my $loclist = shift;
721 my $ttl = shift;
722 my $stamp = shift;
723 my $loc = shift;
724 my $zpass = shift;
725 my $zone = new NetAddr::IP $zpass;
726# my $zone = new NetAddr::IP shift;
727 my $revrec = shift || 'y';
728# my $ptrflag = shift || 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
729
730 # do this conversion once, not (number-of-ips-in-subnet) times
731 my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa.', 'r', '.');
732
733 my $iplist = $sub->splitref(32);
734 my $ipindex = -1;
735 foreach (@$iplist) {
736 my $ip = $_->addr;
737 $ipindex++;
738 # make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
739 my $lastoct = (split /\./, $ip)[3];
740
741 # Allow smaller entries to override longer ones, eg, a specific PTR will
742 # always publish, overriding any template record containing that IP.
743 # %blank% also needs to be per-IP here to properly cascade overrides with
744 # multiple nested templates
745# next if $$recflags{$ip}; # && $self->{skip_bcast_255}
746
747# next if $$recflags{$ip} && ($$recflags{$ip} eq 'ptr' || $$recflags{$ip} eq 'a+ptr');
748
749 if ($revrec eq 'y') {
750 next if $$recflags{$ip}; # blanket exclusion; we do reverse records first
751 } else {
752##fixme: A record side templates not cascading correctly
753 # excluding ptr does NOT work, as it excludes ALL previously covered A+PTR template entries.
754 # we only want to exclude the singleton (A+)PTR ones
755 #if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'ptr')) {
756 if ($$recflags{$ip} && ($$recflags{$ip} eq 'a' || $$recflags{$ip} eq 'atemplate' || $$recflags{$ip} eq 'ptr')) {
757 # default skip case
758 next;
759 }
760 } # revrec branch for skipping template member expansion
761
762 # set a forward/reverse-unique flag in %recflags
763 $$recflags{$ip} = ($revrec eq 'y' ? 'ptrtemplate' : 'atemplate');
764 next if $hpat eq '%blank%';
765
766 my $rec = $hpat; # start fresh with the template for each IP
767##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
768# seems less bad than some alternatives.
769 $dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
770 # _template4_expand may blank $rec; if so, don't publish a record
771 next if !$rec;
772##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
773# if ($ptrflag || $zone->masklen > 24) {
774 my $recdata;
775 if ($revrec eq 'y') {
776# || $zone->masklen > 24) {
777# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
778##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
779# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
780# if ($revrec ne 'y') {
781 # print a separate A record. Arguably we could use an = record here instead.
782# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
783# print $fh "$rec $ttl IN A $ip\n" or die $!;
784# }
785 if ($dnsdb->{bind_export_fqdn}) {
786 $recdata = "$lastoct.$arpabase $ttl IN PTR $rec.\n";
787 } else {
788 $recdata = "$lastoct $ttl IN PTR $rec.\n";
789 }
790
791 } else {
792 # A record, not merged
793# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
794# print $fh "$rec $ttl IN A $ip\n" or die $!;
795 $rec =~ s/\.$zone$// unless $dnsdb->{bind_export_fqdn};
796 $recdata = "$rec. $ttl IN A $ip\n";
797 }
798 # and finally
799 __recprint($zonefiles, $loclist, $loc, $recdata);
800 } # foreach (@iplist)
801} # __publish_template_bind()
802
803
804# actual record printing sub
805# loop on the locations here so we don't end up with a huge pot of copypasta
806sub __recprint {
807 my ($zonefiles, $loclist, $loc, $recdata) = @_;
808 if ($loc eq '') {
809 # "common" record visible in all locations
810 foreach my $rloc (@{$loclist}) {
811 print {$zonefiles->{$rloc}} $recdata or die $!;
812 }
813 } else {
814 # record with specific location tagged
815 print {$zonefiles->{$loc}} $recdata or die $!;
816 }
817}
818
8191;
Note: See TracBrowser for help on using the repository browser.