e-smith-lib/root/usr/share/perl5/vendor_perl/esmith/ConfigDB.pm

399 lines
10 KiB
Perl

#----------------------------------------------------------------------
# Copyright 1999-2003 Mitel Networks Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
package esmith::ConfigDB;
use strict;
use warnings;
use vars qw( $AUTOLOAD @ISA );
use esmith::DB::db;
@ISA = qw( esmith::DB::db );
use esmith::ConfigDB::Record;
=head1 NAME
esmith::ConfigDB - interface to esmith configuration database
=head1 SYNOPSIS
use esmith::ConfigDB;
my $db = esmith::ConfigDB->open;
my $db = esmith::ConfigDB->open_ro;
my @services = $db->services();
# Singleton Records
my $record = $db->get($key);
my $value = $record->value;
$record->set_value($value);
# BAD!
my $value = $db->get($key)->value() # Throws a runtime error if $key
# doesn't exist
$value = $db->get($key)->prop($p) # Throws a runtime error if $key
# doesn't exist
# GOOD
my $record = $db->get($key);
my $value;
if ($record)
{
$value = $record->prop($prop);
}
# Typed Records (eventually they all will be)
my $prop = $record->prop($p);
$record->set_prop($prop, $propvalue);
my $value = $db->get_value($key) # Returns undef if record doesn't exist
$value = $db->get_prop($key, $p) # Returns undef if record doesn't exist
=head1 DESCRIPTION
This module provides an abstracted interface to the esmith master
configuration database.
Unless otherwise noted, esmith::ConfigDB acts like esmith::DB::db.
=cut
our $VERSION = sprintf '%d.%03d', q$Revision: 1.29 $ =~ /: (\d+).(\d+)/;
=head2 open()
Like esmith::DB->open, but if given no $file it will try to open the
file in the ESMITH_CONFIG_DB environment variable or configuration.
=begin testing
use esmith::TestUtils qw(scratch_copy);
use_ok("esmith::ConfigDB");
my $scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf');
$C = esmith::ConfigDB->open($scratch_copy_of_conf);
isa_ok($C, 'esmith::ConfigDB');
is( $C->get("AccessType")->prop('type'), "dedicated",
"We can get stuff from the db");
is( $C->get_prop("AccessType",'type'), "dedicated",
"We can get_prop stuff from the db");
is( $C->get_value("AccessType"), "dedicated",
"We can get_value stuff from the db");
is( $C->get_value("NoSuchKey"), undef,
"We can get_value non-existant keys");
is( $C->get_prop("diald","status"), "disabled",
"We can get_prop stuff from the db");
is( $C->get_prop("NoSuchKey","NoSuchProp"), undef,
"We can get_prop non-existant keys");
is( $C->get_prop("diald","NoSuchProp"), undef,
"We can get_prop non-existant props");
=end testing
=cut
sub open
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_CONFIG_DB} || "configuration";
return $class->SUPER::open($file);
}
=head2 open_ro()
Like esmith::DB->open_ro, but if given no $file it will try to open the
file in the ESMITH_CONFIG_DB environment variable or configuration.
=begin testing
=end testing
=cut
sub open_ro
{
my ( $class, $file ) = @_;
$file = $file || $ENV{ESMITH_CONFIG_DB} || "configuration";
return $class->SUPER::open_ro($file);
}
=head2 new_record()
This method creates a new record in the configuration database. As arguments,
it expects the key to the record, followed by a hash references with its
properties, including the type.
my $db = esmith::ConfigDB->open;
my $record = $db->new_record('zope', { type => 'service',
status => 'disabled' });
my %defaults = qw(
type => 'service',
status => 'disabled',
maintainer => 'admin@domain.com'
);
my $record = $db->get('zope');
unless ($record)
{
$record = $db->new_record('zope', \%defaults);
}
=head2 get()
Like their esmith::DB counterparts except they return
esmith::ConfigDB::Record objects which have a few extra methods.
my $record = $db->get('zope');
=begin testing
my $rec = eval { $C->get("I_dont_exist"); };
ok( !$rec, 'get() on a non-existent key' );
is( $@, '', ' doesnt blow up' );
isa_ok( $C->get("AccessType"), 'esmith::ConfigDB::Record',
"get()ened records are ConfigDB::Records" );
$rec = $C->new_record("I_dont_exist", { type => "foo" });
isa_ok( $rec, 'esmith::ConfigDB::Record',
"new_record()s are ConfigDB::Records" );
$rec->delete("I_dont_exist");
ok( !$C->get("I_dont_exist"), 'delete()' );
=end testing
=cut
sub get
{
my ($self) = shift;
my $rec = $self->SUPER::get(@_);
return $rec ? bless $rec, 'esmith::ConfigDB::Record' : undef;
}
sub new_record
{
my ($self) = shift;
my $rec = $self->SUPER::new_record(@_);
return $rec ? bless $rec, 'esmith::ConfigDB::Record' : undef;
}
=pod
=head2 getLocale()
Retrieves the locale and keyboard settings from the configuration database.
Returns ($lang, $kbdtype, $keytable) on success. Returns undef if the record
doesn't exist.
=cut
sub getLocale
{
my $self = shift;
my $rec = $self->get('sysconfig') or return undef;
my $lang = $rec->prop('Language') || 'en_US';
my $kbdtype = $rec->prop('KeyboardType') || 'pc';
my $keytable = $rec->prop('Keytable') || 'us';
return ( $lang, $kbdtype, $keytable );
}
=pod
=head2 hosts_allow_spec ($service [,$daemon])
Given a service, return the string suitable for /etc/hosts.allow,
checking to see if the service is defined, whether it is enabled and
whether access is set to public, private, or localhost.
An optional argument provides the tag which appears in hosts.allow. If not
given, the service name is used.
For example, one of the following:
# 'oidentd' is not defined in the configuration database
# 'oidentd' is disabled in the configuration database
in.identd: 127.0.0.1
in.identd: 127.0.0.1 192.168.1.1/255.255.255.0
in.identd: ALL
And here's the hosts.allow fragment:
{
$OUT = $DB->hosts_allow_spec('oidentd', 'in.identd');
}
=cut
sub hosts_allow_spec
{
my $self = shift;
my $service_name = shift;
my $daemon = shift || $service_name;
my $service = $self->get($service_name)
or return
"# '$service_name' is not defined in the configuration database";
my $status = $service->prop('status') || "disabled";
return "# '$service_name' is disabled in the configuration database"
unless ( $status eq "enabled" );
my $access = $service->prop('access') || "private";
use esmith::NetworksDB;
my $ndb = esmith::NetworksDB->open_ro;
my @spec = ( "$daemon:", $ndb->local_access_spec($access) );
return "@spec";
}
=pod
=head2 wins_server
Return the value of the WINS server from the config db
or undef if we don't have a WINS server set and we are
not the domain master
=cut
sub wins_server
{
my ($self) = @_;
my $wins_server = $self->get_prop( 'smb', 'WINSServer' );
return $wins_server if $wins_server;
my $server_role = $self->get_prop( 'smb', 'ServerRole' ) || 'WS';
return $self->get_prop( 'InternalInterface', 'IPAddress' )
if $server_role =~ m{^(PDC|ADS)$};
return undef;
}
=pod
=head2 services()
Returns a list of services in the configuration database
=for testing
foreach my $t (qw(services)) {
my @list = $C->$t();
ok(@list, "Got a list of $t");
}
=cut
sub AUTOLOAD
{
my $self = shift;
my ($called_sub_name) = ( $AUTOLOAD =~ m/([^:]*)$/ );
my @types = qw( services );
if ( grep /^$called_sub_name$/, @types )
{
$called_sub_name =~ s/s$//g; # de-pluralize
return $self->list_by_type($called_sub_name);
}
}
=pod
=head2 _loadDefaults ($forceReset)
Behaves just like the esmith::DB method of the same name. This is a private
method used internally.
=begin testing
$scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf', 'configuration.conf.scratch');
is ($scratch_copy_of_conf, 'configuration.conf.scratch', 'scratch copy name');
$ENV{'ESMITH_CONFIG_DB'} = $scratch_copy_of_conf;
$C = esmith::ConfigDB->open();
is ($C->{file}, $scratch_copy_of_conf, 'file name');
my $accesstype = $C->get("AccessType")->value;
ok($C->new_record('foobar', {type=>'service', status=>'disabled'}),
"Set up foobar record");
is($C->get('foobar')->prop('status'), "disabled", "foobar is disabled");
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
ok($C->_loadDefaults(), "Loaded defaults");
is($C->get('foobar')->prop('status'), 'enabled', "We forced status enabled");
is($C->get('bazbar')->prop('status'), 'enabled', "We included a new default");
is($C->get('AccessType')->value, $accesstype, "AccessType has not changed");
=end testing
=head2 record_has_defaults ($name)
Behaves just like the esmith::DB method of the same name.
=begin testing
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
is($C->record_has_defaults('foobar'), 1, "foobar has some defaults");
is($C->record_has_defaults('notthisone'), undef, "notthisone does not");
=end testing
=cut
# There would normally be a method here, but we inherit _loadDefaults
# from esmith::DB. The tests need to go here because the superclass is
# all virtual and testing requires concrete open/get/set methods.
=pod
=head2 migrate
Just like the esmith::DB method of the same name.
=begin testing
$scratch_copy_of_conf = scratch_copy('10e-smith-lib/configuration.conf', 'configuration.conf.scratch');
is ($scratch_copy_of_conf, 'configuration.conf.scratch', 'scratch copy name');
$ENV{'ESMITH_CONFIG_DB'} = $scratch_copy_of_conf;
$C = esmith::ConfigDB->open();
is($C->get('quux'), undef, "No quux here");
$ENV{'ESMITH_DB_DEFAULTSDIR'} = "10e-smith-lib/db";
ok($C->migrate(), "We can migrate");
my $quux = $C->get('quux');
ok($quux, "We got quux");
is($quux->prop('status'), 'enabled', "We migrated to quux");
$quux->delete;
=end testing
=cut
# There would normally be a method here, but we inherit migrate
# from esmith::DB. The tests need to go here because the superclass is
# all virtual and testing requires concrete open/get/set methods.
=head1 AUTHOR
SME Server Developers <bugs@e-smith.com>
=head1 SEE ALSO
L<esmith::DB>, L<esmith::DB::db>, L<esmith::AccountsDB>, L<esmith::DomainsDB>,
L<esmith::HostsDB>, L<esmith::NetworksDB>, L<esmith::ConfigDB::Record>
=cut
1;