541 lines
14 KiB
Perl
541 lines
14 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::AccountsDB;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use esmith::db;
|
||
|
|
|
||
|
|
use vars qw( $AUTOLOAD @ISA );
|
||
|
|
|
||
|
|
use esmith::DB::db;
|
||
|
|
@ISA = qw(esmith::DB::db);
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
esmith::AccountsDB - interface to esmith configuration database
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
use esmith::AccountsDB;
|
||
|
|
my $a = esmith::AccountsDB->open;
|
||
|
|
|
||
|
|
my @users = $a->users();
|
||
|
|
my @groups = $a->groups();
|
||
|
|
my @ibays = $a->ibays();
|
||
|
|
my @printers = $a->printers();
|
||
|
|
my @pseudonyms = $a->pseudonyms();
|
||
|
|
|
||
|
|
$a->is_user_in_group($user, $group);
|
||
|
|
my @groups = $a->user_group_list($user);
|
||
|
|
$a->add_user_to_groups($user, @groups);
|
||
|
|
$a->remove_user_from_groups($user, @groups);
|
||
|
|
|
||
|
|
$a->create_user_auto_pseudonyms($user);
|
||
|
|
$a->remove_user_auto_pseudonyms($user);
|
||
|
|
$a->remove_all_user_pseudonyms($user);
|
||
|
|
my $dp = $a->dot_pseudonym($user);
|
||
|
|
my $up = $a->underbar_pseudonym($user);
|
||
|
|
my $uid = $a->get_next_uid();
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
This module provides an abstracted interface to the esmith accounts
|
||
|
|
database.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
our $VERSION = sprintf '%d.%03d', q$Revision: 1.18 $ =~ /: (\d+).(\d+)/;
|
||
|
|
|
||
|
|
=head2 open()
|
||
|
|
|
||
|
|
Loads an existing account database and returns an esmith::AccountsDB
|
||
|
|
object representing it.
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
use esmith::TestUtils qw(scratch_copy);
|
||
|
|
|
||
|
|
use_ok("esmith::AccountsDB");
|
||
|
|
use esmith::db;
|
||
|
|
use vars qw($a);
|
||
|
|
|
||
|
|
my $conf = scratch_copy('10e-smith-lib/accounts.conf');
|
||
|
|
$a = esmith::AccountsDB->open($conf);
|
||
|
|
isa_ok($a, 'esmith::AccountsDB');
|
||
|
|
is( $a->get("global")->prop('type'), "system", "We can get stuff from the db");
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub open {
|
||
|
|
my($class, $file) = @_;
|
||
|
|
$file = $file || $ENV{ESMITH_ACCOUNT_DB} || "accounts";
|
||
|
|
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_ACCOUNT_DB environment variable or accounts.
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub open_ro {
|
||
|
|
my($class, $file) = @_;
|
||
|
|
$file = $file || $ENV{ESMITH_ACCOUNT_DB} || "accounts";
|
||
|
|
return $class->SUPER::open_ro($file);
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 users(), groups(), ibays(), printers(), pseudonyms()
|
||
|
|
|
||
|
|
Returns a list of records (esmith::DB::db::Record objects) of the
|
||
|
|
given type.
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
foreach my $t (qw(users groups pseudonyms)) {
|
||
|
|
my @list = $a->$t();
|
||
|
|
ok(@list, "Got a list of $t");
|
||
|
|
isa_ok($list[0], 'esmith::DB::db::Record');
|
||
|
|
}
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub AUTOLOAD {
|
||
|
|
my $self = shift;
|
||
|
|
my ($called_sub_name) = ($AUTOLOAD =~ m/([^:]*)$/);
|
||
|
|
my @types = qw( users groups ibays printers pseudonyms);
|
||
|
|
if (grep /^$called_sub_name$/, @types) {
|
||
|
|
$called_sub_name =~ s/s$//g; # de-pluralize
|
||
|
|
return $self->get_all_by_prop(type => $called_sub_name);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=head1 GROUP MANAGEMENT
|
||
|
|
|
||
|
|
=head2 $a->is_user_in_group($user, $group)
|
||
|
|
|
||
|
|
Returns true if the user is a member of the group, false otherwise. The
|
||
|
|
arguments are a user name and a group name.
|
||
|
|
|
||
|
|
This routine will return undef if there is no such group, false (but
|
||
|
|
defined) if the user is not in the group, and true if the user is in the
|
||
|
|
group.
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
ok($a->is_user_in_group('bart', 'simpsons'), "Bart is in group Simpsons");
|
||
|
|
ok(not($a->is_user_in_group('moe', 'simpsons')), "Moe is not in group Simpsons");
|
||
|
|
ok(not(defined $a->is_user_in_group('moe', 'flanders')), "No such group as Flanders");
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub is_user_in_group {
|
||
|
|
my ($self, $user, $group) = @_;
|
||
|
|
$group = $self->get($group) || return undef;
|
||
|
|
my $members = $group->prop('Members');
|
||
|
|
|
||
|
|
return grep(/^$user$/, split /,/, $members) ? 1 : 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->user_group_list($user)
|
||
|
|
|
||
|
|
Get a list of groups (by name) of which a user is a member. The $user argument
|
||
|
|
is simply the username.
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
my @groups = $a->user_group_list('bart');
|
||
|
|
is_deeply(\@groups, ['simpsons'], "Bart's group list is 'simpsons'");
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub user_group_list {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my @groups = $self->groups();
|
||
|
|
my @user_groups;
|
||
|
|
foreach my $g (@groups) {
|
||
|
|
push(@user_groups, $g->key())
|
||
|
|
if $self->is_user_in_group($user, $g->key());
|
||
|
|
}
|
||
|
|
return @user_groups;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->add_user_to_groups($user, @groups)
|
||
|
|
|
||
|
|
Given a list of groups (by name), adds the user to all of them.
|
||
|
|
|
||
|
|
Doesn't signal the group-modify event, just does the DB work.
|
||
|
|
|
||
|
|
Note: the method used here is a bit kludgy. It could result in a user
|
||
|
|
being in the same group twice.
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
my @groups = $a->groups();
|
||
|
|
$a->remove_user_from_groups('maggie', map { $_->key() } @groups);
|
||
|
|
my @mg = $a->user_group_list('maggie');
|
||
|
|
is(scalar @mg, 0, "Maggie has been removed from all groups");
|
||
|
|
$a->add_user_to_groups('maggie', 'simpsons');
|
||
|
|
@mg = $a->user_group_list('maggie');
|
||
|
|
is_deeply(\@mg, ['simpsons'], "Maggie has been added to group 'simpsons'");
|
||
|
|
$a->remove_user_from_groups('maggie', 'simpsons');
|
||
|
|
@mg = $a->user_group_list('maggie');
|
||
|
|
is_deeply(\@mg, [], "Maggie's been removed from all groups again");
|
||
|
|
$a->set_user_groups('maggie', 'simpsons');
|
||
|
|
@mg = $a->user_group_list('maggie');
|
||
|
|
is_deeply(\@mg, ['simpsons'], "Maggie's groups have been set to: 'simpsons'");
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub add_user_to_groups {
|
||
|
|
my ($self, $user, @groups) = @_;
|
||
|
|
GROUP: foreach my $group (@groups) {
|
||
|
|
unless (($group) = ($group =~ /(^[\w.-]+$)/))
|
||
|
|
{
|
||
|
|
warn "Group name doesn't look like a group!\n";
|
||
|
|
next GROUP;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $group_rec = $self->get($group) || next GROUP;
|
||
|
|
my @members = split(/,/, $group_rec->prop('Members'));
|
||
|
|
push @members, $user;
|
||
|
|
# Remove duplicates
|
||
|
|
my %members = map { $_ => 1 } @members;
|
||
|
|
$group_rec->set_prop('Members', join(',', sort keys %members));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->remove_user_from_groups($user, @groups)
|
||
|
|
|
||
|
|
Given a list of groups, removes a user from all of them.
|
||
|
|
Doesn't signal the group-modify event, just does the DB work.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub remove_user_from_groups {
|
||
|
|
my ($self, $user, @groups) = @_;
|
||
|
|
|
||
|
|
GROUP: foreach my $g (@groups) {
|
||
|
|
my $group_rec = $self->get($g) || next GROUP;
|
||
|
|
my $members = $group_rec->prop('Members');
|
||
|
|
my @members = split (/,/, $members);
|
||
|
|
@members = grep (!/^$user$/, @members);
|
||
|
|
@members = qw(admin) unless @members; # admin *must* be in every group
|
||
|
|
$group_rec->set_prop('Members', join(',', @members));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->set_user_groups($user, @groups)
|
||
|
|
|
||
|
|
Sets the user's groups in one fell swoop. Under the hood, it's removing
|
||
|
|
the user from every group they're in then adding them to the set you give.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub set_user_groups
|
||
|
|
{
|
||
|
|
my ($self, $user, @groups) = @_;
|
||
|
|
my @old_groups = $self->user_groups_list($user);
|
||
|
|
$self->remove_user_from_groups($user, @old_groups);
|
||
|
|
$self->add_user_to_groups($user, @groups);
|
||
|
|
}
|
||
|
|
|
||
|
|
=head1 PSEUDONYM MANAGEMENT
|
||
|
|
|
||
|
|
=head2 $a->create_user_auto_pseudonyms($user)
|
||
|
|
|
||
|
|
Given a user name, creates standard pseudonyms ("dot" and "underbar" style)
|
||
|
|
for that user.
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
my $user = 'bart';
|
||
|
|
ok($a->pseudonyms(), "There are pseudonyms in the accounts db");
|
||
|
|
$a->remove_user_auto_pseudonyms($user);
|
||
|
|
ok(! $a->get('bart.simpson'), "Removed dot-pseudonym");
|
||
|
|
ok(! $a->get('bart_simpson'), "Removed underbar-pseudonym");
|
||
|
|
$a->create_user_auto_pseudonyms($user);
|
||
|
|
ok($a->get('bart.simpson'), "Created dot-pseudonym");
|
||
|
|
ok($a->get('bart_simpson'), "Created underbar-pseudonym");
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub create_user_auto_pseudonyms {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my $user_rec = $self->get($user);
|
||
|
|
my $firstName = $user_rec->prop("FirstName");
|
||
|
|
my $lastName = $user_rec->prop("LastName");
|
||
|
|
|
||
|
|
my $dot_pseudonym = dot_pseudonym($self, $user);
|
||
|
|
my $underbar_pseudonym = underbar_pseudonym($self, $user);
|
||
|
|
|
||
|
|
my $dot_acct = $self->get($dot_pseudonym) ||
|
||
|
|
$self->new_record($dot_pseudonym, { type => 'pseudonym',
|
||
|
|
Account => $user} );
|
||
|
|
|
||
|
|
my $underbar_acct = $self->get($underbar_pseudonym) ||
|
||
|
|
$self->new_record($underbar_pseudonym, { type => 'pseudonym',
|
||
|
|
Account => $user} );
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
=head2 $a->remove_all_user_pseudonyms($user)
|
||
|
|
|
||
|
|
Given a username, remove any pseudonyms related to that user from the
|
||
|
|
accounts database. Also removes any pseudonyms related to a pseudonym
|
||
|
|
being removed. Returns the number of pseudonym records deleted.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub remove_all_user_pseudonyms {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my $count = 0;
|
||
|
|
foreach my $p_rec (grep { $_->prop("Account") eq $user } $self->pseudonyms())
|
||
|
|
{
|
||
|
|
foreach my $p_p_rec (grep { $_->prop("Account") eq $p_rec->key } $self->pseudonyms())
|
||
|
|
{
|
||
|
|
$p_p_rec->delete;
|
||
|
|
$count++;
|
||
|
|
}
|
||
|
|
$p_rec->delete;
|
||
|
|
$count++;
|
||
|
|
}
|
||
|
|
return $count;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->remove_user_auto_pseudonyms($user)
|
||
|
|
|
||
|
|
Given a username, remove the dot_pseudonym and underbar_pseudonym
|
||
|
|
related to that user from the accounts database. Returns the number
|
||
|
|
of pseudonym records deleted.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub remove_user_auto_pseudonyms {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my $dot_pseudonym = dot_pseudonym($self, $user);
|
||
|
|
my $underbar_pseudonym = underbar_pseudonym($self, $user);
|
||
|
|
my $count = 0;
|
||
|
|
foreach my $p_rec ($self->get($dot_pseudonym),
|
||
|
|
$self->get($underbar_pseudonym))
|
||
|
|
{
|
||
|
|
if (defined $p_rec && $p_rec->prop("type") eq "pseudonym" &&
|
||
|
|
$p_rec->prop("Account") eq $user)
|
||
|
|
{
|
||
|
|
$p_rec->delete;
|
||
|
|
$count++;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return $count;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->dot_pseudonym($user)
|
||
|
|
|
||
|
|
Returns the "dot"-style pseudonym for a user as a string. For instance,
|
||
|
|
dot_pseudonym("bart") might return "bart.simpson".
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub dot_pseudonym {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my $user_rec = $self->get($user);
|
||
|
|
my $firstName = $user_rec->prop("FirstName");
|
||
|
|
my $lastName = $user_rec->prop("LastName");
|
||
|
|
|
||
|
|
my $dot_pseudonym = lc("$firstName $lastName");
|
||
|
|
|
||
|
|
$dot_pseudonym =~ s/^\s+//; # Strip leading whitespace
|
||
|
|
$dot_pseudonym =~ s/\s+$//; # Strip trailing whitespace
|
||
|
|
$dot_pseudonym =~ s/\s+/ /g; # Multiple spaces become single spaces
|
||
|
|
$dot_pseudonym =~ s/\s/./g; # Change all spaces to dots
|
||
|
|
return $dot_pseudonym;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->underbar_pseudonym($user)
|
||
|
|
|
||
|
|
Returns the "underbar"-style pseudonym for a user as a string. For instance,
|
||
|
|
underbar_pseudonym("bart") might return "bart_simpson".
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
my @users = $a->users();
|
||
|
|
my $user = 'bart';
|
||
|
|
my $rec = $a->get($user);
|
||
|
|
my $firstName = $rec->prop("FirstName");
|
||
|
|
my $lastName = $rec->prop("LastName");
|
||
|
|
my $up = $a->underbar_pseudonym($user);
|
||
|
|
is($up, "bart_simpson", "Underbar pseudonym created correctly");
|
||
|
|
my $dp = $a->dot_pseudonym($user);
|
||
|
|
is($dp, "bart.simpson", "Underbar pseudonym created correctly");
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub underbar_pseudonym {
|
||
|
|
my ($self, $user) = @_;
|
||
|
|
my $user_rec = $self->get($user);
|
||
|
|
my $firstName = $user_rec->prop("FirstName");
|
||
|
|
my $lastName = $user_rec->prop("LastName");
|
||
|
|
|
||
|
|
my $underbar_pseudonym = lc("$firstName $lastName");
|
||
|
|
|
||
|
|
$underbar_pseudonym =~ s/^\s+//; # Strip leading whitespace
|
||
|
|
$underbar_pseudonym =~ s/\s+$//; # Strip trailing whitespace
|
||
|
|
$underbar_pseudonym =~ s/\s+/ /g; # Multiple spaces become single spaces
|
||
|
|
$underbar_pseudonym =~ s/\s/_/g; # Change all spaces to underbars
|
||
|
|
return $underbar_pseudonym;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 $a->activeUsers()
|
||
|
|
|
||
|
|
Returns the number of active users, ie, accounts which have passwords set and
|
||
|
|
are of type 'user'.
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
my $numActiveUsers = scalar $a->activeUsers();
|
||
|
|
like($numActiveUsers, qr/[0-9]+/, "active users returns a number");
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub activeUsers()
|
||
|
|
{
|
||
|
|
my $self = shift;
|
||
|
|
my @users = $self->users();
|
||
|
|
|
||
|
|
return unless @users;
|
||
|
|
return grep { $_->prop("PasswordSet") eq 'yes' } @users;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head2 get_next_uid
|
||
|
|
|
||
|
|
Returns the next available UID from /etc/passwd. All UIDs are above the range
|
||
|
|
reserved for 'system' accounts (currently 5000).
|
||
|
|
|
||
|
|
=for testing
|
||
|
|
SKIP: {
|
||
|
|
skip "Must be root to run get_next_uid" if $<;
|
||
|
|
my $u = $a->get_next_uid();
|
||
|
|
ok($u > 5000, "UID should be greater than 5000");
|
||
|
|
ok(! getpwuid($u), "UID should not yet exist");
|
||
|
|
}
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub get_next_uid {
|
||
|
|
use esmith::ConfigDB;
|
||
|
|
|
||
|
|
my $id;
|
||
|
|
my $db = esmith::ConfigDB->open || die "Couldn't open config db";
|
||
|
|
|
||
|
|
if ($id = $db->get('MinUid'))
|
||
|
|
{
|
||
|
|
$id = $id->value();
|
||
|
|
}
|
||
|
|
else
|
||
|
|
{
|
||
|
|
$db->new_record('MinUid');
|
||
|
|
$id = 5000;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $maxid = 1 << 31;
|
||
|
|
setpwent();
|
||
|
|
setgrent();
|
||
|
|
while (getpwuid $id || getgrgid $id)
|
||
|
|
{
|
||
|
|
die "All userids in use" if ($id == $maxid);
|
||
|
|
$id++;
|
||
|
|
}
|
||
|
|
endpwent();
|
||
|
|
endgrent();
|
||
|
|
|
||
|
|
$db->set_value('MinUid', $id + 1);
|
||
|
|
|
||
|
|
return $id;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
=head2 new_record ($key, \%props)
|
||
|
|
|
||
|
|
This method is overridden from esmith::DB::db. We do an additional check
|
||
|
|
for implicit accounts here - accounts that exist in /etc/passwd but not
|
||
|
|
in the db. Otherwise it behaves just like the superclass method.
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
isnt($a->new_record("root", {type=>'system'}), "OK",
|
||
|
|
"can't create existing account");
|
||
|
|
is($a->get("nobody"), undef, "nobody doesn't exist in db");
|
||
|
|
isnt($a->new_record("nobody", {type=>'system'}), "OK",
|
||
|
|
"can't create account in /etc/passwd");
|
||
|
|
isnt($a->new_record("screwy", {type=>'user'}), undef,
|
||
|
|
"created a regular user");
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub new_record
|
||
|
|
{
|
||
|
|
my ($self, $key, $props) = @_;
|
||
|
|
|
||
|
|
if(getpwnam($key) || getgrnam($key))
|
||
|
|
{
|
||
|
|
warn "Attempt to create account '$key' which already exists ",
|
||
|
|
"in passwd";
|
||
|
|
return undef;
|
||
|
|
}
|
||
|
|
return $self->SUPER::new_record($key, $props);
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
=head2 validate_account_name ($name)
|
||
|
|
|
||
|
|
Check $name to see if it is a valid account name. Valid account names
|
||
|
|
start with a letter or number and contain only letters, numbers,
|
||
|
|
underscores, dots and dashes.
|
||
|
|
|
||
|
|
=begin testing
|
||
|
|
|
||
|
|
is($a->validate_account_name("root"), "OK", "root is a valid name");
|
||
|
|
is($a->validate_account_name("fred.frog"), "OK", "fred.frog is a valid name");
|
||
|
|
is($a->validate_account_name("jane_doe"), "OK", "jane_doe is a valid name");
|
||
|
|
isnt($a->validate_account_name("^root"), "OK", "^root is not a valid name");
|
||
|
|
is(esmith::AccountsDB::validate_account_name("root"), "OK", "called as a function");
|
||
|
|
|
||
|
|
=end testing
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub validate_account_name
|
||
|
|
{
|
||
|
|
my $self;
|
||
|
|
# Were we called as a method or a function?
|
||
|
|
if($#_ > 0)
|
||
|
|
{
|
||
|
|
$self = shift;
|
||
|
|
}
|
||
|
|
my $name = shift;
|
||
|
|
return ($name =~ /[^0-9a-z\-_\.]/ or $name !~ /^[a-z]/) ? undef : 'OK';
|
||
|
|
}
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
SME Server Developers <bugs@e-smith.com>
|
||
|
|
|
||
|
|
See http://www.e-smith.org/ for more information
|
||
|
|
|
||
|
|
|
||
|
|
|