records-lib.pl

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

	}

	return $addr;
}


#
# Convert an IPv6 address like a.b.c.d.4.3.2.1.ip6.arpa. to 1234:dcba::
# If the address is a subnet then no trailing :: will be included.
#
# ip6arpa_to_net(name)
#

sub ip6arpa_to_net {

	my $count = 0;

	my $addr = $_[0];


	if ($addr =~ /^((\*\.)?([\da-f]\.)+)ip6\.arpa\.?$/io) {
		$addr = lc($1);

		$count = ($addr =~ s/\./\./go);

		$count++ unless ($addr =~ /\.$/o);

		$addr = reverse(split(/\./, $addr));

		$addr =~ s/([*\da-f]{4})/$1:/go;

		#
		# For full IPv6 addresses we can remove the leading zeros in
		# all parts of the address. However, for subnets we must leave
		# in the leading zeros in the last part of the address. If we
		# did not then we would not be able to tell where the subnet
		# ended.
		#

		if ($count == 33) {			# A full IPv6 address.
			$addr =~ s/([*\da-f]+)$/$+0000/;

			$addr =~ s/([*\da-f]{4})0+$/$1/o;

			$addr =~ s/:0{1,3}([\da-f]+)$/:$1/o;
		}
		else {
			$addr =~ s/:$//o;
		}

		$addr =~ s/(^|:)0{1,3}([\da-f]+)(?=:)/$1$2/go;

		$addr =~ s/::$//o;

		$addr =~ s/(:0)+:/::/o if ($count == 33);

		$addr =~ s/([*\da-f]):$/$1/o;
	}

	return $addr;
}


#
# Converts an IPv6 address like 1234:dcba:: to a.b.c.d.4.3.2.1.ip6.arpa.
#
# net_to_ip6arpa(address)
#

sub net_to_ip6arpa {

	my $addr = $_[0];


	if (&check_ip6address($addr)) {
		$addr = lc($addr);

		$addr = reverse(split(/\:/, &expandall_ip6($addr)));

		$addr =~ s/([*\da-f])/$1\./go;

		$addr .= 'ip6.arpa.';
	}

	return $addr;
}


#
# Check that a DNS name is valid.
#
# valdnsname(name, wild, origin)
#

sub valdnsname {

	my $fqdn = '';

	my $underscore = $config{'allow_underscore'} ? '_' : '';


	$fqdn = ($_[0] !~ /\.$/o) ? "$_[0].$_[2]." : $_[0];

	$fqdn =~ s/\.+$/\./o;

	if (length($fqdn) > 255) {
		&terror('edit_efqdn', $fqdn);
	}

	if ($_[0] =~ /[^.]{64}/o) {   # No label should be longer than 63 chars.
		&terror('edit_elabel', $_[0]);
	}

	return ((($_[1] && $config{'allow_wild'})
		? (($_[0] =~ /^[-*.a-z\d\/\$$underscore]+$/i)
		   && ($_[0] !~ /.\*/o)		# Wildcard must be at the start.
		   && ($_[0] !~ /\*[^.]/o))	# A "." must always follow "*".
		: ($_[0] =~ /^[-.a-z\d\/\$$underscore]+$/i))
		&& ($_[0] !~ /\.\./o)		# No ".." inside.
		&& ($_[0] !~ /^\../o)		# No "." at the beginning.
		&& ($_[0] !~ /\.\d+\.$/o));	# Last label is not numeric.
}


#
# Check that an email address is valid.
#
# valemail(email_address)
#

sub valemail {

	my $addr = my $uid = '';


	$addr = $_[0];


	return 1 if ($addr eq '.');

	if ($addr =~ /^([^@]+)(@([^@]+))?$/o) {
		$uid = $1; $addr = $3;

		return 0 unless ($uid =~ /^[-.\w\d]+$/o);

		return 0 if ($addr && ! &valdnsname($addr, 0, '.'));

		return 1;
	}

	return 0;
}


#
# Make a named absolute path. If the path does not start with
# a '/', then prepend the base directory.
#
# absolute_path(path)
#

sub absolute_path {

	return $_[0] if ($_[0] =~ /^\//o);

	return (&base_directory() . '/' . $_[0]);
}


#
# This subroutine will return a boolean/logical value indicating if the
# given zone is 'dynamic' or 'static'. A dynamic zone is one which allows
# dynamic updates. That is, the 'allow-update' or 'update-policy' option is
# present in a master zone, or 'allow-update-forwarding' is present in a slave
# zone, and it does not begin with the keyword 'none'.
#
# For dynamic zones, if 'check_updaters' is set, then the list of IP addresses
# allowed to update the zone is checked against the local hosts address.
# The value of 1 is returned if it is present, and if it is not present, or
# 'none' is seen, then a value of 2 is returned. A returned value of 0
# indicates a static zone.
#
# Return value:	0 - static zone
#		1 - dynamic zone
#		2 - dynamic zone but updates not allowed from this host
#
# dynamic_zone(zone, check_updaters)
#

sub dynamic_zone {

	my $not = my $update_policy = 0;

	my $zone = my $check_updaters = my $allow_updates = my $updaters = '';
	my $host_ip = my $ip_list = my $entry = my $u = '';

	my $str = undef;


	$zone = $_[0];

	$check_updaters = $_[1];

	$u = &find_value('type', $zone->{'members'});

	return 0 if ($access{'dyn_as_static'} && $u eq 'master' &&
		     &named_running() == 0);


	#
	# A dynamic zone is defined as one which has either the 'allow-update'
	# option or the 'update-policy' option set. We check for the
	# 'allow-update' and the 'allow-update-forwarding' options first.
	#

	if ($u eq 'master') {
		$str = &find('allow-update', $zone->{'members'});

		unless (defined($str)) {
			$str = &find('update-policy', $zone->{'members'});

			$update_policy++ if (defined($str));
		}
	}
	elsif ($u eq 'slave') {
		$str = &find('allow-update-forwarding', $zone->{'members'});
	}

	return 0 unless (defined($str));


	if ($check_updaters) {
		$host_ip = &to_ipaddress(&get_system_hostname());

		return 2 unless ($host_ip);	# No IP, so updates not allowed.
	}


	$updaters = $str->{'members'};

	foreach $u (@{ $updaters }) {
		$ip_list .= ' ' if ($ip_list);
		$ip_list .= $u->{'name'};
	}


	#
	# For the 'update-policy' option we can only check whether we have
	# seen a 'grant' or not.
	#

	if ($update_policy) {
		return ($ip_list =~ /grant/io);
	}


	#
	# Now we can check the updaters for zones using the 'allow-update'
	# or 'allow-update-forwarding' options.
	#

	while ($ip_list) {
		if ($ip_list =~ /^!\s*(.*)$/o) {
			$not = 1;
			$ip_list = $1;
		}
		else {
			$not = 0;
		}

		if ($ip_list =~ /^(\S+)\s*(.*)$/o) {
			$entry = $1;
			$ip_list = $2;
		}
		
		if ($entry eq 'any' || $entry eq 'localhost' || $entry eq 'localnets') {
			return ($not ? 2 : 1);
		}

		if ($entry eq 'none') {
			if ($not) {
				return 1;
			}
			else {
				return ($allow_updates ? 2 : 0);
			}
		}

		if (&check_ipaddress($entry) || &check_ip6address($entry)) {
			if ($entry eq $host_ip) {
				return ($not ? 2 : 1);
			}
			else {
				$allow_updates .= ' ' if ($allow_updates);
				$allow_updates .= $entry;
			}
		}
		elsif ($entry =~ /\//o) {
			if (&ip_in_range($host_ip, $entry)) {
				return ($not ? 2 : 1);
			}
			else {
				$allow_updates .= ' ' if ($allow_updates);
				$allow_updates .= $entry;
			}
		}
		elsif (! $not) {
			$entry = &expand_acl($entry);

			$ip_list = $entry . ' ' . $ip_list;

			&trim($ip_list);
		}
	}

	return ($check_updaters) ? 2 : 1;
}


#
# Return an array of information about a zone.
#
# The default TTL value for the zone is obtained by looking for an initial
# $TTL directive in the zone file. If that is not found then the TTL value
# specified on the SOA record is used. If that is not present then the SOA
# negative caching (minimum) value is used. Failing that 86400 is used.
# A static zone can use 0 to mean the default TTL.
#
# Returned data: Zone index
#		 Zone type    = 0	Static zone
#			      = 1	Dynamic zone
#			      = 2	Dynamic zone - but cannot be updated
#					from this host
#		 Default TTL  = x	Default TTL in seconds
#		 SOA serial number
#
# get_zone_data(zone)
#

sub get_zone_data {

	my $ttl = my $soa_ttl = my $soa_ncache = my $dynamic_zone = 0;

	my $zone = my $conf = my $file = my $line = my $z = '';


	$zone = $_[0];


	unless (ref($zone)) {		# Probably a static zone.
		$conf = &get_config();

		foreach $z (@$conf) {
			if ($z->{'index'} == $zone) {
				$zone = $z;
				last;
			}
		}

		unless (ref($zone)) {	# Non-existant zone.
			@zone_data = ();

			return \@zone_data;
		}
	}


	if (@zone_data) {
		#
		# Only return the cached data if this is for the same zone.
		#

		return \@zone_data if ($zone->{'index'} == $zone_data[0]);
	}


	@zone_data = ();

	$zone_data[0] = $zone->{'index'};


	$zone_data[1] = $dynamic_zone = &dynamic_zone($zone, 1);


	#
	# Get the SOA record info - TTL value, serial number and negative
	# caching value if necessary.
	#

	$zone_data[3] = -1;			# Invalid SOA serial number.

	$line = &get_soa_rec($zone, undef, undef);

	if ($line =~ /^\S+\s+((?:\d+[SMHDW]?)+)?\s+(IN)?\s+SOA\s+\S+\s+\S+\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/o) {
		$soa_ttl = $1 if (defined($1));	# SOA TTL value
		$zone_data[3] = $3;		# SOA serial number
		$soa_ncache = $7;		# SOA negative caching value
	}


	#
	# We must look in the zone file to see if there is any overriding
	# $TTL directive for the zones default TTL value.
	#

	$file = &find_value('file', $zone->{'members'});

	if (defined($file)) {
		$file = $config{'chroot'} . &absolute_path($file);

		if (open(FILE, $file)) {
			while (defined($line = <FILE>)) {
				chomp($line);

				next if ($line =~ /^\s*(;.*)?$/o);

				if ($line =~ /^\$TTL\s+((\d+[SMHDW]?)+)/io) {
					$ttl = $1;
					last;
				}

				last if ($line =~ /^[^\$]/o);
			}

			close(FILE);
		}
	}

	unless ($ttl) {			# Now decide which TTL value to use.
		if ($soa_ttl) {
			$ttl = $soa_ttl;
		}
		elsif ($soa_ncache) {
			$ttl = $soa_ncache;
		}
	}

	$ttl = &convert_time(0, $ttl);

	$ttl = 86400 unless ($ttl);

	$zone_data[2] = $ttl;


	return \@zone_data;
}


#
# expand_acl(acl_name)
#

sub expand_acl {

	my $found_acl = my $i = 0;

	my $acl_name = my $list = my $conf = '';

	my @acls = ();


	$acl_name = lc($_[0]);


	$conf = &get_config();

	@acls = ( &find('acl', $conf), { } );

	for ($i = 0; $i < @acls; $i++) {
		if (lc($acls[$i]->{'value'}) eq $acl_name) {
			$found_acl++;
			last;
		}
	}

	if ($found_acl) {
		$list = join(' ', map { $_->{'name'} } @{ $acls[$i]->{'members'} });
	}

	return $list;
}


#
# ip_in_range(address, ip_range)
#

sub ip_in_range {


	my $mask = 0;

	my $addr = my $range = '';


	$addr = $_[0];

	$range = $_[1];


	unless (&check_ipaddress($addr)) {
		return 0;
	}


	#
	# Expand the range IP address by filling in the missing 0's.
	#

	if ($range =~ /^(\d{1,3})(\.\d{1,3})?(\.\d{1,3})?(\.\d{1,3})?(.*)$/o) {
		if (! defined($2)) {
			$range = $1 . '.0.0.0' . $5;
		}
		elsif (! defined($3)) {
			$range = $1 . $2 . '.0.0' . $5;
		}
		elsif (! defined($4)) {
			$range = $1 . $2 . $3 . '.0' . $5;
		}
	}
	else {			# Invalid IP address range given.
		return 0;
	}


	#
	# Now determine the subnet mask.
	#

	if ($range =~ /\/(\d\d?)$/o) {
		$mask = $1;

		if ($mask > 32) {	# Invalid subnet mask given.
			return 0;
		}
		elsif ($mask == 0) {	# Any address will match.
			return 1;
		}
		elsif ($mask == 32) {	# Range is just an IP address.
			$range =~ s:/\d+$::o;

			return ($addr eq $range);
		}
		else {
			$mask = 0xFFFFFFFF << (32 - $mask);
		}
	}
	elsif ($range =~ /\//o) {	# Invalid subnet mask given.
		return 0;
	}
	else {				# Range is just an IP address.
		return ($addr eq $range);
	}


	$addr = unpack('N', pack('C4', split(/\./, $addr)));

	$range =~ s:/\d+$::o;		# Strip off the subnet mask.

	$range = unpack('N', pack('C4', split(/\./, $range)));

	$range = $range & $mask;


	return ($range == ($addr & $mask));
}


#
# This subroutine will change a name or address to or from the FQDN name.
# The first argument can be either:
#
#	1 - convert to FQDN
#	0 - convert to abbreviated format
#      -1 - same as '0' except that IP addresses are converted to dotted-quad
#	    format for IPv4 and network format for IPv6.
#
# convert_fqdn(to_fqdn, name, origin, leave_origin)
#

sub convert_fqdn {

	my $name = my $orig_name = my $origin = '';


	if ($_[1]) {
		$name = lc($_[1]);
	}
	else {
		return $name;
	}

	$origin = lc($_[2]);


	$orig_name = $name;

	$name = $origin if ($name eq '@');


	if ($name =~ /^\d{1,3}(\.\d{1,3})?(\.\d{1,3})?(\.(\d{1,3}|\*))?$/o) {
		$name = &ip_to_arpa($name);

		if ($_[0] == 0) {
			if ($name eq $origin) {
				$name = '@' unless ($_[3]);
			}
			elsif ($origin eq '.') {
				$name =~ s/\.$//o;
			}
			else {
				$name =~ s/\.$origin$//;
			}
		}
		elsif ($_[0] == -1) {
			$name = &compress_ip($orig_name);

			if ($name eq $origin) {
				$name = '@' unless ($_[3]);
			}
		}
	}
	elsif ($name =~ /^[:\da-f]+:[:\da-f]+\*?$/o) {
		return $name if ($name =~ /[\da-f]:$/o);

		$name = &net_to_ip6arpa($name);

		if ($_[0] == 0) {
			if ($name eq $origin) {
				$name = '@' unless ($_[3]);
			}
			elsif ($origin eq '.') {
				$name =~ s/\.$//o;
			}
			else {
				$name =~ s/\.$origin$//;
			}
		}
		elsif ($_[0] == -1) {
			if (&is_ip6_subnet($name)) {
				$name = $orig_name;
			}
			else {
				$name = &compress_ip6($orig_name);
			}

			if ($name eq $origin) {
				$name = '@' unless ($_[3]);
			}
		}
	}
	else {
		if ($name !~ /\.$/o) {
			$name .= '.';

			$name .= $origin unless ($origin eq '.');
		}

		if ($_[0] == -1 && $name =~ /\.(in-addr|ip6)\.arpa\.$/o) {
			if ($name eq $origin) {
				$name = '@' unless ($_[3]);
			}