Authen-Users
view release on metacpan or search on metacpan
lib/Authen/Users.pm view on Meta::CPAN
. "user $self->{dbuser} and given password and $self->{sqlparams}: "
. DBI->errstr;
}
else {
# SQLite is the default
$self->{dsn} = "dbi:SQLite:dbname=$self->{dbname}";
$self->{dbh} = DBI->connect( $self->{dsn}, $self->{sqlparams} )
or croak "Can't connect to SQLite database as $self->{dsn} with "
. "$self->{sqlparams}: "
. DBI->errstr;
}
# check if table exists
my $sth_tab = $self->{dbh}->table_info();
my $need_table = 1;
while ( my $tbl = $sth_tab->fetchrow_hashref ) {
$need_table = 0 if $tbl->{TABLE_NAME} eq $self->{authentication};
}
if ($need_table) {
unless ( $self->{create} ) {
croak
"No table in database, and create not specified for new Authen::Users";
}
# try to create the table
my $ok_create = $self->{dbh}->do(<<ST_H);
CREATE TABLE $self->{authentication}
( groop VARCHAR(15), user VARCHAR(30), password VARCHAR(60),
fullname VARCHAR(40), email VARCHAR(40), question VARCHAR(120),
answer VARCHAR(80), created VARCHAR(12), modified VARCHAR(12),
pw_timestamp VARCHAR(12), salt VARCHAR(10), gukey VARCHAR (46) UNIQUE )
ST_H
carp("Could not make table") unless $ok_create;
}
return $self;
}
sub authenticate {
my ( $self, $group, $user, $password ) = @_;
my $password_sth = $self->{dbh}->prepare(<<ST_H);
SELECT password, salt FROM $self->{authentication} WHERE groop = ? AND user = ?
ST_H
$password_sth->execute( $group, $user );
my $row = $password_sth->fetchrow_arrayref;
if ($row) {
my $stored_pw_digest = $row->[0];
my $salt = $row->[1];
my $user_pw_digest = ($salt)
? $self->{sha}->($password, $salt)
: $self->{sha}->($password);
return 1 if $user_pw_digest eq $stored_pw_digest;
}
return;
}
sub add_user {
my ( $self, $group, $user, $password, $fullname, $email, $question,
$answer ) = @_;
$self->validate( $group, $user, $password ) or return;
$self->not_in_table( $group, $user ) or return;
my $r;
my $salt = 0;
if($self->{make_salt}) {
$salt = $self->{sha}->( time + rand(10000) );
$salt = substr( $salt, -8 );
my $password_sha = $self->{sha}->($password, $salt);
my $insert_sth = $self->{dbh}->prepare(<<ST_H);
INSERT INTO $self->{authentication}
(groop, user, password, fullname, email, question, answer,
created, modified, pw_timestamp, salt, gukey)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
ST_H
my $t = time;
$r = $insert_sth->execute( $group, $user, $password_sha,
$fullname, $email, $question, $answer, $t, $t, $t, $salt,
_g_u_key( $group, $user ) );
}
else {
my $password_sha = $self->{sha}->($password);
my $insert_sth = $self->{dbh}->prepare(<<ST_H);
INSERT INTO $self->{authentication}
(groop, user, password, fullname, email, question, answer,
created, modified, pw_timestamp, gukey)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
ST_H
my $t = time;
$r = $insert_sth->execute( $group, $user, $password_sha,
$fullname, $email, $question, $answer, $t, $t, $t,
_g_u_key( $group, $user ) );
}
return 1 if $r and $r == 1;
$self->{_error} = $self->{dbh}->errstr;
return;
}
sub user_add { shift->add_user(@_) }
sub update_user_all {
my ( $self, $group, $user, $password, $fullname, $email, $question,
$answer ) = @_;
$self->validate( $group, $user, $password ) or return;
my $salt = 0;
if($self->{make_salt}) {
$salt = $self->{sha}->( time + rand(10000) );
$salt = substr( $salt, -8 );
my $password_sha = $self->{sha}->($password, $salt);
my $update_all_sth = $self->{dbh}->prepare(<<ST_H);
UPDATE $self->{authentication} SET password = ?, fullname = ?, email = ?,
question = ?, answer = ? , modified = ?, pw_timestamp = ?, salt = ?, gukey = ?
WHERE groop = ? AND user = ?
ST_H
my $t = time;
return 1
if $update_all_sth->execute(
$password_sha, $fullname, $email, $question, $answer,
$t, $t, $salt, _g_u_key( $group, $user ), $group, $user
);
}
else {
my $password_sha = $self->{sha}->{password};
lib/Authen/Users.pm view on Meta::CPAN
}
sub get_user_fullname {
my ( $self, $group, $user ) = @_;
my $row = $self->user_info( $group, $user );
return $row->[3] if $row;
return;
}
sub get_user_email {
my ( $self, $group, $user ) = @_;
my $row = $self->user_info( $group, $user );
return $row->[4] if $row;
return;
}
sub get_user_question_answer {
my ( $self, $group, $user ) = @_;
my $row = $self->user_info( $group, $user );
return ( $row->[5], $row->[6] ) if $row;
return;
}
sub get_password_change_time {
my ( $self, $group, $user ) = @_;
my $row = $self->user_info( $group, $user );
return $row->[9] if $row;
return;
}
sub errstr {
my $self = shift;
return $self->{dbh}->errstr;
}
sub error {
my $self = shift;
return $self->{_error} || $self->{dbh}->errstr;
}
# validation routine for adding users, etc.
sub validate {
my ( $self, $group, $user, $password ) = @_;
unless ($group) {
$self->{_error} = "Group is not defined.";
return;
}
unless ($user) {
$self->{_error} = "Username is not defined.";
return;
}
unless ($password) {
$self->{_error} = "Password is not defined.";
return;
}
return 1;
}
# assistance functions
sub not_in_table {
my ( $self, $group, $user ) = @_;
my $unique_sth = $self->{dbh}->prepare(<<ST_H);
SELECT password FROM $self->{authentication} WHERE gukey = ?
ST_H
$unique_sth->execute( _g_u_key( $group, $user ) );
my @row = $unique_sth->fetchrow_array;
return if @row;
return 1;
}
sub is_in_table {
my ( $self, $group, $user ) = @_;
return if $self->not_in_table( $group, $user );
return 1;
}
#end of public interface
# internal use--not for object use (no $self argument)
sub _g_u_key {
my ( $group, $user ) = @_;
return $group . '|' . $user;
}
=head1 NAME
Authen::Users - DBI Based User Authentication
=head1 DESCRIPTION
General password authentication using DBI-capable databases. Currently supports
MySQL and SQLite databases. The default is to use a SQLite database to store
and access user information.
This module is not an authentication protocol. For that see something such as
Authen::AuthenDBI.
=head1 RATIONALE
After several web sites were written which required ongoing DBI or .htpassword
file tweaking for user authentication, it seemed we needed a default user
password database that would contain not only the user name and password but
also such things as the information needed to reset lost passwords.
Thus, this module, designed to be as much as possible a drop-in for your
website authorization scripting needs.
=head1 SYNOPSIS
use Authen::Users;
my $authen = new Athen::Users(dbtype => 'SQLite', dbname => 'mydbname');
// for backward compatibility use the call below:
my $authen = new Athen::Users(
dbtype => 'SQLite', dbname => 'mydbname', NO_SALT => 1 );
my $a_ok = $authen->authenticate($group, $user, $password);
my $result = $authen->add_user(
$group, $user, $password, $fullname, $email, $question, $answer);
=head1 METHODS
=over 4
=item B<new>
Create a new Authen::Users object.
my $authen = new Authen::Users(dbname => 'Authentication');
=over 4
lib/Authen/Users.pm view on Meta::CPAN
=item B<get_group_members>
$authen->get_group_members($group) or die "Cannot retrieve list of group $group: $authen->errstr";
Return a reference to a list of the user members of group $group.
=item B<user_info>
$authen->user_info($group, $user) or die "Cannot retrieve information about $user in group $group: $authen->errstr";
Return a reference to a list of the information about $user in $group.
=item B<user_info_hashref>
my $href = $authen->user_info_hashref($group, $user) or die "Cannot retrieve information about $user in group $group: $authen->errstr";
print "The email for $user in $group is $href->{email}";
Return a reference to a hash of the information about $user in $group, with the field
names as keys of the hash.
=item B<get_user_fullname>
$authen->get_user_fullname($group, $user) or die "Cannot retrieve full name of $user in group $group: $authen->errstr";
Return the user full name entry.
=item B<get_user_email>
$authen->get_user_email($group, $user) or die "Cannot retrieve email of $user in group $group: $authen->errstr";
Return the user email entry.
=item B<get_user_question_answer>
$authen->get_user_question_answer($group, $user) or die "Cannot retrieve question and answer for $user in group $group: $authen->errstr";
Return the user question and answer entries.
=item B<get_password_change_time>
$authen->get_password_change_time($group, $user)
or die "Cannot retrieve password timestamp for $user in group $group: $authen->errstr";
There is a timestamp associated with changes in passwords. This may be used to
expire passwords that need to be periodically changed. The logic used to do
password expiration, if any, is up to the code using the module.
=item B<errstr>
print $auth->errstr();
Returns the last database error, if any.
=item B<error>
print $auth->error;
Returns the last class internal error message, if any; if none, returns the
last database DBI error, if any.
=item B<not_in_table>
$auth->not_in_table($group, $user);
True if $user in group $group is NOT already an entry.
Useful to rule out an existing user name when adding a user.
=item B<is_in_table>
$auth->is_in_table($group, $user);
True if $user in group $group is already in the database.
=item B<validate>
$auth->validate($group, $user, $password);
True if the item is a valid entry; internal use
=back
=head1 BUGS
On installation, "make test" may fail if Perl support for MySql or SQLite is
installed, but the database itself is not running or is otherwise not available
for use by the installing user. MySql by default has a 'test' database which is
required under "make test." "Forcing" installation may work around this.
=head1 AUTHOR
William Herrera (wherrera@skylightview.com)
=head1 SUPPORT
Questions, feature requests and bug reports should go to wherrera@skylightview.com
=head1 COPYRIGHT
Copyright (C) 2004, 2008 William Hererra. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
( run in 3.457 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )