source: trunk/DNSDB/ExportBIND.pm@ 872

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

/trunk

BIND export, unwinding dev saves, 24 of many many

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