File Coverage

blib/lib/Unix/Conf/Bind8/Conf/Controls.pm

Criterion	Covered	Total	%
statement	36	99	36.3
branch	0	54	0.0
condition	0	7	0.0
subroutine	12	19	63.1
pod	6	6	100.0
total	54	185	29.1

# Bind8 package directive handling
#
# Copyright Karthik Krishnamurthy

=head1 NAME

Unix::Conf::Bind8::Conf::Controls - Class for handling Bind8 configuration
directive `controls'

=head1 SYNOPSIS

	use Unix::Conf::Bind8;

	my ($conf, $controls, $ret);
	$conf = Unix::Conf::Bind8->new_conf (
		FILE        => '/etc/named.conf',
		SECURE_OPEN => 1,
	) or $conf->die ("couldn't open `named.conf'");

	#
	# Ways to get a Controls object
	#

	$controls = Unix::Conf::Bind8::Conf->new_controls (
		UNIX	=> [ '/var/run/ndc', 0600, 0, 0 ],
		INET	=> [ '*', 52, [ qw (any) ], ],
	) or $controls->die ("couldn't create controls object");

	# or

	$controls = Unix::Conf::Bind8::Conf->get_controls ()
		or $controls->die ("couldn't get controls object");

	#
	# Operations that can be performed on an Controls object.
	#

	# set the various attributes.

	$ret = $controls->inet ('192.168.1.1', '1000', [ qw (localhost) ])
		or $ret->die ("couldn't set inet channel");

	$ret = $controls->unix ('/etc/namedb/control.pipe', 0600, 0, 0)
		or $ret->die ("couldn't set unix channel");

	# get the attributes

	$ret = $controls->inet () or $ret->die ("couldn't get inet channel");
	printf ("ADDRESS => %s, PORT => %s, ALLOW => %s\n", $ret->[0], $ret->[1],
		"@{$ret->[2]->elements ()});

	$ret = $controls->unix () or $ret->die ("couldn't get unix channel");
	printf ("PATH => %s, PERMS => %d, OWNER => %d, GROUP => %d",
		$ret->[0], $ret->[1], $ret->[2], $ret->[3]);

	# delete
	$ret = $controls->delete_inet () or $ret->die ("couldn't delete inet channel");
	$ret = $controls->delete_unix () or $ret->die ("couldn't delete unix channel");

=head1 METHODS

=cut

package Unix::Conf::Bind8::Conf::Controls;

use strict;
use warnings;
use Unix::Conf;
use Unix::Conf::Bind8::Conf::Directive;
our (@ISA) = qw (Unix::Conf::Bind8::Conf::Directive);

use Unix::Conf::Bind8::Conf::Lib;


use constant	I_ADDR	=> 0;
use constant	I_PORT	=> 1;
use constant	I_ALLOW	=> 2;

use constant	U_PATH	=> 0;
use constant	U_PERM	=> 1;
use constant	U_OWNER	=> 2;
use constant	U_GROUP	=> 3;

=item new ()

 Arguments
 UNIX	=> [ PATH, PERM, OWNER, GROUP ],
 INET	=> [ ADDR, PORT, ALLOW ]
 WHERE  => 'FIRST'|'LAST'|'BEFORE'|'AFTER'
 WARG   => Unix::Conf::Bind8::Conf::Directive subclass object
                  # WARG is to be provided only in case WHERE eq 'BEFORE
                  # or WHERE eq 'AFTER'
 PARENT	=> reference,
                  # to the Conf object datastructure.

Class constructor.
Creates a new Unix::Conf::Bind8::Conf::Controls object and returns it, on
success, an Err object otherwise. Do not use this constructor directly. Use
the Unix::Conf::Bind8::Conf::new_controls () method instead.

=cut

sub new
{
	shift ();
	my %args = @_;
	my $new = bless ({});
	my $ret;

	$args{PARENT} 	||	return (Unix::Conf->_err ('new', "PARENT not defined"));
	$ret = $new->_parent ($args{PARENT}) or return ($ret);
	$ret = $new->inet (@{$args{INET}}) or return ($ret)
		if ($args{INET});
	$ret = $new->unix (@{$args{UNIX}}) or return ($ret)
		if ($args{UNIX});
	$ret = Unix::Conf::Bind8::Conf::_add_controls ($new)
		or return ($ret);
	$args{WHERE} = 'LAST'	unless ($args{WHERE});
	$ret = Unix::Conf::Bind8::Conf::_insert_in_list ($new, $args{WHERE}, $args{WARG})
		or return ($ret);
	return ($new);
}


=item inet ()

 Arguments
 ADDRESS	# optional
 PORT		# optional
 ALLOW		# optional

Object method.
Argument `ALLOW' can either be an Acl object, or an array reference.
Get/sets the corresponding attribute, and returns either the attribute
values or true on success, an Err object otherwise. The attribute values
are returned as an anonymous array [ ADDRESS PORT ALLOW ], where ALLOW
is an Acl object.

=cut

sub inet
{
	my ($self, $addr, $port, $allow) = @_;
	my $acl;

	if ($addr) {
		return (Unix::Conf->_err ('inet', "illegal address `$addr'"))
			unless ($addr eq '*' || __valid_ipaddress ($addr));
		return (Unix::Conf->_err ('inet', "illegal port `$port'"))
			unless (__valid_port ($port));
		if (ref ($allow)) {
			if (UNIVERSAL::isa ($allow, 'ARRAY')) {
				$acl = Unix::Conf::Bind8::Conf::Acl->new (
					PARENT		=> $self->_parent (),
					ELEMENTS	=> $allow,
				) or return ($acl);
			}
			elsif (UNIVERSAL::isa ($allow, 'Unix::Conf::Bind8::Conf::Acl')) {
				$acl = $allow;
			}
			else {
				return (
					Unix::Conf->_err (
						'inet',
						"expected arguments are array reference or Unix::Conf::Bind8::Conf::Acl object"
					)
				);
			}
		}
		else {
			# assume a single element
			$acl = Unix::Conf::Bind8::Conf::Acl->new (
				PARENT		=> $self-_parent (),
				ELEMENTS	=> [ $allow ],
			) or return ($acl);
		}
		$self->{inet} = [ $addr, $port, $acl ];
		$self->dirty (1);
		return (1);
	}
	return (
		defined ($self->{inet}) ? [ @{$self->{inet}} ] :
			Unix::Conf->_err ('inet', "inet control channel not defined")
	);
}

=item inet_allow

Object method.
Returns the elements defined for the allow as an anonymous array.
if defined, an Err object otherwise.

=cut

sub inet_allow
{
	my $self = $_[0];

	return (
		defined ($self->{inet}) ? $self->{inet}[I_ALLOW]->elements () :
			Unix::Conf->_err ('inet_allow', "inet control channel not defined")
	);
}

=item unix ()

 Arguments
 PATH,
 'PERM',	# As string.
 OWNER,
 GROUP

Object method.
If arguments are passed, sets it as the value of the corresponding attribute,
returns true on success, an Err otherwise. If no arguments are passed, returns
the defined value as an anonymous array [ PATH, PERM, OWNER, GROUP ], if defined,
an Err object otherwise.

NOTE: The PERM argument is to be specified as a string, to avoid
unecessary complications. As this module does not interpret these values,
it makes sense to use a string, instead of octal.

=cut

sub unix
{
	my ($self, $path, $perm, $owner, $group) = @_;

	if ($path) {
		$path = qq("$path")	if ($path =~ /^[^"]/);
		return (Unix::Conf->_err ('unix', "perm `$perm' not a number"))
			unless ($perm =~ /^\d+$/);
		return (Unix::Conf->_err ('unix', "owner `$owner' not a number"))
			unless ($perm =~ /^\d+$/);
		return (Unix::Conf->_err ('unix', "group `$group' not a number"))
			unless ($perm =~ /^\d+$/);
		$self->{unix} = [ $path, $perm, $owner, $group ];
		$self->dirty (1);
		return (1);
	}
	return (
		defined ($self->{unix}) ? [ @{$self->{unix}} ] :
			Unix::Conf->_err ('unix', "unix control channel not defined")
	);
}

=item delete_inet ()

Object method.
Deletes the `inet' attribute, and returns true, if defined, an Err object
otherwise.

=cut

sub delete_inet
{
	my $self = $_[0];
	return (Unix::Conf->_err ('delete_inet', "inet control channel not defined"))
		unless (defined ($self->{inet}));
	delete ($self->{inet});
	$self->dirty (1);
	return (1);
}

=item delete_unix ()

Object method.
Deletes the `unix' attribute, and returns true, if defined, an Err object
otherwise.

=cut

sub delete_unix
{
	my $self = $_[0];
	return (Unix::Conf->_err ('delete_unix', "unix control channel not defined"))
		unless (defined ($self->{unix}));
	delete ($self->{unix});
	$self->dirty (1);
	return (1);
}

sub __render
{
	my $self = $_[0];
	my $tmp;

	my $rendered = "controls {\n";
	if ($tmp = $self->inet ()) {
		$rendered .= sprintf (
			"\tinet $tmp->[I_ADDR] port $tmp->[I_PORT] allow %s\n",
			${$tmp->[I_ALLOW]->_rstring (undef, 1)}
		);
	}
	if ($tmp = $self->unix ()) {
		$rendered .=
			"\tunix $tmp->[U_PATH] perm $tmp->[U_PERM] owner $tmp->[U_OWNER] group $tmp->[U_GROUP];\n"
	}
	$rendered .= "};";
	return ($self->_rstring (\$rendered));
}

1;