Context Navigation

source: trunk/DNSDB/ExportBIND.pm@ 867

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

/trunk

BIND export, unwinding dev saves, 19 of many many

Tweak fixed arguments for some calls to publish_template_bind() and tweak sub to match
More intermediate broom-pushing calling _ZONE
Actually output some records in publish_template_bind()

Property svn:keywords set to Date Rev Author Id

File size: 18.3 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 867 2022-09-20 22:13:37Z 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 ".
[849]	45	"ORDER BY masklen(revnet) DESC, rdns_id");
	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
[855]	86	my (@loclist) = $dnsdb->{dbh}->selectrow_array("SELECT DISTINCT location FROM records WHERE rdns_id = ?", undef, $revid);
[853]	87	push @loclist, $defloc unless grep /$defloc/, @loclist;
[856]	88	my $zonepath = $dnsdb->{bind_export_reverse_zone_path};
[859]	89	my %zonefiles; # to be a hash of file handles.
[856]	90	##fixme: need to open separate zone files for aggregated metazones eg /22 or /14
[853]	91	foreach my $loc (@loclist) {
	92	my $zfilepath = $zonepath;
	93	$zfilepath =~ s/\%view/$loc/;
	94	$zfilepath =~ s/\%zone/$revzone/;
[856]	95	$zfilepath =~ s/\%arpazone/$arpazone/;
[853]	96	# Just In Case(TM)
	97	$zfilepath =~ s,[^\w./-],_,g;
[859]	98	open $zonefiles{$loc}, ">", $zfilepath;
[860]	99	printf {$zonefiles{$loc}} "; %s in view %s exported %s\n", $arpazone, $loc, scalar(localtime);
[853]	100	print "open zonefile for '$loc', '$zfilepath'\n";
	101	}
	102
[851]	103	# need to fetch this separately since the rest of the records all (should) have real IPs in val
	104	$soasth->execute($revid);
	105	my (@zsoa) = $soasth->fetchrow_array();
[865]	106	##fixme: do we even need @loclist passed in?
	107	printrec_bind(\%zonefiles, $zsoa[7], 'y', \%recflags, $revzone,
[851]	108	$zsoa[0],$zsoa[1],$zsoa[2],$zsoa[3],$zsoa[4],$zsoa[5],$zsoa[6],$zsoa[8],'');
	109
	110	$recsth->execute($revid);
	111	my $fullzone = _ZONE($tmpzone, 'ZONE', 'r', '.').($tmpzone->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
	112
	113	while (my ($host, $type, $val, $dist, $weight, $port, $ttl, $recid, $loc, $stamp, $expires, $stampactive)
	114	= $recsth->fetchrow_array) {
	115	next if $recflags{$recid};
	116
	117	# Check for out-of-zone data
	118	if ($val =~ /\.arpa$/) {
	119	# val is non-IP
	120	if ($val !~ /$fullzone$/) {
	121	warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
	122	next;
	123	}
	124	} else {
	125	my $ipval = new NetAddr::IP $val;
	126	if (!$tmpzone->contains($ipval)) {
	127	warn "Not exporting out-of-zone record $val $typemap{$type} $host, $ttl (zone $tmpzone)\n";
	128	next;
	129	}
	130	} # is $val a raw .arpa name?
	131
	132	# Spaces are evil.
	133	$val =~ s/^\s+//;
	134	$val =~ s/\s+$//;
	135	if ($typemap{$type} ne 'TXT') {
	136	# Leading or trailng spaces could be legit in TXT records.
	137	$host =~ s/^\s+//;
	138	$host =~ s/\s+$//;
	139	}
	140
[854]	141	printrec_bind($zonefilehandle, $recid, 'y', \%recflags, $revzone,
[851]	142	$host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
	143
	144	$recflags{$recid} = 1;
	145
	146	} # while ($recsth)
	147
[855]	148	if ($dnsdb->{usecache}) {
[851]	149	close ZONECACHE; # force the file to be written
	150	# catch obvious write errors that leave an empty temp file
	151	if (-s $tmpcache) {
	152	rename $tmpcache, $cachefile
	153	or die "Error overwriting cache file $cachefile with temporary file: $!\n";
	154	}
	155	}
	156
	157	} # if $changed or cache filesize is 0
	158
	159	};
	160	if ($@) {
[855]	161	die "error writing ".($dnsdb->{usecache} ? 'new data for ' : '')."$revzone: $@\n";
[851]	162	# error! something borked, and we should be able to fall back on the old cache file
	163	# report the error, somehow.
	164	} else {
	165	# mark zone as unmodified. Only do this if no errors, that way
	166	# export failures should recover a little more automatically.
	167	$zonesth->execute($revid);
	168	}
	169
[855]	170	# if ($dnsdb->{usecache}) {
[851]	171	# # We've already made as sure as we can that a cached zone file is "good",
	172	# # although possibly stale/obsolete due to errors creating a new one.
	173	# eval {
	174	# open CACHE, "<$cachefile" or die $!;
	175	# print $datafile $_ or die "error copying cached $revzone to master file: $!" while <CACHE>;
	176	# close CACHE;
	177	# };
	178	# die $@ if $@;
	179	# }
	180
	181
	182
[849]	183	} # revsth->fetch
	184
	185
	186	# Write the view configuration last, because otherwise we have to be horribly inefficient
	187	# at figuring out which zones are visible/present in which views
[848]	188	if ($viewlist) {
[857]	189	my $tmpconf = "$dnsdb->{bind_zone_conf}.$$"; ##fixme: split filename for prefixing
	190	open BINDCONF, ">", $tmpconf;
	191
[848]	192	foreach my $view (@{$viewlist}) {
	193	#print Dumper($view);
[857]	194	print BINDCONF "view $view->{location} {\n";
	195	# print "view $view->{location} {\n";
[848]	196	# could also use an acl { ... }; statement, then match-clients { aclname; };, but that gets hairy
	197	# note that some semantics of data visibility need to be handled by the record export, since it's
	198	# not 100% clear if the semantics of a tinydns view with an empty IP list (matches anyone) are the
	199	# same as a BIND view with match-clients { any; };
	200	if ($view->{iplist}) {
[857]	201	print BINDCONF " match-clients { ".join("; ", $view->iplist)."; };\n";
	202	# print " match-clients { ".join("; ", split(/[\s,]+/, $view->{iplist}))."; };\n";
[848]	203	} else {
[857]	204	print BINDCONF " match-clients { any; };\n";
	205	# print " match-clients { any; };\n";
[848]	206	}
[849]	207	foreach my $zone (@{$viewzones{$view->{location}}}) {
	208	##fixme: notify settings, maybe per-zone?
	209	print qq( zone "$zone" IN {\n\ttype master;\n\tnotify no;\n\tfile "db.$zone";\n };\n);
	210	}
[848]	211	print "};\n\n";
	212	} # foreach @$viewlist
[857]	213	rename $tmpconf, $dnsdb->{bind_zone_conf};
[848]	214	} # if $viewlist
	215
	216	} # export()
	217
[854]	218
	219	# Print individual records in BIND format
	220	sub printrec_bind {
[855]	221	my $dnsdb = shift;
[865]	222
	223	# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
	224	my ($zonefiles, $recid, $revrec, $recflags, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
[855]	225	$loc, $stamp, $expires, $stampactive) = @_;
[854]	226
	227	# Just In Case something is lingering in the DB
[855]	228	$loc = '' if !$loc;
[854]	229
	230	## And now to the records!
	231
	232	if ($typemap{$type} eq 'SOA') {
	233	# host contains pri-ns:responsible
	234	# val is abused to contain refresh:retry:expire:minttl
	235	# let's be explicit about abusing $host and $val
	236	my ($email, $primary) = (split /:/, $host)[0,1];
	237	my ($refresh, $retry, $expire, $min_ttl) = (split /:/, $val)[0,1,2,3];
	238	my $serial = 0; # fail less horribly than leaving it empty?
[858]	239	# just snarfing the right SOA serial for the zone type
[854]	240	if ($revrec eq 'y') {
[855]	241	($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM revzones WHERE revnet=?", undef, $zone);
[854]	242	} else {
[855]	243	($serial) = $dnsdb->{dbh}->selectrow_array("SELECT zserial FROM domains WHERE domain=?", undef, $zone);
[854]	244	} # revrec <> 'y'
	245	# suppress a "uninitialized value" warning. should be impossible but...
	246	# abuse hours as the last digit pair of the serial for simplicity
[858]	247	##fixme?: alternate SOA serial schemes?
[854]	248	$serial = strftime("%Y%m%d%H", localtime()) if !$serial;
[859]	249	$primary .= "." if $primary !~ /\.$/;
	250	$email .= "." if $email !~ /\.$/;
[855]	251	# print *{$zonefiles->{$loc}} "Z$zone:$primary:$email:$serial:$refresh:$retry:$expire:$min_ttl:$ttl:$stamp:$loc\n"
	252	# or die $!;
	253	print *{$zonefiles->{$loc}} "$zone $ttl IN SOA $primary $email ( $serial $refresh $retry $expire $min_ttl )\n"
[859]	254	or die "couldn't write $zone SOA: $!";
[854]	255	} # SOA
	256
[861]	257	elsif ($typemap{$type} eq 'A') {
	258	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	259	# print $datafile "+$host:$val:$ttl:$stamp:$loc\n" or die $!;
	260	print {$zonefiles->{$loc}} "$host $ttl IN A $val\n" or die $!;
	261	} # A
	262
[860]	263	elsif ($typemap{$type} eq 'NS') {
	264	if ($revrec eq 'y') {
	265	$val = NetAddr::IP->new($val);
	266
	267	##fixme: conversion for sub-/24 delegations in reverse zones?
	268	# if (!$val->{isv6} && ($val->masklen > 24)) {
	269	# }
	270
	271	# print {$zonefiles->{$loc}} "$zone $ttl IN NS $host\n";
[861]	272	print "$zone $ttl IN NS $host\n" or die $!;
[860]	273
	274	} else {
	275	# print $datafile "\&$host"."::$val:$ttl:$stamp:$loc\n" or die $!;
	276	}
	277	} # NS
	278
[861]	279	elsif ($typemap{$type} eq 'AAAA') {
	280	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	281	print {$zonefiles->{$loc}} "$host $ttl IN AAAA $val\n" or die $!;
	282	} # AAAA
[860]	283
[861]	284	elsif ($typemap{$type} eq 'TXT') {
	285	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	286	print {$zonefiles->{$loc}} "$host $ttl IN TXT \"$val\"\n" or die $!;
	287	} # TXT
	288
	289	elsif ($typemap{$type} eq 'CNAME') {
	290	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	291	print {$zonefiles->{$loc}} "$host $ttl IN CNAME $val\n" or die $!;
	292	} # CNAME
	293
	294	elsif ($typemap{$type} eq 'SRV') {
	295	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
[862]	296	print {$zonefiles->{$loc}} "$host $ttl IN SRV $distance $weight $port $val\n" or die $!;
[861]	297	} # SRV
	298
	299	elsif ($typemap{$type} eq 'RP') {
	300	# ($host,$val) = __revswap($host,$val) if $revrec eq 'y';
	301	print {$zonefiles->{$loc}} "$host $ttl IN RP $val\n" or die $!;
	302	} # RP
	303
	304
	305	elsif ($typemap{$type} eq 'PTR') {
[864]	306	$$recflags{$val}++;
[861]	307	if ($revrec eq 'y') {
	308
	309	if ($val =~ /\.arpa$/) {
	310	# someone put in the formal .arpa name. humor them.
[863]	311	print {$zonefiles->{$loc}} "$val $ttl IN PTR $host\n" or die $!;
[861]	312	} else {
	313	$zone = NetAddr::IP->new($zone);
	314	if (!$zone->{isv6} && $zone->masklen > 24) {
	315	# sub-octet v4 zone
	316	($val) = ($val =~ /\.(\d+)$/);
[863]	317	print {$zonefiles->{$loc}} "$val.".DNSDB::_ZONE($zone, 'ZONE', 'r', '.').'.in-addr.arpa'.
	318	" $ttl IN PTR $host\n"
	319	or die $!;
[861]	320	} else {
	321	# not going to care about strange results if $val is not an IP value and is resolveable in DNS
	322	$val = NetAddr::IP->new($val);
[863]	323	print {$zonefiles->{$loc}} DNSDB::_ZONE($val, 'ZONE', 'r', '.').($val->{isv6} ? '.ip6.arpa' : '.in-addr.arpa').
	324	" $ttl IN PTR $host\n"
	325	or die $!;
	326
[861]	327	}
	328	} # non-".arpa" $val
	329
	330	} else {
	331	# PTRs in forward zones are less bizarre and insane than some other record types
	332	# in reverse zones... OTOH we can't validate them any which way, so we cross our
	333	# fingers and close our eyes and make it Someone Else's Problem.
	334	print {$zonefiles->{$loc}} "^$host:$val:$ttl:$stamp:$loc\n" or die $!;
	335	}
	336	} # PTR
	337
[863]	338	elsif ($type == 65280) { # A+PTR
	339	# Recurse to PTR or A as appropriate because BIND et al don't share
	340	# the tinydns concept of merged forward/reverse records
[864]	341	$$recflags{$val}++;
[863]	342	if ($revrec eq 'y') {
[865]	343	printrec_bind($zonefiles, $recid, $revrec, $recflags, $zone, $host, 12, $val, $distance, $weight, $port, $ttl,
[863]	344	$loc, $stamp, $expires, $stampactive);
	345	#print {$zonefiles->{$loc}} "=$host:$val:$ttl:$stamp:$loc\n" or die $!;
	346	# printrec_bind(\%zonefiles, $recid, 'y', \@loclist, $revzone,
	347	# $host, $type, $val, $dist, $weight, $port, $ttl, $loc, $stamp, $expires, $stampactive);
	348	# my ($zonefiles, $recid, $revrec, $loclist, $zone, $host, $type, $val, $distance, $weight, $port, $ttl,
	349	# $loc, $stamp, $expires, $stampactive) = @_;
	350	} else {
[865]	351	printrec_bind($zonefiles, $recid, $revrec, $recflags, $zone, $host, 1, $val, $distance, $weight, $port, $ttl,
[863]	352	$loc, $stamp, $expires, $stampactive);
	353	}
	354	} # A+PTR
	355
[864]	356	elsif ($type == 65282) { # PTR template
	357	# only useful for v4 with standard DNS software, since this expands all
	358	# IPs in $zone (or possibly $val?) with autogenerated records
	359	$val = NetAddr::IP->new($val);
	360	return if $val->{isv6};
	361
[866]	362	if ($val->masklen <= 16) {
	363	foreach my $sub ($val->split(16)) {
	364	__publish_template_bind($sub, $recflags, $host, $zonefiles->{$loc}, $ttl, $stamp, $loc, $zone, 1);
	365	}
	366	} else {
	367	__publish_template_bind($val, $recflags, $host, $zonefiles->{$loc}, $ttl, $stamp, $loc, $zone, 1);
	368	}
	369	} # PTR template
	370
	371	elsif ($type == 65283) { # A+PTR template
	372	$val = NetAddr::IP->new($val);
	373	# Just In Case. An A+PTR should be impossible to add to a v6 revzone via API.
	374	return if $val->{isv6};
	375
	376	if ($val->masklen < 16) {
	377	foreach my $sub ($val->split(16)) {
[867]	378	__publish_template_bind($sub, $recflags, $host, $zonefiles->{$loc}, $ttl, $stamp, $loc, $zone, 'y');
[866]	379	}
	380	} else {
[867]	381	__publish_template_bind($val, $recflags, $host, $zonefiles->{$loc}, $ttl, $stamp, $loc, $zone, 'y');
[866]	382	}
	383	} # A+PTR template
	384
	385	elsif ($type == 65284) { # AAAA+PTR template
	386	# Stub for completeness. Could be exported to DNS software that supports
	387	# some degree of internal automagic in generic-record-creation
	388	# (eg http://search.cpan.org/dist/AllKnowingDNS/ )
	389	} # AAAA+PTR template
	390
	391	} # printrec_bind()
	392
	393
[864]	394	sub __publish_template_bind {
	395	my $sub = shift;
	396	my $recflags = shift;
	397	my $hpat = shift;
	398	my $fh = shift;
	399	my $ttl = shift;
	400	my $stamp = shift;
	401	my $loc = shift;
	402	my $zone = new NetAddr::IP shift;
[867]	403	my $revrec = shift \|\| 'y';
	404	# my $ptrflag = shift \|\| 0; ##fixme: default to PTR instead of A record for the BIND variant of this sub?
[864]	405
	406	# do this conversion once, not (number-of-ips-in-subnet) times
[867]	407	my $arpabase = DNSDB::_ZONE($zone, 'ZONE.in-addr.arpa', 'r', '.');
[864]	408
	409	my $iplist = $sub->splitref(32);
	410	my $ipindex = -1;
	411	foreach (@$iplist) {
	412	my $ip = $_->addr;
	413	$ipindex++;
	414	# make as if we split the non-octet-aligned block into octet-aligned blocks as with SOA
	415	my $lastoct = (split /\./, $ip)[3];
	416
	417	# Allow smaller entries to override longer ones, eg, a specific PTR will
	418	# always publish, overriding any template record containing that IP.
	419	# %blank% also needs to be per-IP here to properly cascade overrides with
	420	# multiple nested templates
	421	next if $$recflags{$ip}; # && $self->{skip_bcast_255}
	422	$$recflags{$ip}++;
	423	next if $hpat eq '%blank%';
	424
	425	my $rec = $hpat; # start fresh with the template for each IP
	426	##fixme: there really isn't a good way to handle sub-/24 zones here. This way at least
	427	# seems less bad than some alternatives.
	428	$dnsdb->_template4_expand(\$rec, $ip, \$sub, $ipindex);
	429	# _template4_expand may blank $rec; if so, don't publish a record
	430	next if !$rec;
	431	##fixme: trim merged record type voodoo. "if ($ptrflag) {} else {}" ?
[867]	432	# if ($ptrflag \|\| $zone->masklen > 24) {
	433	if ($revrec eq 'y' \|\| $zone->masklen > 24) {
[864]	434	# print $fh "^$lastoct.$arpabase:$rec:$ttl:$stamp:$loc\n" or die $!;
[867]	435	##fixme: use $ORIGIN instead? make the FQDN output switchable-optional?
[864]	436	print $fh "$lastoct.$arpabase $ttl IN PTR $rec\n" or die $!;
[867]	437	# if (!$ptrflag) {
	438	if ($revrec ne 'y') {
[864]	439	# print a separate A record. Arguably we could use an = record here instead.
	440	# print $fh "+$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
[867]	441	print $fh "$rec $ttl IN A $ip\n" or die $!;
[864]	442	}
	443	} else {
	444	# A record, not merged
	445	# print $fh "=$rec:$ip:$ttl:$stamp:$loc\n" or die $!;
[867]	446	print $fh "$rec $ttl IN A $ip\n" or die $!;
[864]	447	}
	448	}
[866]	449	} # __publish_template_bind()
[864]	450
[847]	451	1;

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

Download in other formats: