source: trunk/DNSDB/ExportBIND.pm@ 880

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

/trunk

BIND export, unwinding dev saves, home stretch

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