records-lib.pl

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

			$err = `echo "$str" | $config{'nsupdate_cmd'} -d 2>&1`;

			&check_update_err($err) if ($?);
		}
	}
	else {
		$_[4] = $ttl;

		$lref = &read_file_lines($config{'chroot'} .
							&absolute_path($file));

		$lines = $old->{'eline'} - $old->{'line'} + 1;

		splice(@$lref, $old->{'line'}, $lines,
						&make_record(@_[3 .. $#_]));

		&flush_file_lines();
	}

	return;
}


#
# Delete a resource record.
#
# delete_record(zone, file, &old)
#

sub delete_record {

	my $dynamic_zone = my $lref = my $lines = my $v = 0;

	my $zone = my $file = my $old = my $str = my $err = my $values = '';


	$zone = $_[0];
	$file = $_[1];
	$old = $_[2];


	$dynamic_zone = &dynamic_zone($zone, 1);

	if ($dynamic_zone) {
		if ($dynamic_zone == 1) {
			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 .= "update delete $old->{'fqdn'} $old->{class} $old->{'type'} $values\n\n";

			$err = `echo "$str" | $config{'nsupdate_cmd'} -d 2>&1`;

			&check_update_err($err) if ($?);
		}
	}
	else {
		$lref = &read_file_lines($config{'chroot'} .
							&absolute_path($file));

		$lines = $old->{'eline'} - $old->{'line'} + 1;

		splice(@$lref, $old->{'line'}, $lines);

		&flush_file_lines();
	}

	return;
}


#
# Add a new $GENERATE line to some zone file.
#
# create_generator(file, range, lhs, type, rhs, [comment])
#

sub create_generator {

	my $lref = 0;


	$lref = &read_file_lines($config{'chroot'} . &absolute_path($_[0]));

	push(@$lref, join(' ', '$GENERATE', @_[1 .. $#_]));

	&flush_file_lines();

	return;
}


#
# Update an existing $GENERATE line in some zone file.
#
# modify_generator(file, &old, range, lhs, type, rhs, [comment])
#

sub modify_generator {

	my $lref = 0;


	$lref = &read_file_lines($config{'chroot'} . &absolute_path($_[0]));

	$lref->[$_[1]->{'line'}] = join(' ', '$GENERATE', @_[2 .. $#_]);

	&flush_file_lines();

	return;
}


#
# Delete a $GENERATE line in some zone file.
#
# delete_generator(file, &old)
#

sub delete_generator {

	my $lref = 0;


	$lref = &read_file_lines($config{'chroot'} . &absolute_path($_[0]));

	splice(@$lref, $_[1]->{'line'}, 1);

	&flush_file_lines();

	return;
}


#
# Return a string for some zone record.
#
# make_record(name, ttl, class, type, values, comment)
#

sub make_record {

	return $_[0] . ($_[1] ? "\t$_[1]" : '') . "\t$_[2]\t$_[3]\t$_[4]" .
	       ($_[5] ? "\t;$_[5]" : '');
}


#
# Increment the serial number in the SOA record. We must handle the case
# where the date-based format reaches 99, and future dates.
#
# bump_soa_record(zone, @records, future_serial)
#

sub bump_soa_record {

	my $vals = my $dynamic_zone = my $ttl = my $n = 0;
	my $serial = my $new_serial = 0;
	my $refresh = my $retry = my $expiry = my $neg_cache = 0;

	my $zone = my $values = my $zone_ref = my $today = my $date = '';
	my $serial_str = my $host = my $master = my $hostmaster = '';
	my $file = my $soa_ref = '';

	my $space = ' ';
	my $nltabs = "\n\t\t\t";


	$zone = $_[0];


	$zone_ref = &get_zone_data($zone);

	$dynamic_zone = $zone_ref->[1];


	if ($dynamic_zone) {
		if ($dynamic_zone == 2) {	    # This should have been
			&terror('recs_eupdate');    # checked already.
		}

		return unless ($config{'soa_date_style'});
	}
	else {
		return unless ($config{'updserial_on'});
	}


	#
	# Check that we can in fact update the serial number.
	#

	$new_serial = &check_soa_serial($zone_ref, $zone, $_[1], $soa_ref);

	if ($new_serial < 0) {
		&terror('soa_serial_noupdt', '');
	}


	#
	# At this point we have a new serial number. We must dig out the
	# relevant bits of information and then update the SOA record.
	#

	if ($dynamic_zone) {
		#
		# If we have already calculated the new future date serial
		# number for a dynamic zone, then use it. The one returned
		# above by check_soa_serial will be invalid - it will just
		# return '1'.
		#

		if (defined($_[2]) && $_[2] =~ /00$/o) {
			$new_serial = $_[2];
		}
		elsif ($new_serial == 1) {	# The update will already have
			return;			# happened, so just return.
		}

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

		if ($serial_str =~ /^(\S+)\s+(\d+)\s+IN\s+SOA\s+(\S+)\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/o) {
			$host = $1; $ttl = $2; $master = $3; $hostmaster = $4;
			$refresh = $6; $retry = $7; $expiry = $8;
			$neg_cache = $9;
		}
		else {
			&terror('soa_serial_invalid');
		}
	}
	else {
		return if ($new_serial == 1);	# SOA not to be updated.

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

		$host = $soa_ref->{'fqdn'};
		$ttl = ($soa_ref->{'ttl'} == 0) ? undef : $soa_ref->{'ttl'};

		$master = $soa_ref->{'values'}->[0];
		$hostmaster = $soa_ref->{'values'}->[1];
		$refresh = $soa_ref->{'values'}->[3];
		$retry = $soa_ref->{'values'}->[4];
		$expiry = $soa_ref->{'values'}->[5];
		$neg_cache = $soa_ref->{'values'}->[6];
	}

	$values = sprintf('%s %s %s%s%s%s%s%s%s%s%s%s%s', $master, $hostmaster,
			  ($dynamic_zone) ? ''     : "($nltabs", $new_serial,
			  ($dynamic_zone) ? $space : $nltabs, $refresh,
			  ($dynamic_zone) ? $space : $nltabs, $retry,
			  ($dynamic_zone) ? $space : $nltabs, $expiry,
			  ($dynamic_zone) ? $space : $nltabs, $neg_cache,
			  ($dynamic_zone) ? ''     : ')');


	#
	# Now we can update the SOA record.
	#

	&modify_record($zone, $file, $soa_ref, $host, $ttl, 'IN', 'SOA', $values);


	return;
}


#
# Return today's date in the format 'YYYYMMDD'.
#
# today()
#

sub today {

	my @tm = localtime(time());

	return sprintf('%4.4d%2.2d%2.2d', $tm[5] + 1900, $tm[4] + 1, $tm[3]);
}


#
# Get the zone defaults.
#
# get_zone_defaults(&array)
#

sub get_zone_defaults {

	unless (&read_file("$module_config_directory/zonedef", $_[0])) {
		$_[0]->{'refresh'} =  10800;   $_[0]->{'refunit'} = 'S';
		$_[0]->{'retry'}   =    900;   $_[0]->{'retunit'} = 'S';
		$_[0]->{'expiry'}  = 604800;   $_[0]->{'expunit'} = 'S';
		$_[0]->{'ncache'}  =   3600;   $_[0]->{'ncacheunit'} = 'S';

		$_[0]->{'defttl'}  =  86400;   $_[0]->{'defttlunit'} = 'S';
	}

	return;
}


#
# Convert a time value depending on whether a specific criteria is met
# or not. A two-entry array is returned - the first element contains the
# time value and the second the units.
#
# get_time(criteria, time_value)
#

sub get_time {

	my $value = my $time = my $unit = '';


	$value = $_[1];
	&trim($value);

	if ($_[0]) {			# Convert time to seconds.
		$time = &convert_time(0, $value);
		$unit = 'S' if ($time);
	}
	else {				# Convert time to abbreviated format.
		$time = &convert_time(1, $value);
	}

	if ($time =~ /^(\d+)([SMHDW])$/io) {
		$time = $1;
		$unit = $2;
	}

	return ($time, $unit);
}


#
# Check if the given file is valid for the zone file.
#
# allowed_zone_file(&access, file)
#

sub allowed_zone_file {

	my $len = 0;

	my $full_path = '';

	my $file = $_[1];


	return 0 if ($file =~ /\.\./o);

	$full_path = $config{'chroot'} . $file;

	if (-l $full_path) {
		$file = readlink($full_path);

		$file =~ s/^$config{'chroot'}//;

		return 0 unless (&allowed_zone_file($_[0], $file));
	}

	$len = length($_[0]->{'dir'});

	return (length($file) > $len) &&
	       (substr($file, 0, $len) eq $_[0]->{'dir'});
}


#
# Sort and return the zone records.
#
# sort_records(record_refs, ipv4_6_reverse_zone, origin)
#

sub sort_records {

	my $sort_order = my $sort_type = my $reverse = my $idx = 0;

	my $rtype = '';


	local $origin = pop @_;

	$reverse = pop @_;

	return @_ unless (@_);


	$rtype = $_[0]->{'type'};

	$sort_order = $in{'sort'} ? $in{'sort'} : $config{'records_order'};


	if ($sort_order < 0) {			# We are sorting a value.
		$sort_type = -1;

		$idx = abs(++$sort_order);

		if ($rtype eq 'MX') {
			$sort_type = ! $idx;
		}
		elsif ($rtype eq 'SRV') {
			$sort_type = ($idx == 3) ? 0 : 1;
		}
		elsif ($rtype eq 'KEY') {
			$sort_type = 1;
		}
		elsif ($rtype eq 'TXT' || $rtype eq 'HINFO' ||
		       $rtype eq 'WKS' || $rtype eq 'RP') {
			$sort_type = 0;
		}

		if ($sort_type == 0) {
			return sort { $a->{'values'}->[$idx] cmp $b->{'values'}->[$idx] } @_;
		}
		elsif ($sort_type == 1) {
			return sort { $a->{'values'}->[$idx] <=> $b->{'values'}->[$idx] } @_;
		}
	}
	elsif ($sort_order == 1) {		# Sort by record name.
		if ($reverse == 1) {		# It's an IPv4 reverse zone.
			return sort ptr_sort_func @_;
		}
		elsif ($reverse == 2) {		# It's an IPv6 reverse zone.
			return sort ptr6_sort_func @_;
		}
		else {
			return sort { $a->{'fqdn'} cmp $b->{'fqdn'} } @_;
		}
	}
	elsif ($sort_order == 2) {		# Sort by record value.
		if ($rtype eq 'A' || $rtype eq 'WKS') {
			return sort ip_sort_func @_;
		}
		elsif ($rtype eq 'AAAA') {
			return sort ip6_sort_func @_;
		}
		elsif ($reverse && ($rtype eq 'CNAME' || $rtype eq 'DNAME')) {
			if ($reverse == 1) {
				return sort ip_sort_func @_;
			}
			else {
				return sort ip6_sort_func @_;
			}
		}
		else {
			return sort { $a->{'values'}->[0] cmp $b->{'values'}->[0] } @_;
		}
	}
	elsif ($sort_order == 3) { # Sort by IP address or by value if no IP.
		if ($rtype eq 'A') {
			return sort ip_sort_func @_;
		}
		elsif ($rtype eq 'AAAA') {
			return sort ip6_sort_func @_;
		}
		elsif ($reverse) {
			if ($reverse == 1) {	# It's an IPv4 reverse zone.
				return sort ptr_sort_func @_;
			}
			else {			# It's an IPv6 reverse zone.
				return sort ptr6_sort_func @_;
			}
		}
		else {
			return sort { $a->{'values'}->[0] cmp $b->{'values'}->[0] } @_;
		}
	}
	elsif ($sort_order == 4) {		# Sort by record type.
			return sort { $a->{'type'} cmp $b->{'type'} } @_;
	}
	elsif ($sort_order == 5) {		# Sort by sub-domain name.
			return sort sd_sort_func @_;
	}


	return @_;
}


sub ptr_sort_func {

	my $a1 = my $a2 = my $a3 = my $a4 = 0;


	$a->{'fqdn'} =~ /^(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)\.)?(\d+)/o;

	($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);

	$b->{'fqdn'} =~ /^(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)\.)?(\d+)/o;

	return	$a4 < $4 ? -1 :
		$a4 > $4 ?  1 :
		$a3 < $3 ? -1 :
		$a3 > $3 ?  1 :
		$a2 < $2 ? -1 :
		$a2 > $2 ?  1 :
		$a1 < $1 ? -1 :
		$a1 > $1 ?  1 : 0;
}


sub ptr6_sort_func {

	my $i = 0;

	my $aip6 = my $bip6 = '';

	my @aip = my @bip = ();


	#
	# Because IPv6 reverse addresses can consist of up to 32 elements, and
	# each of these has to be compared to the next record and then repeated
	# for all the records, this can become a very expensive operation. To
	# try and speed things up we remove the origin since that may well
	# remove most of the elements.
	#

	$aip6 = $a->{'fqdn'};
	$aip6 =~ s/\.$origin$//;

	@aip = split(/\./, $aip6);

	$bip6 = $b->{'fqdn'};
	$bip6 =~ s/\.$origin$//;

	@bip = split(/\./, $bip6);


	for ($i = ($#aip > $#bip) ? $#aip : $#bip; $i >= 0; $i--) {
		if ($aip[$i] lt $bip[$i]) {
			return -1;
		}
		elsif ($aip[$i] gt $bip[$i]) {
			return 1;
		}
	}

	return 0;
}


sub ip_sort_func {

	my $a1 = my $a2 = my $a3 = my $a4 = 0;


	$a->{'values'}->[0] =~ /^(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)\.)?(\d+)/o;

	($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);

	$b->{'values'}->[0] =~ /^(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)\.)?(\d+)/o;

	return	$a1 < $1 ? -1 :
		$a1 > $1 ?  1 :
		$a2 < $2 ? -1 :
		$a2 > $2 ?  1 :
		$a3 < $3 ? -1 :
		$a3 > $3 ?  1 :
		$a4 < $4 ? -1 :
		$a4 > $4 ?  1 : 0;
}


sub ip6_sort_func {

	my $i = 0;

	my $aip6 = my $bip6 = '';

	my @aip = my @bip = ();


	#
	# Unfortunately with IPv6 addresses we must first transform any :: that
	# may be present. We also need to expand the address to include all the
	# relevant zeros, because a lexical comparison will not equate, for
	# example, 'fae' with '0fae'.
	#

	$aip6 = &expandall_ip6($a->{'values'}->[0]);

	$bip6 = &expandall_ip6($b->{'values'}->[0]);

	@aip = split(/:/, $aip6);

	@bip = split(/:/, $bip6);


	for ($i = 0; $i < 8; $i++) {
		if ($aip[$i] lt $bip[$i]) {
			return -1;
		}
		elsif ($aip[$i] gt $bip[$i]) {
			return 1;
		}
	}

	return 0;
}


sub sd_sort_func {

	my $a1 = my $b1 = '';


	$a1 = $a->{'fqdn'};
	$a1 =~ s/\.$origin$//;

	$a1 = join('.', (reverse(split(/\./, $a1))));


	$b1 = $b->{'fqdn'};
	$b1 =~ s/\.$origin$//;

	$b1 = join('.', (reverse(split(/\./, $b1))));


	return	$a1 cmp $b1;
}


#
# Convert an address like 4.3.2.1.in-addr.arpa. to 1.2.3.4
#
# arpa_to_ip(name)
#

sub arpa_to_ip {

	my $addr = $_[0];


	if ($addr =~ /^([*\d.]+)\.in-addr\.arpa\.?$/io) {
		$addr = join('.', reverse(split(/\./, $1)));
	}

	return $addr;
}


#
# Convert an IP address like 1.2.3.4 to 4.3.2.1.in-addr.arpa.
#
# ip_to_arpa(address)
#

sub ip_to_arpa {

	my $addr = $_[0];


	if ($addr =~ /^[*\d.]+$/o) {
		return join('.', reverse(split(/\./, $addr))) . '.in-addr.arpa.';