Context Navigation

source: trunk/DNSDB/ExportBIND.pm@ 870

Last change on this file since 870 was 870, checked in by Kris Deugau, 2 years ago

/trunk

BIND export, unwinding dev saves, 22 of many many

Refine/tighten reverse zone export order
Note zone<->location relationship for future need
Forcibly include 'common' location in locations list
Minor cleanup for correctness in BIND configuration fragment

Property svn:keywords set to Date Rev Author Id

File size: 21.6 KB

Rev	Line
[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 870 2022-09-28 19:56:15Z 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
	22	package DNSDB::ExportBIND;
	23
	24	use strict;
	25	use warnings;
	26
	27	sub export {
	28	# expected to be a DNSDB object
[855]	29	my $dnsdb = shift;
[847]	30
[849]	31	# to be a hash of views/locations, containing lists of zones
	32	my %viewzones;
	33
[848]	34	# allow for future exports of subgroups of records
[855]	35	my $viewlist = $dnsdb->getLocList(curgroup => 1);
[847]	36
[855]	37	my $soasth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location ".
[850]	38	"FROM records WHERE rdns_id=? AND type=6");
[855]	39	my $recsth = $dnsdb->{dbh}->prepare("SELECT host,type,val,distance,weight,port,ttl,record_id,location,extract(epoch from stamp),expires,stampactive ".
[850]	40	"FROM records WHERE rdns_id=? AND NOT type=6 ".
	41	"ORDER BY masklen(inetlazy(val)) DESC, inetlazy(val)");
	42
[849]	43	# Fetch active zone list
[855]	44	my $revsth = $dnsdb->{dbh}->prepare("SELECT rdns_id,revnet,status,changed,default_location FROM revzones WHERE status=1 ".
[870]	45	"ORDER BY masklen(revnet),revnet DESC, rdns_id");
[849]	46	# Unflag changed zones, so we can maybe cache the export and not redo everything every time
[855]	47	my $zonesth = $dnsdb->{dbh}->prepare("UPDATE revzones SET changed='n' WHERE rdns_id=?");
[849]	48	$revsth->execute();
[865]	49
	50	my %recflags; # need this to be independent for forward vs reverse zones, as they're not merged
	51
[849]	52	while (my ($revid,$revzone,$revstat,$changed,$defloc) = $revsth->fetchrow_array) {
[856]	53	my $cidr = NetAddr::IP->new($revzone);
	54	my $zfile = $cidr->network->addr."-".$cidr->masklen;
[855]	55	# my $cachefile = "$dnsdb->{exportcache}/$zfile";
	56	# my $tmpcache = "$dnsdb->{exportcache}/tmp.$zfile.$$";
[850]	57	my $tmpcache = "tmp.$zfile.$$"; # safety net. don't overwrite a previous known-good file
	58
	59	##fixme: convert logical revzone into .arpa name? maybe take a slice of showrev_arpa?
	60	##fixme: need to bodge logical non-octet-boundary revzones into octet-boundary revzones
	61	##fixme: do we do cache files? views balloon the file count stupidly
[856]	62	## foreach $octetzone $cidr->split(octet-boundary)
	63	## loclist = SELECT DISTINCT location FROM records WHERE rdns_id = $zid AND inetlazy(val) <<= $octetzone
[850]	64
[856]	65	#printf "non-octet? %s, %i\n", $cidr->masklen, $cidr->masklen % 8;
[850]	66
[856]	67
[851]	68	eval {
	69
[859]	70	my $arpazone = DNSDB::_ZONE($cidr, 'ZONE', 'r', '.').($cidr->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
	71
[851]	72	# write fresh records if:
	73	# - we are not using the cache
	74	# - force_refresh is set
	75	# - the zone has changed
	76	# - the cache file does not exist
	77	# - the cache file is empty
[855]	78	if (!$dnsdb->{usecache} \|\| $dnsdb->{force_refresh} \|\| $changed \|\| !-e $cachefile \|\| -z $cachefile) {
	79	if ($dnsdb->{usecache}) {
[851]	80	open ZONECACHE, ">$tmpcache" or die "Error creating temporary file $tmpcache: $!\n";
	81	$zonefilehandle = *ZONECACHE;
	82	}
	83
[853]	84	# fetch a list of views/locations present in the zone. we need to publish a file for each one.
	85	# in the event that no locations are present (~~ $viewlist is empty), /%view collapses to nothing in the zone path
[868]	86	# my (@loclist) = $dnsdb->{dbh}->selectrow_array("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
	87	my $tmplocs = $dnsdb->{dbh}->selectall_arrayref("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
	88	my @loclist;
	89	foreach my $tloc (@{$tmplocs}) {
	90	push @loclist, ($tloc->[0] eq '' ? 'common' : $tloc->[0]);
	91	}
	92
[853]	93	push @loclist, $defloc unless grep /$defloc/, @loclist;
[868]	94	push @loclist, 'common' unless grep /^common$/, @loclist;
[856]	95	my $zonepath = $dnsdb->{bind_export_reverse_zone_path};
[859]	96	my %zonefiles; # to be a hash of file handles.
[856]	97	##fixme: need to open separate zone files for aggregated metazones eg /22 or /14
[853]	98	foreach my $loc (@loclist) {
	99	my $zfilepath = $zonepath;
	100	$zfilepath =~ s/\%view/$loc/;
	101	$zfilepath =~ s/\%zone/$revzone/;
[856]	102	$zfilepath =~ s/\%arpazone/$arpazone/;
[853]	103	# Just In Case(TM)
	104	$zfilepath =~ s,[^\w./-],_,g;
[859]	105	open $zonefiles{$loc}, ">", $zfilepath;
[868]	106	printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime)
[870]	107	or die "Error writing header [$zone, '$loc']: $!\n";;
	108	# tag the zonefile for publication in the view
	109	push @{$viewzones{$loc}}, $arpazone;
	110	} # foreach @loclist
[853]	111
[851]	112	# need to fetch this separately since the rest of the records all (should) have real IPs in val
	113	$soasth->execute($revid);
	114	my (@zsoa) = $soasth->fetchrow_array();
[869]	115
[865]	116	##fixme: do we even need @loclist passed in?
[869]	117	publishrec_bind(\%zonefiles, \@loclist, $zsoa[7], 'y', \%recflags, $revzone,
	118	$zsoa[0], $zsoa[1], $zsoa[2], $zsoa[3], $zsoa[4], $zsoa[5], $zsoa[6], $loc, '');
[851]	119
	120	$recsth->execute($revid);
	121	my $fullzone = _ZONE($tmpzone, 'ZONE', 'r', '.').($tmpzone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
	122
	123	while (my ($host, $type, $val, $dist, $weight, $port, $ttl, $recid, $loc, $stamp, $expires, $stampactive)
	124	= $recsth->fetchrow_array) {
	125	next if $recflags{$recid};
	126
	127	# Check for out-of-zone data
	128	if ($val =~ /\.arpa$/) {
	129	# val is non-IP
	130	if ($val !~ /$fullzone$/) {
	131	warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
	132	next;
	133	}
	134	} else {
	135	my $ipval = new NetAddr::IP $val;
	136	if (!$tmpzone->contains($ipval)) {
	137	warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
	138	next;
	139	}
	140	} # is $val a raw .arpa name?
	141
	142	# Spaces are evil.
	143	$val =~ s/^\s+//;
	144	$val =~ s/\s+$//;
	145	if ($typemap{$type} ne 'TXT') {
	146	# Leading or trailng spaces could be legit in TXT records.
	147	$host =~ s/^\s+//;
	148	$host =~ s/\s+$//;
	149	}
	150
[869]	151	publishrec_bind(\%zonefiles, \@loclist, $recid, 'y', \%recflags, $revzone,
[851]	152	$host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
	153
	154	$recflags{$recid} = 1;
	155
	156	} # while ($recsth)
	157
[855]	158	if ($dnsdb->{usecache}) {
[851]	159	close ZONECACHE; # force the file to be written
	160	# catch obvious write errors that leave an empty temp file
	161	if (-s $tmpcache) {
	162	rename $tmpcache, $cachefile
	163	or die "Error overwriting cache file $cachefile with temporary file: $!\n";
	164	}
	165	}
	166
	167	} # if $changed or cache filesize is 0
	168
	169	};
	170	if ($@) {
[855]	171	die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
[851]	172	# error! something borked, and we should be able to fall back on the old cache file
	173	# report the error, somehow.
	174	} else {
	175	# mark zone as unmodified. Only do this if no errors, that way
	176	# export failures should recover a little more automatically.
	177	$zonesth->execute($revid);
	178	}
	179
[855]	180	# if ($dnsdb->{usecache}) {
[851]	181	# # We've already made as sure as we can that a cached zone file is "good",
	182	# # although possibly stale/obsolete due to errors creating a new one.
	183	# eval {
	184	# open CACHE, "<$cachefile" or die $!;
	185	# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
	186	# close CACHE;
	187	# };
	188	# die $@ if $@;
	189	# }
	190
	191
	192
[849]	193	} # revsth->fetch
	194
	195
	196	# Write the view configuration last, because otherwise we have to be horribly inefficient
	197	# at figuring out which zones are visible/present in which views
[848]	198	if ($viewlist) {
[857]	199	my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
	200	open BINDCONF, ">", $tmpconf;
	201
[870]	202	foreach my $view (@{$viewlist}, 'common') {
[848]	203	#print Dumper($view);
[857]	204	print BINDCONF "view $view->{location} {\n";
	205	# print "view $view->{location} {\n";
[848]	206	# could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
	207	# note that some semantics of data visibility need to be handled by the record export, since it's
	208	# not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
	209	# same as a BIND view with match-clients { any; };
	210	if ($view->{iplist}) {
[870]	211	print BINDCONF " match-clients { ".join("; ", $view->{iplist})."; };\n";
[857]	212	# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
[848]	213	} else {
[857]	214	print BINDCONF " match-clients { any; };\n";
	215	# print " match-clients { any; };\n";
[848]	216	}
[849]	217	foreach my $zone (@{$viewzones{$view->{location}}}) {
	218	##fixme: notify settings, maybe per-zone?
	219	print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
	220	}
[870]	221	print BINDCONF "};\n\n";
[848]	222	print "};\n\n";
	223	} # foreach @$viewlist
[857]	224	rename $tmpconf, $dnsdb->{bind_zone_conf};
[848]	225	} # if $viewlist
	226
	227	} # export()
	228
[854]	229
	230	# Print individual records in BIND format
[869]	231	sub publishrec_bind {
[855]	232	my $dnsdb = shift;
[865]	233
	234	# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
[868]	235	my ($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
[855]	236	$loc, $stamp, $expires, $stampactive) = @_;
[854]	237
[868]	238	# make sure "global" records get into all the right per-view zone files, without having to do this loop in each record-print location
	239	##fixme: maybe exclude the template types? those may be more expensive to export
	240	## ponder may be more efficient to loop in each record print due to substitution and manipulation from stored data to formal
	241	## record for .arpa zones for all records
	242	if ($loc eq '') {
	243	foreach my $subloc (@{$loclist}) {
[869]	244	publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
[868]	245	$subloc, $stamp, $expires, $stampactive);
	246	}
	247	}
	248
[854]	249	# Just In Case something is lingering in the DB
[855]	250	$loc = '' if !$loc;
[854]	251
	252	## And now to the records!
	253
	254	if ($typemap{$type} eq 'SOA') {
	255	# host contains pri-ns:responsible
	256	# val is abused to contain refresh:retry:expire:minttl
	257	# let's be explicit about abusing $host and $val
	258	my ($email, $primary) = (split /:/, $host)[0,1];
	259	my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
	260	my $serial = 0; # fail less horribly than leaving it empty?
[858]	261	# just snarfing the right SOA serial for the zone type
[854]	262	if ($revrec eq 'y') {
[855]	263	($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
[854]	264	} else {
[855]	265	($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
[854]	266	} # revrec <> 'y'
	267	# suppress a "uninitialized value" warning. should be impossible but...
	268	# abuse hours as the last digit pair of the serial for simplicity
[858]	269	##fixme?: alternate SOA serial schemes?
[854]	270	$serial = strftime("%Y%m%d%H", localtime()) if !$serial;
[859]	271	$primary .= "." if $primary !~ /\.$/;
	272	$email .= "." if $email !~ /\.$/;
[855]	273	# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
	274	# or die $!;
[869]	275	# print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
	276	# or die "couldn't write $zone SOA: $!";
	277	my $recdata = "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n";
	278	recprint($zonefiles, $loclist, $loc, $recdata);
[854]	279	} # SOA
	280
[861]	281	elsif ($typemap{$type} eq 'A') {
	282	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	283	# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
[869]	284	# print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
	285	my $recdata = "$host $ttl IN A $val\n";
	286	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	287	} # A
	288
[860]	289	elsif ($typemap{$type} eq 'NS') {
	290	if ($revrec eq 'y') {
	291	$val = NetAddr::IP->new($val);
	292
	293	##fixme: conversion for sub-/24 delegations in reverse zones?
	294	# if (!$val->{isv6} && ($val->masklen > 24)) {
	295	# }
	296
	297	# print {$zonefiles->{$loc}} "$zone $ttl IN NS $host\n";
[869]	298	# print "$zone $ttl IN NS $host\n" or die $!;
	299	my $recdata = "$zone $ttl IN NS $host\n";
	300	recprint($zonefiles, $loclist, $loc, $recdata);
[860]	301
	302	} else {
	303	# print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
	304	}
	305	} # NS
	306
[861]	307	elsif ($typemap{$type} eq 'AAAA') {
	308	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[869]	309	# print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
	310	my $recdata = "$host $ttl IN AAAA $val\n";
	311	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	312	} # AAAA
[860]	313
[861]	314	elsif ($typemap{$type} eq 'TXT') {
	315	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[869]	316	# print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
	317	my $recdata = "$host $ttl IN TXT \"$val\"\n";
	318	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	319	} # TXT
	320
	321	elsif ($typemap{$type} eq 'CNAME') {
	322	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[869]	323	# print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
	324	my $recdata = "$host $ttl IN CNAME $val\n";
	325	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	326	} # CNAME
	327
	328	elsif ($typemap{$type} eq 'SRV') {
	329	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[869]	330	# print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
	331	my $recdata = "$host $ttl IN SRV $distance $weight $port $val\n";
	332	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	333	} # SRV
	334
	335	elsif ($typemap{$type} eq 'RP') {
	336	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[869]	337	# print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
	338	my $recdata = "$host $ttl IN RP $val\n";
	339	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	340	} # RP
	341
	342
	343	elsif ($typemap{$type} eq 'PTR') {
[864]	344	$$recflags{$val}++;
[861]	345	if ($revrec eq 'y') {
	346
	347	if ($val =~ /\.arpa$/) {
	348	# someone put in the formal .arpa name. humor them.
[869]	349	# print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
	350	my $recdata = "$val $ttl IN PTR $host\n";
	351	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	352	} else {
	353	$zone = NetAddr::IP->new($zone);
	354	if (!$zone->{isv6} && $zone->masklen > 24) {
	355	# sub-octet v4 zone
	356	($val) = ($val =~ /\.(\d+)$/);
[869]	357	# print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
	358	# " $ttl IN PTR $host\n"
	359	# or die $!;
	360	my $recdata = "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').".in-addr.arpa $ttl IN PTR $host\n";
	361	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	362	} else {
	363	# not going to care about strange results if $val is not an IP value and is resolveable in DNS
	364	$val = NetAddr::IP->new($val);
[869]	365	# print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
	366	# " $ttl IN PTR $host\n"
	367	# or die $!;
	368	my $recdata = DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
	369	" $ttl IN PTR $host\n";
	370	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	371	}
	372	} # non-".arpa" $val
	373
	374	} else {
	375	# PTRs in forward zones are less bizarre and insane than some other record types
	376	# in reverse zones... OTOH we can't validate them any which way, so we cross our
	377	# fingers and close our eyes and make it Someone Else's Problem.
[869]	378	# print {$zonefiles->{$loc}} "$host $ttl IN PTR $val\n" or die $!;
	379	my $recdata = "$host $ttl IN PTR $val\n";
	380	recprint($zonefiles, $loclist, $loc, $recdata);
[861]	381	}
	382	} # PTR
	383
[863]	384	elsif ($type == 65280) { # A+PTR
	385	# Recurse to PTR or A as appropriate because BIND et al don't share
	386	# the tinydns concept of merged forward/reverse records
[864]	387	$$recflags{$val}++;
[863]	388	if ($revrec eq 'y') {
[869]	389	publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 12, $val, $distance, $weight, $port, $ttl,
[863]	390	$loc, $stamp, $expires, $stampactive);
	391	#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
[869]	392	# publishrec_bind(\%zonefiles, $recid, 'y', \@loclist, $revzone,
[863]	393	# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
	394	# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
	395	# $loc, $stamp, $expires, $stampactive) = @_;
	396	} else {
[869]	397	publishrec_bind($zonefiles, $loclist, $recid, $revrec, $recflags, $zone, $host, 1, $val, $distance, $weight, $port, $ttl,
[863]	398	$loc, $stamp, $expires, $stampactive);
	399	}
	400	} # A+PTR
	401
[864]	402	elsif ($type == 65282) { # PTR template
	403	# only useful for v4 with standard DNS software, since this expands all
	404	# IPs in $zone (or possibly $val?) with autogenerated records
	405	$val = NetAddr::IP->new($val);
	406	return if $val->{isv6};
	407
[866]	408	if ($val->masklen <= 16) {
	409	foreach my $sub ($val->split(16)) {
[869]	410	__publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
[866]	411	}
	412	} else {
[869]	413	__publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
[866]	414	}
	415	} # PTR template
	416
	417	elsif ($type == 65283) { # A+PTR template
	418	$val = NetAddr::IP->new($val);
	419	# Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
	420	return if $val->{isv6};
	421
	422	if ($val->masklen < 16) {
	423	foreach my $sub ($val->split(16)) {
[869]	424	__publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
[866]	425	}
	426	} else {
[869]	427	__publish_template_bind($sub, $recflags, $host, $zonefiles, $loclist, $ttl, $stamp, $loc, $zone, $revrec);
[866]	428	}
	429	} # A+PTR template
	430
	431	elsif ($type == 65284) { # AAAA+PTR template
	432	# Stub for completeness. Could be exported to DNS software that supports
	433	# some degree of internal automagic in generic-record-creation
	434	# (eg http://search.cpan.org/dist/AllKnowingDNS/ )
	435	} # AAAA+PTR template
	436
[869]	437	} # publishrec_bind()
[866]	438
	439
[864]	440	sub __publish_template_bind {
	441	my $sub = shift;
	442	my $recflags = shift;
	443	my $hpat = shift;
[869]	444	my $zonefiles = shift;
	445	my $loclist = shift;
[864]	446	my $ttl = shift;
	447	my $stamp = shift;
	448	my $loc = shift;
	449	my $zone = new NetAddr::IP shift;
[867]	450	my $revrec = shift \|\| 'y';
	451	# my $ptrflag = shift \|\| 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
[864]	452
	453	# do this conversion once, not (number-of-ips-in-subnet) times
[867]	454	my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa', 'r', '.');
[864]	455
	456	my $iplist = $sub->splitref(32);
	457	my $ipindex = -1;
	458	foreach (@$iplist) {
	459	my $ip = $_->addr;
	460	$ipindex++;
	461	# make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
	462	my $lastoct = (split /\./, $ip)[3];
	463
	464	# Allow smaller entries to override longer ones, eg, a specific PTR will
	465	# always publish, overriding any template record containing that IP.
	466	# %blank% also needs to be per-IP here to properly cascade overrides with
	467	# multiple nested templates
	468	next if $$recflags{$ip}; # && $self->{skip_bcast_255}
	469	$$recflags{$ip}++;
	470	next if $hpat eq '%blank%';
	471
	472	my $rec = $hpat; # start fresh with the template for each IP
	473	##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
	474	# seems less bad than some alternatives.
	475	$dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
	476	# _template4_expand may blank $rec; if so, don't publish a record
	477	next if !$rec;
	478	##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
[867]	479	# if ($ptrflag \|\| $zone->masklen > 24) {
[869]	480	my $recdata;
	481	if ($revrec eq 'y') {
	482	# \|\| $zone->masklen > 24) {
[864]	483	# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
[867]	484	##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
[869]	485	# print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
	486	# if ($revrec ne 'y') {
[864]	487	# print a separate A record. Arguably we could use an = record here instead.
	488	# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
[869]	489	# print $fh "$rec $ttl IN A $ip\n" or die $!;
	490	# }
	491	$recdata = "$lastoct.$arpabase $ttl IN PTR $rec\n";
[864]	492	} else {
	493	# A record, not merged
	494	# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
[869]	495	# print $fh "$rec $ttl IN A $ip\n" or die $!;
	496	$recdata = "$rec $ttl IN A $ip\n";
[864]	497	}
[869]	498	# and finally
	499	recprint($zonefiles, $loclist, $loc, $recdata);
	500	} # foreach (@iplist)
[866]	501	} # __publish_template_bind()
[864]	502
[869]	503
	504	# actual record printing sub
	505	# loop on the locations here so we don't end up with a huge pot of copypasta
	506	sub recprint {
	507	my ($zonefiles, $loclist, $loc, $recdata) = @_;
	508	if ($loc eq '') {
	509	# "common" record visible in all locations
	510	foreach my $rloc (@{$loclist}) {
	511	print {$zonefiles->{$rloc}} $recdata or die $!;
	512	}
	513	} else {
	514	# record with specific location tagged
	515	print {$zonefiles->{$loc}} $recdata or die $!;
	516	}
	517	}
	518
[847]	519	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: