Context Navigation

source: trunk/bind-import@ 820

Last change on this file since 820 was 820, checked in by Kris Deugau, 4 years ago

/trunk

Thirteenth sampled iteration of bind-import

File size: 18.6 KB

Rev	Line
[808]	1	#!/usr/bin/perl
	2	# Import a BIND zone file
[818]	3	# Note we are not using Net:DNS::ZoneFile, because we want to convert $GENERATE
	4	# directives straight into PTR template or A+PTR template metarecords
[808]	5	##
	6	# Copyright 2020 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	use strict;
	23	use warnings;
[819]	24	use Getopt::Long;
	25
[808]	26	use Data::Dumper;
	27
[819]	28	##fixme
[808]	29	use lib '.';
	30	use DNSDB;
	31
	32	my $dnsdb = new DNSDB;
[819]	33	my $doimport = 1;
[808]	34
	35	#print Dumper(\%reverse_typemap);
	36
[817]	37	local $dnsdb->{dbh}->{AutoCommit} = 0;
	38	local $dnsdb->{dbh}->{RaiseError} = 1;
	39
[819]	40	# from tiny-import: arguably can't use -r, -c is irrelevant. others useful?
	41	# -r rewrite imported files to comment imported records
	42	# -c coerce/downconvert A+PTR = records to PTR
	43	# -l swallow A+PTR as-is
	44	# -m merge PTR and A/AAAA as possible
	45	# -t trial mode; don't commit to DB or actually rewrite flatfile (disables -r)
	46	# -g import to specified group (name or ID) instead of group 1
	47
[817]	48	##fixme: command arguments/flags to set these to alternate values
	49	my $group = 1;
	50	my $status = 1;
	51	my $location = '';
	52	# we'll update this with the actual serial number from the SOA record later
	53	my $serial = time();
	54
[819]	55	my @skipdefs;
	56	my $skipfile;
	57
	58	GetOptions(
	59	"skip=s" => \@skipdefs,
	60	"skipfile=s" => \$skipfile,
	61	"test\|dry-run" => sub { $doimport = 0; },
	62	);
	63
	64	my $usage = "usage: bind-import [--skip pattern [--skip pattern2 ...]] [--skipfile file]
	65	zonename [zonefile]
	66	--skip
	67	Specify a string to skip in the records. If an IP-like string is
	68	used, and the zone is a reverse zone, it will also search for the
	69	octet-reversed form. Specify multiple times to skip multiple
	70	different record patterns.
	71	--skipfile
	72	A file containing patterns to skip. Patterns from the file and
	73	any --skip arguments are merged.
	74	zonename
	75	The name of the zone to import. Required.
	76	zonefile
	77	Specify the zone file as an argument. If not specified, the zone
	78	data will be read from STDIN.
	79	";
	80
[808]	81	my $zname = shift @ARGV;
[817]	82	my $origzone = $zname;
[819]	83	die $usage if !$zname;
	84
	85	my $zonefile = shift @ARGV;
	86	if(!$zonefile) {
	87	$zonefile = '&STDIN';
	88	}
	89
[808]	90	my $rev = 'n';
	91	my $zid;
[819]	92	my %foundtypes;
[808]	93
[819]	94	if ($skipfile) {
	95	if (-f $skipfile) {
	96	open SKIP, "<$skipfile";
	97	while (<SKIP>) {
[820]	98	chomp;
[819]	99	push @skipdefs, $_;
	100	}
[820]	101	close SKIP;
[819]	102	} else {
	103	warn "skipfile $skipfile requested but it doesn't seem to exist. Continuing.\n";
	104	}
	105	}
	106
	107	#sub setreplace {
	108	## print "dbg1: $_[0]\ndbg2: $_[1]\n";
	109	##($_[1] eq '' ? $replace = 1 : $replace = $_[1]);
	110	# if ($_[1] eq '') {
	111	# print "no arg value, setting 1\n";
	112	# $replace = 1;
	113	# } else {
	114	# print "arg value $_[1]\n";
	115	# $replace = $_[1];
	116	# }
	117	#}
	118
	119
[810]	120	my %amap;
	121	my %namemap;
[811]	122	my %cmap;
[810]	123
[819]	124	# wrap all the DB stuff in eval{}, so the entire thing either succeeds or fails.
	125
	126	eval {
	127
	128	local $dnsdb->{dbh}->{AutoCommit} = 0;
	129	local $dnsdb->{dbh}->{RaiseError} = 1;
	130
[815]	131	##fixme: this is wrong, BIND zone files are generally complete and we're adding. merging records is an entire fridge full of worms.
[816]	132	##fixme: for import, should arguably check for zone nonexistence
[819]	133	if ($zname =~ /\.arpa\.?$/ \|\| $zname =~ m,^[\d./]+$,) {
	134	$rev = 'y';
	135	$zname = _zone2cidr($zname) if $zname =~ /\.arpa\.?$/;
	136	$zid = $dnsdb->revID($zname,':ANY:');
	137	if ($zid) {
	138	die "zone $origzone already present, not merging records\n";
	139	$zname = new NetAddr::IP $zname;
	140	$zname = DNSDB::_ZONE($zname, 'ZONE', 'r', '.').($zname->{isv6} ? '.ip6.arpa' : '.in-addr.arpa');
	141	}
[820]	142	($zid) = $dnsdb->{dbh}->selectrow_array("INSERT INTO revzones (revnet,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING rnds_id",
[819]	143	undef, ($zname, $group, $status, $location, $serial));
[817]	144
[819]	145	} else {
	146	print "dbg: forward zone\n";
	147	$zid = $dnsdb->domainID($zname,':ANY:');
	148	if ($zid) {
	149	# die "zone $origzone already present, not merging records\n";
	150	print "dbg: skip add domain\n";
[820]	151	} else {
	152	($zid) = $dnsdb->{dbh}->selectrow_array("INSERT INTO domains (domain,group_id,status,default_location,zserial) VALUES (?,?,?,?,?) RETURNING domain_id",
	153	undef, ($zname, $group, $status, $location, $serial));
[819]	154	}
[808]	155
[819]	156	}
[808]	157
[819]	158	die "error creating zone stub for $zname: ".$dnsdb->{dbh}->errstr if !$zid;
[817]	159
	160
[819]	161	##fixme: should probably make this a named argument so it doesn't get confused with the zone filename
	162	# still no sane way to expose a human-friendly view tag on the command line.
	163	my $view = shift @ARGV;
	164	$view = '' if !$view;
[810]	165
[819]	166	##fixme: retrieve defttl from SOA record
	167	my $zonettl = 900;
	168	my $defttl = $zonettl;
	169	my $origin = "$zname."; # to append to unqualified names
[808]	170
[819]	171	# need to spin up a full state machine-ish thing, because BIND zone files are all about context
	172	# see ch4, p56-72 in the grasshopper book
	173	my $prevlabel = '';
	174	my $curlabel = '';
[812]	175
[819]	176	my $i = 0;
[813]	177
[819]	178	open ZONEDATA, "<$zonefile";
	179
	180	while (my $rec = <ZONEDATA>) {
	181	chomp $rec;
	182	next if $rec =~ /^\s*$/;
	183	next if $rec =~ /^\s*;/; # comments
	184	next if $rec =~ /^\s*\)/; # SOA closing (possibly other records too?)
[817]	185	# arguably should do some more targeted voodoo when parsing the SOA details
[813]	186
[820]	187	##fixme: would prefer to break the loop below AND next; the while starting above
	188	# check skiplist. do this early since it's (mostly) a simple string match against the raw record line
	189	my $skipflag = 0;
	190	foreach (@skipdefs) {
	191	#print "skipdbg: $_ =~ $rec\n" if $rec =~ /207/;
	192	if ($rec =~ /\Q$_\E/) {
	193	$skipflag = 1;
	194	# print "skip: $rec\n";
	195	}
	196	}
	197	next if $skipflag;
	198
[818]	199	##fixme: use external skiplist
[820]	200	# # skip stale records that have no value
	201	# next if /^ip-192-168-1(12\|20)-\d+/;
	202	# next if /ip.add.re.\d+\s*$/;
[817]	203
[820]	204	$i++;
	205	last if $i > 17;
[818]	206	#print "line $i: ($rec)\n";
[819]	207	if (my ($macro,$mdetail) = ($rec =~ /^\s*\$(TTL\|ORIGIN\|INCLUDE\|GENERATE)\s+(.+)/) ) {
	208	# macro sort of thing; $TTL and $ORIGIN most common. $INCLUDE is a thing, expect it to be rare in live use tho
	209	if ($macro eq 'TTL') {
	210	$mdetail =~ s/\s*;.+$//;
	211	if ($mdetail =~ /^\d+$/) {
	212	$defttl = $mdetail;
	213	} else {
	214	warn "invalid \$TTL: $rec\n";
	215	}
	216	} elsif ($macro eq 'ORIGIN') {
[810]	217	##fixme: going to skip the stupid case of "$ORIGIN com." and the like that lie
	218	# between . and the root domain we were told we're importing; anyone using such
	219	# a mess outside the root servers is clearly insane
[815]	220
	221	# $ORIGIN supports cascading/nesting, by watching for fully-qualified names vs partial names.
	222
	223	print "origin ($mdetail)\n";
[819]	224	if ($mdetail =~ /\.$/) {
	225	$origin = $mdetail;
	226	} else {
	227	# append current origin to unqualified origin
	228	$origin = "$mdetail.$origin";
	229	}
[815]	230
	231	# if ($mdetail eq '.' \|\| $mdetail =~ /$zname\.$/ \|\| $zname =~ /$mdetail\.$/) {
	232	# $origin = $mdetail;
	233	# } else {
	234	# # if we continue, we either use an $ORIGIN that's out of zone, or ignore it and potentially publish incorrect records.
	235	# die "bad \$ORIGIN: $_\n";
	236	# }
	237
[819]	238	}
	239	elsif ($macro eq 'GENERATE') {
[818]	240	# needs to generate CIDR range(s) as needed to match the start/stop points
[819]	241	}
	242	# not handling $INCLUDE or $GENERATE (altho the latter seems to be mostly a less-flexible version of the template types)
	243	next;
[818]	244	}
[815]	245
[819]	246	my $origrec = $rec;
[815]	247
	248	# leading whitespace indicates "same label as last record"
[819]	249	if ($rec =~ /^\s/) {
	250	$curlabel = $prevlabel;
[820]	251	#print " found empty label, using previous label\n";
[819]	252	} else {
	253	($curlabel) = ($rec =~ /^([\w\@_.-]+)\s/);
	254	}
[815]	255
[820]	256	#print " found '$curlabel'\n";
[817]	257
[819]	258	# magic name!
	259	$curlabel = "$zname." if $curlabel eq '@';
[815]	260
[819]	261	# append $ORIGIN if name is not fully qualified.
	262	if ($curlabel !~ /\.$/) {
	263	$curlabel .= ($origin eq '.' ? '.' : ".$origin");
	264	}
[820]	265	#print " expanded '$curlabel'\n";
[815]	266
[818]	267	# hack pthbptt
	268	#$curlabel =~ s/\.\.$/./;
[819]	269	# check for zone scope. skip bad records.
	270	if ($curlabel !~ /$zname.$/) {
	271	warn "bad record $origrec, maybe bad \$ORIGIN?\n";
	272	# bweh? maybe this should die()?
[817]	273	last;
[819]	274	next;
	275	}
[815]	276
[819]	277	# trim the label, if any
	278	$rec =~ s/^([\w\@_.-]*)\s+//;
[817]	279
[815]	280	# # records must begin in the first column, no leading whitespace
	281	# my ($name) = /^([\w\@_.-]+)\s/;
	282
[813]	283	# foo IN A 1.2.3.4
	284	# IN A 2.3.4.5
	285	# =
	286	# foo.zone. IN A 1.2.3.4
	287	# foo.zone. IN A 2.3.4.5
	288
[815]	289	# # "empty" label records inherit the previous label
	290	# # RRs start in the first column by definition, so leading whitespace indicates an inherited label
	291	# if (/^\s+/) {
	292	# # fatal error. if there is no previous label, we can by definition not set
	293	# # the current label based on it. this can only happen on the very first
	294	# # record, following records will ALWAYS have a previous label
	295	# die "bad first record ($_): no previous label\n" if !$prevlabel;
	296	# $name = $prevlabel;
	297	# }
[813]	298
[818]	299	#print "$i ($rec)\n";#\t$curlabel";
[814]	300
[813]	301
[814]	302
	303
[815]	304	# # append zone name to record name if missing AND not dot-terminated;
	305	# # this happens automagically for forward zones, but not reverse because Reasons. (fixme?)
	306	# # suck up and deal with the error if the dot-termiated name is out of zone; should be
	307	# # impossible with valid BIND zone file but...
	308	# if ($name !~ /\.$/) {
	309	# $name .= ".$zname" if $name !~ /$zname$/;
	310	# } else {
	311	# warn "skipping out-of-zone record:\n\t($_)\n" if $name !~ /$zname\.$/;
	312	# next;
	313	# }
[813]	314
	315
[819]	316	my $nc = 0;
	317	my $class = 'IN';
	318	my $type;
	319	my $ttl;
	320	my $distance;
	321	my $weight;
	322	my $port;
	323	my $badrec;
	324	my $curatom = 'class';
[813]	325
[819]	326	# unpack the class, TTL, and type
	327	eval {
	328	for (; $nc < 3; $nc++) {
	329	my ($atom) = ($rec =~ /^([\w\d.]+)\s/);
	330	# should be safe?
	331	last if !$atom;
	332	last if $type;
[817]	333	#print "nc:$nc: $atom\n";
[819]	334	if ($atom =~ /^\d+$/) {
	335	if (defined($ttl)) {
[817]	336	die "bad record ($origrec)\n";
	337	# warn "bad record ($origrec)\n";
	338	# $badrec = 1;
	339	# last;
[819]	340	} else {
	341	if ($curatom ne 'class' && $curatom ne 'ttl') {
	342	die "bad record ($origrec)\n";
	343	# warn "bad record ($origrec)\n";
	344	# $badrec = 1;
	345	# last;
	346	}
	347	$curatom = 'ttl';
	348	$ttl = $atom;
[817]	349	}
[816]	350	}
[817]	351
[819]	352	elsif ($atom =~ /^IN\|CS\|CH\|HS$/) {
[817]	353	#print "a$nc: d2: atom [$atom]\n $rec\n" if $i == $debugid;
[819]	354	if ($atom =~ /CS\|CH\|HS/) {
	355	die "unsupported class $atom in record ($origrec)\n";
	356	# warn "unsupported class $atom in record ($origrec)\n";
	357	# $badrec = 1;
	358	# last;
	359	}
	360	$curatom = 'class';
	361	$class = $atom;
[817]	362	}
	363
[819]	364	elsif ($atom =~ /^[A-Z]+/) {
[817]	365	# print "dbg: type $atom\n";
[819]	366	if ($reverse_typemap{$atom}) {
	367	$type = $atom;
	368	} else {
	369	die "unknown type $atom in record ($origrec)\n";
	370	}
[817]	371	}
[819]	372	$rec =~ s/^$atom\s*//;
[817]	373	}
[819]	374	}; # record class/type/TTL parse
	375	if ($@) {
	376	warn $@;
	377	next;
[815]	378	}
	379
[818]	380	##todo: BIND conflates a repeated label with repeating the TTL too. Matter of opinion whether that's really correct or not.
[819]	381	# set default TTL here so we can detect a TTL in the loop above
	382	$ttl = $defttl if !defined($ttl);
[817]	383
[816]	384	#next if $badrec;
[815]	385
[819]	386	$prevlabel = $curlabel;
[815]	387
[814]	388
[817]	389	## by convention the optional TTL leads the optional class, but they're apparently swappable.
	390	# my ($ttl) = /^(\d+)?\s/;
	391	# if (defined $ttl) {
	392	# # TTL may be zero
	393	# s/(\d+)?\s+//;
	394	# } else {
	395	# # Fall back to zone default TTL
	396	# $ttl = $zonettl;
	397	# }
	398	# my ($class) = /^(IN\|CS\|CH\|HS\|\d+)\s/;
	399	# if (defined $class) {
	400	# if ($class =~ /\d+/) {
	401	#
	402	# }
	403	# if ($class ne 'IN') {
	404	# warn "Non-Internet class ($class) records not supported:\n\t$origrec\n";
	405	# next;
	406	# }
	407	# s/(IN\|CS\|CH\|HS)\s+//;
	408	# } else {
	409	# $class = 'IN';
	410	# }
	411	# my ($type) = /([A-Z-]+)\s/;
	412	# if (!$reverse_typemap{$type}) {
	413	# warn "Unknown type $type, skipping\n\t($rec)\n";
	414	# next;
	415	# }
	416	# s/([A-Z-]+)\s+//;
	417	# chomp;
	418
	419
[819]	420	my $itype = $reverse_typemap{$type};
	421	my $rdata = $rec;
[808]	422
[812]	423	# SOA is the only type that may span multiple lines. Probably. Note even AXFRed zones write multiline SOA records:
	424	#@ IN SOA test.example.invalid. test.example.invalid. (2020082500 7200 900 604800 3600)
	425	# IN NS olddns.example.com.
	426	# IN MX 1 fred.foo.bar.invalid.
	427	#foo IN A 192.168.16.45
	428	# AXFR'ed zone file gets written as
	429	#$ORIGIN .
	430	#$TTL 3600 ; 1 hour
	431	#example.invalid IN SOA test.example.invalid. test.example.invalid. (
	432	# 2020082500 ; serial
	433	# 7200 ; refresh (2 hours)
	434	# 900 ; retry (15 minutes)
	435	# 604800 ; expire (1 week)
	436	# 3600 ; minimum (1 hour)
	437	# )
	438	# NS olddns.example.com.
	439	# MX 1 fred.foo.bar.invalid.
	440	#$ORIGIN example.invalid.
	441	#foo A 192.168.16.45
[819]	442	$foundtypes{$type}++;
[812]	443
[818]	444	##fixme: strip trailing . here? dnsadmin's normalized internal format omits it, some validation fails or may go funky
	445
[819]	446	if ($type eq 'SOA') {
	447	my ($ns, $adminmail) = ($rdata =~ /([\w.]+)\s+([\w.]+)\s+\(/);
	448	die "Can't parse gibberish SOAish record: $rec\n" if !$ns;
	449	$rdata =~ s/([\w.]+)\s+([\w.]+)\s+\(\s*//;
[812]	450
[819]	451	# There are probably more efficient ways to do this but the SOA record
	452	# format is essentially character based, not line-based.
	453	# In theory the SOA serial etc may be spread over up to 5 lines, in any combination.
[812]	454
[819]	455	# Parse fields from $rdata if present
	456	my @soabits;
	457	my @soafirst = split /\s+/, $rdata;
	458	while (my $f = shift @soafirst) {
[813]	459	last if $f !~ /^\d/;
[819]	460	push @soabits, $f;
[813]	461	}
[819]	462
	463	# Read more lines if we don't have enough SOA fields filled
	464	while (scalar(@soabits) < 5) {
	465	my $tmp = <ZONEDATA>;
	466	$tmp =~ s/^\s*//;
	467	my @tmpsoa = split /\s+/, $tmp;
	468	while (my $f = shift @tmpsoa) {
	469	last if $f !~ /^\d/;
	470	push @soabits, $f;
	471	}
	472	if (scalar(@soabits) == 5) {
	473	last;
	474	}
[813]	475	}
[819]	476	my @soavals = ($zid, "$adminmail:$ns", 6, join(':', @soabits), $ttl, $location);
	477	# host = $adminmail:$ns
	478	# val = join(':', @soabits);
	479
	480	if ($rev eq 'y') {
	481	$dnsdb->{dbh}->do("UPDATE revzones SET zserial = ? WHERE rdns_id = ?", undef, $soabits[0], $zid);
	482	$dnsdb->{dbh}->do("INSERT INTO records (rdns_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
	483	} else {
	484	$dnsdb->{dbh}->do("UPDATE domains SET zserial = ? WHERE domain_id = ?", undef, $soabits[0], $zid);
	485	$dnsdb->{dbh}->do("INSERT INTO records (domain_id,host,type,val,ttl,location) VALUES (?,?,?,?,?,?)", undef, @soavals);
	486	}
[818]	487	# $dnsdb->{dbh}->do("INSERT INTO records () VALUES ()");
	488	# next;
	489	#Zfqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo
	490	#print "Z$zname:$ns:$adminmail:$soabits[0]:$soabits[1]:$soabits[2]:$soabits[3]:$soabits[4]:$ttl\n";
[820]	491	# skip insert at end of loop; SOA records are not handled by DNSDB::addRec()
	492	next;
[819]	493	} # SOA
[813]	494
[818]	495
[819]	496	# we're using DNSDB::addrec(), so we'll skip detailed validation of other records. Most won't need further breakdown
[818]	497
[819]	498	elsif ($type eq 'A') {
[818]	499	#print "+$curlabel:$rdata:$ttl\n";
[819]	500	}
[818]	501
[819]	502	elsif ($type eq 'NS') {
[818]	503	#print "\&$curlabel::$rdata:$ttl\n";
[819]	504	}
[818]	505
[819]	506	elsif ($type eq 'CNAME') {
[818]	507	#print "C$curlabel:$rdata:$ttl\n";
[819]	508	}
[818]	509
[819]	510	elsif ($type eq 'PTR') {
	511	}
[818]	512
[819]	513	elsif ($type eq 'MX') {
	514	($distance) = ($rdata =~ /^(\d+)\s+/);
	515	if (!defined($distance)) {
	516	warn "malformed MX record: $origrec, skipping\n";
	517	next;
	518	}
	519	$rdata =~ s/^\d+\s+//;
[818]	520	}
	521
[819]	522	elsif ($type eq 'TXT') {
	523	# Quotes may arguably be syntactically required, but they're not actually part of the record data
	524	$rdata =~ s/^"//;
	525	$rdata =~ s/"$//;
[818]	526	#print "'$curlabel:$rdata:$ttl\n";
[819]	527	}
[808]	528
[819]	529	elsif ($type eq 'RP') {
	530	}
[810]	531
[819]	532	elsif ($type eq 'AAAA') {
	533	}
[818]	534
[819]	535	elsif ($type eq 'SRV') {
	536	($distance, $weight, $port) = ($rdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+/);
	537	if ( !defined($distance) \|\| !defined($weight) \|\| !defined($port) ) {
	538	warn "malformed SRV record: $origrec, skipping\n";
	539	next;
	540	}
	541	$rdata =~ s/^\d+\s+\d+\s+\d+\s+//;
[818]	542	}
	543
[819]	544	# basically a dedicated clone of TXT, not sure anything actually looks up type SPF.
	545	# BIND autogenerates them from SPF TXT records.
	546	elsif ($type eq 'SPF') {
	547	# Quotes may arguably be syntactically required, but they're not actually part of the record data
	548	$rdata =~ s/^"//;
	549	$rdata =~ s/"$//;
	550	}
[818]	551
	552	# elsif ($type eq 'TXT') {
	553	# elsif ($type eq 'TXT') {
	554
[819]	555	else {
	556	warn "unsupported type $type, may not import correctly\n";
	557	}
[818]	558
[808]	559	no warnings qw(uninitialized);
[818]	560	#print "parsed: '$curlabel' '$class' '$ttl' '$type'->'$itype' '$rdata'\n";
[808]	561	#print;
	562	#;imap IN 900 CNAME deepnet.cx.
	563	##fixme: not sure how to handle the case where someone leaves off the class.
[819]	564	if ($doimport) {
	565	my ($code, $msg);
	566	if ($rev eq 'n') {
	567	($code,$msg) = $dnsdb->addRec('n', $rev, $zid, \$curlabel, \$itype, \$rdata, $ttl,
	568	$location, undef, undef, $distance, $weight, $port);
	569	} else {
	570	($code,$msg) = $dnsdb->addRec('y', $rev, $zid, \$rdata, \$itype, \$curlabel, $ttl,
	571	$location, undef, undef, $distance, $weight, $port);
	572	}
[820]	573	print "$code: $msg\n" if $code ne 'OK';
[810]	574	}
[819]	575	# $i++;
[809]	576	}
[819]	577
	578	};
	579	if ($@) {
	580	warn "Error parsing zonefile: $@\n";
	581	$dnsdb->{dbh}->rollback;
	582	exit;
[808]	583	}
[810]	584
	585	#print Dumper \%amap;
[811]	586	#print Dumper \%namemap;
	587	#print Dumper \%cmap;
	588
[818]	589	#foreach my $n (keys %amap) {
	590	# foreach my $ip (@{$amap{$n}}) {
	591	##print "$ip $n\n";
	592	# push @{$namemap{$ip}}, $n unless grep $n, @{$namemap{$ip}};
	593	# }
	594	#}
[810]	595
[818]	596	#foreach my $c (keys %cmap) {
	597	# if ($amap{$c}) {
	598	# print Dumper(\@{$amap{$c}});
	599	# }
	600	## print $amap{$c};
	601	#}
[811]	602
	603	# cname targ -> IP
	604
	605	#foreach my $ip (sort keys %namemap) {
	606	# print "$ip ".join(' ', @{$namemap{$ip}})."\n";
	607	#}
	608
[819]	609	##fixme: might not be sane, addRec() above does a commit() internally.
	610	#$dnsdb->{dbh}->rollback;
	611	$dnsdb->{dbh}->commit;
[818]	612
	613	foreach my $t (keys %foundtypes) {
	614	print "found $t: $foundtypes{$t}\n";
	615	}

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

Download in other formats: