# $Id: GroupAdmin.pm,v 1.2 2003/01/16 19:41:31 lstein Exp $
package HTTPD::GroupAdmin;
use HTTPD::AdminBase ();
use strict;
use vars qw($VERSION @ISA $DLM);
@ISA = qw(HTTPD::AdminBase);
$DLM = " ";
$VERSION = 1.50;
sub delete {
my($self,$username,$group) = @_;
$group = $self->{NAME} unless defined $group;
return unless $self->{'_HASH'}->{$group};
$self->{'_HASH'}->{$group} =~ s/(^|$DLM)$username($DLM|$)/$1$2/;
}
sub list {
my($self, $group) = @_;
return keys %{$self->{'_HASH'}} unless $group;
return unless $self->{'_HASH'}{$group};
split /\s+/, $self->{'_HASH'}{$group};
}
sub create {
my($self,$group) = @_;
return unless $group;
return (0, "group '$group' exists") if $self->exists($group);
$self->{'_HASH'}{$group} = "";
1;
}
sub exists {
my($self, $name, $user) = @_;
return 0 unless defined $self->{'_HASH'}{$name};
return $self->{'_HASH'}{$name} unless $user;
return grep { $_ eq $user } $self->list($name);
}
sub db {
my($self, $file) = @_;
my $old = $self->{'DB'};
return $old unless $file;
if($self->{'_HASH'}) {
$self->DESTROY;
}
$self->{'DB'} = $file;
#return unless $self->{NAME};
$self->lock || Carp::croak();
$self->_tie('_HASH', $self->{DB});
$old;
}
sub user {
my($self) = shift;
$self->load('HTTPD::UserAdmin');
my %attr = %{$self};
delete $attr{DB}; #just incase, everything else should be OK
return new HTTPD::UserAdmin (%attr, @_);
}
sub name { shift->_elem('NAME', @_) }
#These should work fine with the _generic classes
my %Support = (apache => [qw(Text SQL)],
ncsa => [qw(DBM Text)],
netscape => [qw(DBM)]
);
HTTPD::GroupAdmin->support(%Support);
1;
__END__
=head1 NAME
HTTPD::GroupAdmin - Management of HTTP server group databases
=head1 SYNOPSIS
use HTTPD::GroupAdmin ();
=head1 DESCRIPTION
This software is meant to provide a generic interface that
hides the inconsistencies across HTTP server implementations
of user and group databases.
=head1 METHODS
=over 4
=item new ()
Here's where we find out what's different about your server.
Some examples:
@DBM = (DBType => 'DBM',
DB => '.htgroup',
Server => 'apache');
$group = new HTTPD::GroupAdmin @DBM;
This creates an object whose database is a DBM file named '.htgroup',
in a format that the Apache server understands.
@Text = (DBType => 'Text',
DB => '.htgroup',
Server => 'ncsa');
$group = new HTTPD::GroupAdmin @Text;
This creates an object whose database is a plain text file named
'.htgroup', in a format that the NCSA server understands.
Full list of constructor attributes:
Note: Attribute names are case-insensitive
B<Name> - Group name
B<DBType> - The type of database, one of 'DBM', 'Text', or 'SQL' (Default is 'DBM')
B<DB> - The database name (Default is '.htpasswd' for DBM & Text databases)
B<Server> - HTTP server name (Default is the generic class, that works with NCSA, Apache and possibly others)
Note: run 'perl t/support.t matrix' to see what support is currently availible
B<Path> - Relative DB files are resolved to this value (Default is '.')
B<Locking> - Boolean, Lock Text and DBM files (Default is true)
B<Debug> - Boolean, Turn on debug mode
Specific to DBM files:
B<DBMF> - The DBM file implementation to use (Default is 'NDBM')
B<Flags> - The read, write and create flags.
There are four modes:
B<rwc> - the default, open for reading, writing and creating.
B<rw> - open for reading and writing.
B<r> - open for reading only.
B<w> - open for writing only.
B<Mode> - The file creation mode, defaults to '0644'
Specific to DBI:
We talk to an SQL server via Tim Bunce's DBI interface. For more info see:
http://www.hermetica.com/technologia/DBI/
B<Host> - Server hostname
B<Port> - Server port
B<User> - Database login name
B<Auth> - Database login password
B<Driver> - Driver for DBI (Default is 'mSQL')
B<GroupTable> - Table with field names below
B<NameField> - Field for the name (Default is 'user')
B<GroupField> - Field for the group (Default is 'group')
From here on out, things should look the same for everyone.
=item add($username[,$groupname])
Add user $username to group $groupname, or whatever the 'Name' attribute is set to.
Fails if $username exists in the database
if($group->add('dougm', 'www-group')) {
print "Welcome!\n";
}
=item delete($username[,$groupname])
Delete user $username from group $groupname, or whatever the 'Name' attribute is set to.
if($group->delete('dougm')) {
print "He's gone from the group\n";
}
=item exists($groupname, [$username])
True if $groupname is found in the database
if($group->exists('web-heads')) {
die "oh no!";
}
if($group->exists($groupname, $username) {
#$username is a member of $groupname
}
=item list([$groupname])
Returns a list of group names, or users in a group if '$name' is present.
@groups = $group->list;
@users = $group->list('web-heads');
=item user()
Short cut for creating an HTTPD::UserAdmin object.
All applicable attributes are inherited, but can be
overridden.
$user = $group->user();
(See HTTPD::UserAdmin)
=item convert(@Attributes)
Convert a database.
#not yet
=item remove($groupname)
Remove group $groupname from the database
=item name($groupname)
Change the value of 'Name' attribute.
$group->name('bew-ediw-dlrow');
=item debug($boolean)
Turn debugging on or off
=item lock([$timeout])
=item unlock()
These methods give you control of the locking mechanism.
$group = new HTTPD::GroupAdmin (Locking => 0); #turn off auto-locking
$group->lock; #lock the object's database
$group->add($username,$passwd); #write while database is locked
$group->unlock; release the lock
=item db($dbname);
Select a different database.
$olddb = $group->db($newdb);
print "Now we're reading and writing '$newdb', done with '$olddb'n\";
=item flags([$flags])
Get or set read, write, create flags.
=item commit
Commit changes to disk (for Text files).
=back
=head1 SEE ALSO
HTTPD::UserAdmin(3)
=head1 AUTHOR
Doug MacEachern <dougm@osf.org>
Copyright (c) 1996, 1997 Doug MacEachern
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
=cut