b9ddns-lib.pl

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

	}
	elsif ($code == -8) {
		$str = 'named_ctrl_unk_alg';
	}
	else {
		$str = 'named_ctrl_unknown_msg';
	}

	return $text{$str};
}


#
# Get the PID pathname as defined in named.conf. A default of
# '/var/run/named.pid' will be used if no pathname is defined.
#
# get_pidpath()
#

sub get_pidpath {

	my $pidpath = my $opts = my $dir = my $conf = '';


	$conf = &get_config();

	$opts = &find('options', $conf);

	if (defined($opts)) {
		$pidpath = &find_value('pid-file', $opts->{'members'});

		if (defined($pidpath) && $pidpath !~ /^\//o) {
			$pidpath = &absolute_path($pidpath);
		}
	}

	$pidpath = '/var/run/named.pid' unless ($pidpath);

	return $pidpath;
}


#
# Get the version of the currently configured named. It will return the
# version as a real number, or the original version string if requested.
#
# bind_version(original)
#

sub bind_version {

	my $version = 0;

	my $cmd = my $m = my $n = '';


	$cmd = `$config{'named_path'} -v 2>&1`;

	$version = $1 if ($cmd =~ /bind\s+(\S+)/io);

	if (! $_[0] && $version =~ /^(\d+\.\d+)(\.\d+)+/o) {
		$version = $1; $n = $2;

		$n =~ s/\.//go;

		$version .= $n;
	}

	return $version;
}


#
# This subroutine removes all leading zeros from an IP address.
#
# compress_ip(address)
#

sub compress_ip {

	my $addr = $_[0];


	$addr =~ s/(^|\.)00?(\d+)(?=\.|$)/$1$2/go;

	return $addr;
}


#
# This subroutine will compress an IPv6 address by changing the longest
# sequence of :0 it sees to ::. It will then compress any leading zeros.
#
# compress_ip6(address)
#

sub compress_ip6 {

	my $i = 0;

	my $addr = $_[0];


	return $addr if (! $addr || $addr =~ /[^:\da-f*]/io);


	#
	# We must first expand the address so that all the required ':0'
	# elements are present. These will also be compressed to remove any
	# unnecessary leading zeros. We can then look at the address to
	# determine the longest sequence of ':0'.
	#

	$addr = &expand_ip6($addr, 0);

	for ($i = 7; $i > 0; $i--) {
		if ($addr =~ /((^|:)0+(?=:|$)){$i}/) {
			$addr =~ s/((^|:)0+(?=:|$)){$i}/:/;

			$addr .= ':' if ($addr =~ /[\da-f]:$/o);

			last;
		}
	}

	return $addr;
}


#
# This subroutine checks to see if an IP address is already in use. It returns
# a boolean value. Optionally reverse zones will also be checked.
#
# If we are checking an address from a forward zone then we must look through
# all the forward zones for a matching address. This is also true if we are
# checking an address from a reverse zone. However, if we are to include checks
# of the reverse zones, and we are starting in a reverse zone then that is the
# only reverse zone we need to check, because the address must fall within that
# zone. If we are starting from a forward zone then we need to check all the
# reverse zones.
#
# ip_in_use(config, addr, name, rec_type, reverse_origin, access)
#

sub ip_in_use {

	my $ipv4_rec = my $check_reverse = 0;

	my $conf = my $type = my $zone_type = my $file = my $zn = my $z = '';
	my $rec = my $addr = my $rev_addr = my $rec_name = my $rev_zone = '';

	my @zone_list = my @recs = ();


	$conf = $_[0];

	$addr = $_[1];

	$rec_name = $_[2];

	$type = $_[3];

	$rev_zone = $_[4] if (defined($_[4]) && $_[4]);

	if ($_[5] == 0) {		# Multiple names/addresses are allowed.
		return 0;
	}
	elsif ($_[5] == 1) {		# Multiples are not allowed.
		$check_reverse++;
	}
	elsif ($_[5] == 2) {
		#
		# Only reverse zones can have multiple names and addresses.
		# However, if the forward record is to be updated as well, then
		# we must check the forward zones, but not the reverse ones, to
		# see if the address is already in use. If no forward record is
		# to be created or modified then we can just return.
		#

		return 0 if ($rev_zone && ! $in{'fwd'});
	}


	if ($type eq 'A') {
		$ipv4_rec++;

		$rev_addr = &ip_to_arpa($addr) if ($check_reverse);
	}
	else {
		$addr = &expand_ip6($addr);

		$rev_addr = &net_to_ip6arpa($addr) if ($check_reverse);
	}

	@zone_list = &find('zone', $conf);


	foreach $z (@zone_list) {
		$zone_type = &find_value('type', $z->{'members'});

		next unless (defined($zone_type));

		$zn = lc($z->{'value'});
		$zn .= '.' unless ($zn =~ /\.$/o);

		next unless ($zone_type eq 'master' ||
			     ($zone_type eq 'slave' && &dynamic_zone($z, 1) == 1));

		if ($zn =~ /\.(in-addr|ip6)\.arpa\.$/o) {
			if ($check_reverse) {
				if ($rev_zone) {
					next unless ($zn eq $rev_zone);
				}
				else {
					#
					# Don't check for an IPv4 address in
					# IPv6 zones, and vice versa.
					#

					next if (($ipv4_rec && $1 eq 'ip6') ||
						 (! $ipv4_rec && $1 eq 'in-addr'));
				}
			}
			else {
				next;
			}
		}


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

		next unless (defined($file));

		@recs = &get_zone($z, $file, $zn, undef, $zone_type);


		foreach $rec (@recs) {
			if ($rec->{'type'} eq 'A') {
				if ($ipv4_rec) {
					return 1 if ($rec->{'values'}->[0] eq $addr && $rec->{'fqdn'} ne $rec_name);
				}
			}
			elsif ($rec->{'type'} eq 'AAAA') {
				unless ($ipv4_rec) {
					return 1 if (&expand_ip6($rec->{'values'}->[0]) eq $addr && $rec->{'fqdn'} ne $rec_name);
				}
			}
			elsif ($check_reverse && $rec->{'type'} eq 'PTR') {
				return 1 if ($rec->{'fqdn'} eq $rev_addr && $rec->{'values'}->[0] ne $rec_name);
			}
		}
	}

	return 0;
}


#
# This subroutine will create a zone file name using the name templates set in
# the module configuration.
#
# create_zone_fn(conf, zone_name, reverse, &access, base)
#

sub create_zone_fn {

	my $file = my $base = my $fn_format = '';

	my $zone = $_[1];


	if (defined($_[4])) {
		$base = $_[4];

		$base =~ s:/+$::o;
	}
	else {
		$base = &zone_dir(1, $_[3], $_[0]);
	}


	if ($_[2]) {			# A reverse zone file name.
		$zone = &ip6arpa_to_net(&arpa_to_ip($zone));

		$fn_format = $config{'rev_zone_fn_fmt'};
	}
	else {
		$zone =~ s/\.$//o;

		$fn_format = $config{'fwd_zone_fn_fmt'};
	}

	$fn_format =~ s/ZONE/$zone/g;

	$file = $base . '/' . $fn_format;

	return $file;
}


#
# This subroutine is used when a zone has its options changed. One change
# may be with the zone file. We therefore need to check that any new zone
# file name is valid.
#
# zone_file_check(conf, file, &access, new_file)
#

sub zone_file_check {

	my $file = $_[1];


	return $text{'slave_efile'} unless ($file);

	return &text('slave_efile2', $file) if ($file =~ /\s/o);


	$file = &absolute_path($file);

	return &text('create_efile4', $file) if ($_[3] &&
					       (-r $config{'chroot'} . $file));

	return &allowed_zone_file($_[2], $file) ? undef :
						   &text('slave_efile2', $file);
}


#
# Display a header indicating the type of zone being looked at.
#
# zone_header(dynamic_zone_type, origin, zone_type)
#

sub zone_header {

	my $hdr = '';


	if ($_[1] =~ /\.(in-addr|ip6)\.arpa\.$/o) {
		$hdr = $text{'Reverse'} . (($1 eq 'in-addr') ? ' IPv4 ' : ' IPv6 ');
	}

	if ($_[2] eq $text{'Master'} || $_[2] eq $text{'Slave'}) {
		$hdr .= ($_[0] ? $text{'Dynamic'} : $text{'Static'}) . ' ';
	}

	$hdr .= $_[2] . ' ' . $text{'zone'} .
		   (($_[0] == 2) ? " ($text{'updates_no_allow'})" : '');

	return $hdr;
}


#
# zone_dir(master/slave, %access, [&config])
#

sub zone_dir {

	my $base = my $conf = my $master = '';


	$conf = $_[2] if (defined($_[2]));

	$master = ($_[0] == 1) ? $config{'master_dir'} : $config{'slave_dir'};


	$base = ($master) ? $master
			  : ($_[1]->{'dir'} eq '/') ? &base_directory($conf)
						    : $_[1]->{'dir'};

	$base =~ s:/+$::o if ($base ne '/');

	return $base;
}


#
# This subroutine simply checks if a given ACL name is valid.
#
# valid_acl_name(acl_name)
#

sub valid_acl_name {

	if (! $_[0] || $_[0] =~ /[\s{};'"!]/o || $_[0] !~ /\D/o) {
		return 0;
	}
	else {
		return 1;
	}
}


#
# This subroutine simply checks if a given ACL value is valid.
#
# valid_acl_value(acl_name, [&config])
#

sub valid_acl_value {

	my $conf = '';

	my @acls = ();

	my $acl = $_[0];


	$acl =~ s/^!\s*//o;	# Remove any leading '!'.


	#
	# First check the standard ACL names.
	#

	return 1 if ($acl eq 'none' || $acl eq 'any' ||
		     $acl eq 'localhost' || $acl eq 'localnets');


	#
	# Next check IP addresses.
	#

	if ($acl =~ /^[\d.]+$/o) {
		return &valipaddr($acl, '.in-addr.arpa.', 1, 0, 0, 1);
	}

	if ($acl =~ /^[\da-f:]+:[\da-f:]*$/io) {
		return &valipaddr($acl, '.ip6.arpa.', 1, 0, 0, 0);
	}


	#
	# Now check any IP address range that may have been given.
	#

	if ($acl =~ /^(.+)\/(\d\d?)$/o) {
		if ((&valipaddr($1, '.in-addr.arpa.', 1, 0, 1, 1) ||
		     &valipaddr($1, '.ip6.arpa.', 1, 0, 1, 0)) &&
		    ($2 > 0 && $2 <= 32)) {
			return 1;
		}
		else {
			return 0;
		}
	}


	#
	# Finally check any existing ACL names.
	#

	$conf = (defined($_[1])) ? $_[1] : &get_config();

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

	foreach (@acls) {
		return 1 if ($_->{'value'} eq $acl);
	}


	return 0;
}


#
# This subroutine will create a top-level section in the named config file.
# Typically this is used by the global options to create sections such as
# 'logging', 'controls', 'options' and so on.
#
# create_entry(name, &config)
#

sub create_entry {

	my $entry = { 'name' => $_[0], 'type' => 1 };

	&save_directive(&get_config_parent(), $_[0], [ $entry ], 0);


	return &find($_[0], $_[1]);
}


#
# This subroutine is used to partially parse an 'address_match_list' entry.
# For ease of programming any use of the '!' symbol should be next to the
# relevant address rather than being separated from it by spaces. However,
# the latter is more easily readable by humans. As such this subroutine
# simply splits up all the addresses, removes all redundant spaces and
# compresses the '!' symbol next to the address. It will also lowercase any
# reserved word or IPv6 address it sees.
#
# compress_not(address_string)
#

sub compress_not {

	my $not = '';

	my @addr = ();

	my $addresses = $_[0];


	&trim($addresses);

	foreach (split(/\s+/, $addresses)) {
		if ($_ eq '!') {
			$not = $_;
		}
		else {
			push (@addr, $not . lc($_)) if ($_);

			$not = '';
		}
	}

	push (@addr, $not) if ($not);

	return @addr;
}


#
# trim(string)
#

sub trim {

	$_[0] =~ s/^\s+//o;
	$_[0] =~ s/\s+$//o;

	return;
}


#
# check_tld(name, config|origin, access, zone_type, rec_type)
#

sub check_tld {

	my $origin = '';

	my $name = lc($_[0]);


	return 1 if ($_[2]->{'tld'} == 1 || $_[4] eq 'DNAME' || $_[4] eq 'NS');


	return 1 unless ($_[1]);

	if (ref($_[1])) {
		$origin = $_[1]->{'value'};
	}
	else {
		$origin = $_[1];
	}

	$origin =~ s/\.$//o;
	$origin = lc($origin);

	if ($name =~ /\.$/o) {
		$name =~ s/\.$//o if ($origin);
	}
	else {
		$name .= '.' . $origin;
	}


	if ($_[4] eq 'SRV') {	# SRV records need the service/protocol removed.
		if ($name =~ /^_[^.]+\._[^.]+\.(.+\.$origin)$/) {
			$name = $1;
		}
	}


	if ($name =~ /^[^.]+\.$origin$/) {
		if ($_[2]->{'tld'} == 2) {
			return (lc($_[3]) eq 'master');
		}
	}
	else {
		return 1;
	}

	return 0;
}


#
# check_sd(name, config|origin, access, zone_type, rec_type)
#

sub check_sd {

	my $origin = my $sd = '';

	my %sd_names = ();

	my $name = lc($_[0]);


	return 1 if ($_[4] eq 'NS');

	return 1 if ($_[2]->{'sd'} == 1 && ! $_[2]->{'sd2'});


	return 1 unless ($_[1]);

	if (ref($_[1])) {
		$origin = $_[1]->{'value'};
	}
	else {
		$origin = $_[1];
	}

	$origin =~ s/\.$//o;
	$origin = lc($origin);

	if ($name =~ /\.$/o) {
		$name =~ s/\.$//o if ($origin);
	}
	else {
		$name .= '.' . $origin;
	}


	if ($_[4] eq 'DNAME') {
		if ($name =~ /(([^.]+\.)?[^.]+)\.$origin$/) {
			$sd = $1;
			$sd =~ s/^\*\.//o;
		}
		else {
			return 1;
		}
	}
	elsif ($_[4] eq 'SRV') {
		if ($name =~ /^_[^.]+\._[^.]+.*?\.(([^.]+\.)?[^.]+)\.$origin$/) {
			$sd = $1;

			return 1 unless ($sd =~ /\./o);
		}
		else {
			if ($name =~ /\.(([^.]+\.)?[^.]+)\.$origin$/) {
				$sd = $1;
			}
			else {
				return 1;
			}
		}
	}
	else {
		if ($name =~ /\.(([^.]+\.)?[^.]+)\.$origin$/) {
			$sd = $1;
		}
		else {
			return 1;
		}
	}


	$origin .= '.' unless ($origin =~ /\.$/o);

	unless ($sd_zones{$origin}) {
		#
		# This is expensive. However I don't think this code will ever
		# be reached because the relevant zone must already have been
		# looked up in order for this subroutine to have been called.
		# The calls below simply ensure that sd_zones gets populated.
		#

		my @recs = ($origin =~ /\.(in-addr|ip6)\.arpa\.$/o) ?
				&find_forward($name, undef, ($1 eq 'in-addr')) :
				&find_reverse($name, undef);
	}

	%sd_names = map { $_ => 1 } keys(%{ $sd_zones{$origin} });


	if ($_[2]->{'sd2'}) {		# Only second-level sd's allowed.
		return 1 if (exists($sd_names{$sd}));
	}

	$sd =~ s/^[^.]+\.//o;		# Convert the sd to a top-level name.

	if (exists($sd_names{$sd})) {
		return 1;
	}
	else {
		return 0 if (! $_[2]->{'sd'} || $_[2]->{'sd2'});
	}

	if ($_[2]->{'sd'} == 2 && lc($_[3]) ne 'master') {
		return 0;
	}
	else {
		return 1;
	}
}


sub compare_zones {

	my $i = my $c = 0;

	my @sp0 = my @sp1 = ();


	@sp0 = split(/\./, lc($_[0]));

	@sp1 = split(/\./, lc($_[1]));

	for ($i = 0; $i < @sp0 || $i < @sp1; $i++) {
		if ($sp0[$i] =~ /\D/o || $sp1[$i] =~ /\D/o) {
			$c = $sp0[$i] cmp $sp1[$i];

			return $c if ($c);
		}
		else {
			return -1 if ($sp0[$i] < $sp1[$i]);

			return 1 if ($sp0[$i] > $sp1[$i]);
		}
	}

	return 0;
}


1;