#! /usr/bin/perl##    B9DDNS - BIND 9 dynamic DNS webmin module.#    Copyright (C) 2003 John Horne. <john.horne@plymouth.ac.uk>#    Copyright (C) 2004 John Horne. <john.horne@plymouth.ac.uk>##    This program is free software; you can redistribute it and/or modify#    it under the terms of the GNU General Public License as published by#    the Free Software Foundation; either version 2 of the License, or#    (at your option) any later version.##    This program is distributed in the hope that it will be useful,#    but WITHOUT ANY WARRANTY; without even the implied warranty of#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the#    GNU General Public License for more details.##    You should have received a copy of the GNU General Public License#    along with this program; if not, write to the Free Software#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.### Common DNS record functions for the dynamic DNS module#use strict;no strict 'vars';## Reads a DNS zone and return a data structure of records.## get_zone(zone, file, origin, [previous], [zone_type])#sub get_zone {	my $num = my $gen = my $prv = my $i = my $j = 0;	my $lnum = my $glen = my $merge = my $merged_2 = my $oset = 0;	my $soa_seen = my $dynamic_zone = my $default_ttl = my $ttl = 0;	my $token_count = my $no_file = my $want_sd = 0;	my $origin = my $inc_origin = my $file = my $line = my $comment = '';	my $zone = my $zone_name = my $type = my $cmd_line = '';	my $real_file = my $orig = my $sd = '';	my @records = ();	my @tokens = my @linenum = my @offsets = my @comments = my @inc = ();	my %sd_names = my %stub_recs = ();	$zone = $_[0];	$origin = $zone_name = $_[2];	$orig = $origin unless ($origin eq '.');	if ($_[1]) {		$file = $_[1];		$real_file = $config{'chroot'} . &absolute_path($file);	}	else {		$no_file++;	}	if (defined($_[4])) {		$type = $_[4];	}	else {		$type = &find_value('type', $zone->{'members'});	}	$want_sd++ if ($type eq 'master');	if ($zone && (($dynamic_zone = &dynamic_zone($zone, 0)) || $no_file)) {		$cmd_line = $config{'dig_cmd'} . ' +nocomments +noidentify +nocmd +nostats ';		if ($type eq 'stub') {			#			# Stub zones only need the NS and SOA record, the			# relevant A and AAAA records will be automatically			# included in the answer. If, however, named is not			# running then we will have to wait for each query to			# timeout, and this can be many seconds. To avoid this,			# we simply return when named has stopped. For other			# zone types they wil get a connection refused error			# straight away, and so return straight away.			#			if (&named_running() == 0) {				return @records;			}			$cmd_line .= '+noauthority ' . $origin . ' ns @' . $config{'ns_if_query'} . ' ' . $origin . ' soa @' . $config{'ns_if_query'};		}		else {			$cmd_line .= '-t axfr ' . $origin . ' @' . $config{'ns_if_transfer'};		}		unless (open(FILE, "$cmd_line |")) {			$line = $!;			&terror('xfr_failed', $zone_name, $line);		}	}	else {		if (open(FILE, $real_file)) {			#			# If we allow dynamic zones to be treated as static			# ones when named is stopped, then we must delete any			# journal file that may exist because it is assumed we			# are about to make changes to the zone file.			#			if ($access{'dyn_as_static'} && &named_running() == 0 &&			    $type eq 'master') {				unlink $real_file . '.jnl';			}		}	}	while (defined($line = <FILE>)) {		chomp($line);		$glen = $merge = 0;		$comment = $merged_2 = '';		$line =~ s/\s*$//o;		#		# Strip out comments (# is not a valid comment separator here!).		#		if ($line =~ /(?<!\\);/o &&		    ($line =~ /^((?:[^;"]+|(?:"(?:[^"]*)"))*);(.*)/o ||		     $line =~ /^((?:[^;\\]|\\.)*);(.*)/o ||		     $line =~ /^((?:(?:[^;"\\]|\\.)+|(?:"(?:[^"\\]|\\.)*"))*);(.*)/o)) {			$line = $1;			$comment = $2;		}		# Now split the line into tokens.		$oset = 0;		while (1) {			$merge = 1;			if ($line =~ /^(\s*)"((?:[^"\\]|\\.)*)"(.*)/o ||			    $line =~ /^(\s*)((?:[^\s()"\\]|\\.)+)(.*)/o ||			    ($merge = 0) ||			    $line =~ /^(\s*)([()])(.*)/o) {				if ($glen == 0) {					$oset += length($1);				}				else {					$glen += length($1);				}				$glen += length($2);				$merged_2 .= $2;				$line = $3;				if (! $merge || $line =~ /^([\s()]|$)/o) {					push(@tokens, $merged_2);					push(@linenum, $lnum);					push(@offsets, $oset);					push(@comments, $comment); 					$comment = $merged_2 = '';					$oset += $glen;					$glen = 0;				}			}			else {				last;			}		}		$lnum++;	}	close(FILE);	#	# Now parse into data structures.	#	$i = 0;	while ($i < @tokens) {		if (uc($tokens[$i]) eq '$ORIGIN') {			#			# The $ORIGIN directive (may be relative or absolute).			#			$i++;			unless ($tokens[$i] =~ /\.$/o) {				$tokens[$i] .= '.';				$tokens[$i] .= $origin unless ($origin eq '.');			}			$origin = $tokens[$i];			$i++;		}		elsif (uc($tokens[$i]) eq '$INCLUDE') {			if ($linenum[$i + 1] == $linenum[$i + 2]) {				#				# $INCLUDE zonefile origin				#				unless ($tokens[$i + 2] =~ /\.$/o) {					$tokens[$i + 2] .= '.';					$tokens[$i + 2] .= $origin unless ($origin eq '.');				}				$inc_origin = $tokens[$i + 2];				@inc = &get_zone(0, $tokens[$i + 1],						 $inc_origin,				       (@records ? $records[$#records] : undef),						 $type);				$i += 3;			}			else {				#				# $INCLUDE zonefile				#				@inc = &get_zone(0, $tokens[$i + 1], $origin,				       (@records ? $records[$#records] : undef),						 $type);				$i += 2;			}			foreach $j (@inc) {				$j->{'num'} = $num++;			}			push(@records, @inc);		}		elsif (uc($tokens[$i]) eq '$GENERATE') {			#			# Generate directive...add it as a special record.			#			$gen = { 'line' => $linenum[$i], 'num' => $num++,				 'type' => '$GEN', 'fqdn' => $tokens[$i + 2],				 'values' => [ ] };			local @generate = ();			while ($linenum[++$i] == $gen->{'line'}) {				push (@{ $gen->{values} }, $tokens[$i]);				push(@generate, $tokens[$i]);			}			$gen->{'generate'} = \@generate;			push(@records, $gen);		}		elsif (uc($tokens[$i]) eq '$TTL') {			#			# TTL directive			#			$i++;			$ttl = &convert_time(0, $tokens[$i]);			$default_ttl = $ttl unless ($soa_seen);			$i++;		}		elsif ($tokens[$i] =~ /^\$(\S+)/o) {			#			# Some other special directive.			#			$j = $linenum[$i];				while($linenum[$i] == $j) {				$i++;			}		}		else {			local @values = ();			local %rec = ();			$rec{'line'} = $linenum[$i];			$rec{'comment'} = $comments[$i];			if (uc($tokens[$i]) eq 'IN' && $offsets[$i] > 0) {				# Starting with a class.				$rec{'class'} = uc($tokens[$i]);				$i++;			}			elsif ($tokens[$i] =~ /^\d/o &&			       $tokens[$i] !~ /\.in-addr\.arpa\.?$/io &&			       $offsets[$i] > 0) {				# Starting with a TTL and class.				$rec{'ttl'} = $tokens[$i];				$rec{'class'} = uc($tokens[$i + 1]);				$i += 2;			}			elsif (uc($tokens[$i + 1]) eq 'IN') {				# Starting with a name and class.				$rec{'fqdn'} = $tokens[$i];				$rec{'class'} = uc($tokens[$i + 1]);				$i += 2;			}			elsif ($offsets[$i] > 0) {				# Starting with nothing.				$rec{'class'} = 'IN';			}			elsif ($tokens[$i + 1] =~ /^\d/o &&			       uc($tokens[$i + 2]) eq 'IN') {				# Starting with a name, TTL and class.				$rec{'fqdn'} = $tokens[$i];				$rec{'ttl'} = $tokens[$i + 1];				$rec{'class'} = 'IN';				$i += 3;			}			elsif ($tokens[$i + 1] =~ /^\d/o) {				# Starting with a name and TTL.				$rec{'fqdn'} = $tokens[$i];				$rec{'ttl'} = $tokens[$i + 1];				$rec{'class'} = 'IN';				$i += 2;			}			else {				# Starting with a name.				$rec{'fqdn'} = $tokens[$i];				$rec{'class'} = 'IN';				$rec{'ttl'} = $ttl unless ($ttl == $default_ttl);				$i++;			}			$rec{'type'} = uc($tokens[$i++]);			if ($rec{'fqdn'}) {				$rec{'fqdn'} = $origin if ($rec{'fqdn'} eq '@');				unless ($rec{'fqdn'} =~ /\.$/o) {					$rec{'fqdn'} .= '.';					$rec{'fqdn'} .= $origin unless ($origin eq '.');				}				$rec{'fqdn'} = lc($rec{'fqdn'});				if ($want_sd && $rec{'type'} ne 'SOA' &&						$rec{'type'} ne 'NS') {					$sd = '';					if ($rec{'type'} eq 'DNAME') {						if ($rec{'fqdn'} =~ /(([^.]+\.)?[^.]+)\.$orig$/i) {							$sd = $1;							$sd =~ s/^\*\.//o;						}					}					elsif ($rec{'type'} eq 'SRV') {						if ($rec{'fqdn'} =~ /^_[^.]+\._[^.]+.*\.(([^.]+\.)?[^.]+)\.$orig$/i) {							$sd = $1;						}						else {							if ($rec{'fqdn'} =~ /\.(([^.]+\.)?[^.]+)\.$orig$/i) {								$sd = $1;							}						}					}					else {						if ($rec{'fqdn'} =~ /\.(([^.]+\.)?[^.]+)\.$orig$/i) {							$sd = $1;						}					}					if ($sd) {						unless (exists($sd_names{$sd})) {							$sd_names{$sd} = 1;							$sd =~ s/^[^.]+\.//o;							$sd_names{$sd} = 1;						}					}				}			}			else {				$prv = ($#records >= 0) ? $records[$#records]							: $_[3];				unless ($prv) {					&terror('efirst', $linenum[$i] + 1, $file);				}				$rec{'fqdn'} = $prv->{'fqdn'};			}			if ($rec{'type'} eq 'SOA') {				#				# Zone transfers start and end with the SOA				# record. We only need to record one though.				# If we don't see the second one then the				# transfer has not succeded.				#				$soa_seen++;				last if ($soa_seen == 2);			}			#			# Now read values until either an end of line			# or a ')' is found.			#			$token_count = 0;			$j = $linenum[$i];			while ($linenum[$i] == $j && $i < @tokens) {				if ($tokens[$i] eq '(') {					while (1) {						if (++$i >= @tokens) {							&terror('xfr_invalid_rr', $rec{'line'});						}						elsif ($tokens[$i] eq ')') {							$i++;							last;						}						if (&convert_value($rec{'type'}, $token_count) >= 0) {							$tokens[$i] = $origin if ($tokens[$i] eq '@');							unless ($tokens[$i] =~ /\.$/o) {								$tokens[$i] .= '.';								$tokens[$i] .= $origin unless ($origin eq '.');							}							$tokens[$i] = lc($tokens[$i]);						}						$token_count++;						push(@values, $tokens[$i]);					}					last;				}				else {					if (&convert_value($rec{'type'}, $token_count) >= 0) {						$tokens[$i] = $origin if ($tokens[$i] eq '@');						unless ($tokens[$i] =~ /\.$/o) {							$tokens[$i] .= '.';							$tokens[$i] .= $origin unless ($origin eq '.');						}						$tokens[$i] = lc($tokens[$i]);					}					$token_count++;					push(@values, $tokens[$i++]);				}			}			#			# Unfortunately, for stub zones we are likely to get			# duplicate records returned since we are, in effect,			# making two queries. To avoid showing two records			# which are the same, we sift through the ones already			# seen. Although this could be expensive, hopefully a			# stub zone will have very few entries.			#			if ($type eq 'stub' && $rec{'type'} ne 'SOA') {				if (exists($stub_recs{$rec{'fqdn'}}{$values[0]})) {					next;				}				else {					$stub_recs{$rec{'fqdn'}}{$values[0]}++;				}			}			$rec{'values'} = \@values;			$rec{'eline'} = $linenum[$i - 1];			$rec{'num'} = $num++;			push(@records, \%rec);		}	}	if ($dynamic_zone && $soa_seen == 1 && $type ne 'stub') {		&terror('xfr_incomplete', $zone_name);	}	if ($want_sd) {		$sd_zones{$zone_name} = ();		%{ $sd_zones{$zone_name} } = map { $_ => 1 } keys(%sd_names);	}	return @records;}## Create a new resource record.## create_record(zone, file, name, ttl, class, type, values, comment)#sub create_record {	my $lref = my $dynamic_zone = my $default_ttl = my $ttl = 0;	my $zone = my $file = my $zone_ref = my $str = my $err = '';	$zone = $_[0];	$file = $_[1];	$zone_ref = &get_zone_data($zone);	$dynamic_zone = $zone_ref->[1];	$default_ttl = $zone_ref->[2];	$ttl = &convert_time(0, $_[3]) if (defined($_[3]));	if ($dynamic_zone) {		if ($dynamic_zone == 1) {			$ttl = $default_ttl unless ($ttl);			$str = 'local ' . $config{'ns_if_update'} . "\n";			$str .= 'zone ' . $zone->{'value'} . "\n";			$str .= "update add $_[2] $ttl $_[4] $_[5] $_[6]\n\n";			$err = `echo "$str" | $config{'nsupdate_cmd'} -d 2>&1`;			&check_update_err($err) if ($?);		}	}	else {		$_[3] = $ttl;		$lref = &read_file_lines($config{'chroot'} .							&absolute_path($file));		push(@$lref, &make_record(@_[2 .. $#_]));		&flush_file_lines();	}	return;}## Modify (update) an existing record.## modify_record(zone, file, &old, name, ttl, class, type, values, comment)#sub modify_record {	my $lref = my $lines = my $v = 0;	my $dynamic_zone = my $default_ttl = my $ttl = 0;	my $zone = my $file = my $zone_ref = my $old = my $str = my $err = '';	my $values = '';	$zone = $_[0];	$file = $_[1];	$old = $_[2];	$zone_ref = &get_zone_data($zone);	$dynamic_zone = $zone_ref->[1];	$default_ttl = $zone_ref->[2];	$ttl = &convert_time(0, $_[4]) if (defined($_[4]));	if ($dynamic_zone) {		if ($dynamic_zone == 1) {			$ttl = $default_ttl unless ($ttl);			#			# We need to delete the old record rather than just			# changing the current one because the name and its			# value(s) may have changed. Thus we must, in effect,			# remove the old record first - except for SOA records.			#			if ($_[6] ne 'SOA') {				$values = '';				for ($v = 0; defined($old->{'values'}->[$v]); $v++) {					$values .= ' ' . $old->{'values'}->[$v];				}				if ($v == 0) {		# No values seen.					&terror('update_no_data');				}				$str = 'local ' . $config{'ns_if_update'} . "\n";				$str .= 'zone ' . $zone->{'value'} . "\n";				$str .= "prereq yxrrset $old->{'fqdn'} $old->{'class'} $old->{'type'}\n";				$str .= "update delete $old->{'fqdn'} $old->{'class'} $old->{'type'} $values\n";			}			$str .= "update add $_[3] $ttl $_[5] $_[6] $_[7]\n\n";