smeserver-lib/root/usr/share/perl5/vendor_perl/esmith/AccountsDB.pm

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