source: trunk/DNSDB/ExportBIND.pm@ 873

Last change on this file since 873 was 873, checked in by Kris Deugau, 3 years ago

/trunk

BIND export, unwinding dev saves, 25 of many many

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