records-lib.pl

BIND 9 dynamic DNS webmin module. This module supports both static and dynamic zones, and IPv4 and I

#! /usr/bin/perl

#
#    B9DDNS - BIND 9 dynamic DNS webmin module.
#    Copyright (C) 2003 John Horne. <[e-mail]>
#    Copyright (C) 2004 John Horne. <[e-mail]>
#
#    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";