}	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;