r1294 - in packages/libuser-simple-perl/branches/upstream/current:
. lib/User lib/User/Simple
Gunnar Wolf
gwolf at costa.debian.org
Tue Aug 16 17:35:54 UTC 2005
Author: gwolf
Date: 2005-08-16 17:35:53 +0000 (Tue, 16 Aug 2005)
New Revision: 1294
Modified:
packages/libuser-simple-perl/branches/upstream/current/Changes
packages/libuser-simple-perl/branches/upstream/current/META.yml
packages/libuser-simple-perl/branches/upstream/current/Makefile.PL
packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple.pm
packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple/Admin.pm
Log:
Load /tmp/tmp.dtQMPg/libuser-simple-perl-0.9 into
packages/libuser-simple-perl/branches/upstream/current.
Modified: packages/libuser-simple-perl/branches/upstream/current/Changes
===================================================================
--- packages/libuser-simple-perl/branches/upstream/current/Changes 2005-08-15 15:16:52 UTC (rev 1293)
+++ packages/libuser-simple-perl/branches/upstream/current/Changes 2005-08-16 17:35:53 UTC (rev 1294)
@@ -1,6 +1,15 @@
Revision history for Perl extension User::Simple.
-0.01 Wed Jun 15 10:52:29 2005
+0.9 Sat Jul 30 10:45:15 2005
+ - Added Date::Calc and Digest::MD5 as prerequisite modules
+ - Added a more granular 'level' for the users instead of the
+ all-or-nothing is_admin infrastructure
+ - Modified the is_admin infrastructure so old code works
+ seamlessly with the new version (although sends out some
+ warnings, as is_admin is officially deprecated)
+ - Added/clarified some documentation
+
+0.8 Wed Jun 15 10:52:29 2005
- original version; created by h2xs 1.23 with options
-X User::Simple
Modified: packages/libuser-simple-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libuser-simple-perl/branches/upstream/current/META.yml 2005-08-15 15:16:52 UTC (rev 1293)
+++ packages/libuser-simple-perl/branches/upstream/current/META.yml 2005-08-16 17:35:53 UTC (rev 1294)
@@ -1,10 +1,12 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: User-Simple
-version: 0.8
+version: 0.9
version_from: lib/User/Simple.pm
installdirs: site
requires:
+ Date::Calc: 0
+ Digest::MD5: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libuser-simple-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libuser-simple-perl/branches/upstream/current/Makefile.PL 2005-08-15 15:16:52 UTC (rev 1293)
+++ packages/libuser-simple-perl/branches/upstream/current/Makefile.PL 2005-08-16 17:35:53 UTC (rev 1294)
@@ -5,7 +5,8 @@
WriteMakefile(
NAME => 'User::Simple',
VERSION_FROM => 'lib/User/Simple.pm', # finds $VERSION
- PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ PREREQ_PM => {Date::Calc => 0,
+ Digest::MD5 => 0}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/User/Simple.pm', # retrieve abstract from module
AUTHOR => 'Gunnar Wolf <gwolf@>') : ()),
Modified: packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple/Admin.pm
===================================================================
--- packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple/Admin.pm 2005-08-15 15:16:52 UTC (rev 1293)
+++ packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple/Admin.pm 2005-08-16 17:35:53 UTC (rev 1294)
@@ -10,9 +10,10 @@
=head1 SYNOPSIS
- $ua = User::Simple::Admin->new($db, $user_table);
+ $ua = User::Simple::Admin->new($db, $user_table, [$adm_level]);
- $ua = User::Simple::Admin->create_db_structure($db, $user_table);
+ $ua = User::Simple::Admin->create_db_structure($db, $user_table,
+ [$adm_level]);
$ok = User::Simple::Admin->has_db_structure($db, $user_table);
%users = $ua->dump_users;
@@ -20,47 +21,87 @@
$id = $ua->id($login);
$login = $ua->login($id);
$name = $ua->name($id);
+ $level = $ua->level($id);
$is_admin = $ua->is_admin($id);
$ok = $usr->set_login($id, $login);
$ok = $usr->set_name($id, $name);
+ $ok = $usr->set_level($id, $level);
$ok = $usr->set_admin($id);
$ok = $usr->unset_admin($id);
$ok = $usr->set_passwd($id, $passwd);
$ok = $usr->clear_session($id);
- $id = $ua->new_user($login, $name, $passwd, $is_admin);
+ $id = $ua->new_user($login, $name, $passwd, $level);
$ok = $ua->remove_user($id);
=head1 DESCRIPTION
+User::Simple::Admin manages the administrative part of the User::Simple
+modules - Please check L<User::Simple> for a general overview of these modules
+and an explanation on what-goes-where.
+
+User::Simple::Admin works as a regular administrator would: The module should
+be instantiated only once for all of your users' administration, if possible,
+not instantiated once for each user (in contraposition to L<User::Simple>, as
+it works from each of the users' perspective in independent instantiations).
+
+Note also that User::Simple::Admin does b<not> perform the administrative user
+checks - It is meant to be integrated to your system, and it is your system
+which should carry out all of the needed authentication checks.
+
+There are some oddly named methods and attributes you will find both in
+L<User::Simple> and this modules - C<is_admin>, C<set_admin>, C<unset_admin>,
+C<adm_level>. Please consider them all as B<deprecated>. They are provided only
+for backward compatibility, and will be dropped in a future version.
+
+=head2 CONSTRUCTOR
+
Administrative actions for User::Simple modules are handled through this
Admin object. To instantiate it:
- $a = User::Simple::Admin->new($db, $user_table);
+ $ua = User::Simple::Admin->new($db, $user_table, [$adm_level]);
-$db is an open connection to the database where the user data is stored.
+$db is an open connection to the database where the user data is stored.
+$user_table is the name of the table that holds the users' data.
+
+The optional $adm_level argument indicates from which level on are users
+recognized as administrative - This can be any arbitrary nonnegative integer.
+If this parameter is not specified, it will default to 1, having basically a
+correspondence to Perl's handling of truth values.
+
If we do not yet have the needed DB structure to store the user information,
-we can use this method as a constructor as well.
+we can use this class method as a constructor as well:
- $ok = User::Simple::Admin->create_db_structure($db, $user_table)
+ $ua = User::Simple::Admin->create_db_structure($db, $user_table,
+ [$adm_level])
+=head2 QUERYING FOR DATABASE READINESS
+
In order to check if the database is ready to be used by this module with the
-specified table name.
+specified table name, use the C<has_db_structure> class method:
+ $ok = User::Simple::Admin->has_db_structure($db, $user_table);
+
+=head2 RETRIEVING THE SET OF USERS
+
%users = $ua->dump_users;
Will return a hash with the data regarding the registered users, in the
following form:
- ( $id1 => { is_admin => $is_admin1, name => $name1, login => $login1},
- $id2 => { is_admin => $is_admin2, name => $name2, login => $login2},
+ ( $id1 => { level => $level1, is_admin => $is_admin1,
+ name => $name1, login => $login1},
+ $id2 => { level => $level2, is_admin => $is_admin2,
+ name => $name2, login => $login2},
(...) )
- $id = $ua->new_user($login, $name, $passwd, $is_admin);
+=head2 CREATING, QUERYING AND MODIFYING USERS
+ $id = $ua->new_user($login, $name, $passwd, $level);
+
Creates a new user with the specified data. $is_admin is a boolean value - Use
1 for true, 0 for false. Returns the new user's ID.
@@ -71,6 +112,7 @@
$id = $ua->id($login);
$login = $ua->login($id);
$name = $ua->name($id);
+ $level = $ua->level($id);
$is_admin = $ua->is_admin($id);
Get the value of each of the mentioned attributes. Note that in order to get
@@ -81,6 +123,7 @@
$ok = $usr->set_login($id, $login);
$ok = $usr->set_name($id, $name);
$ok = $usr->set_passwd($id, $passwd);
+ $ok = $usr->set_level($id, $level);
Modifies the requested attribute of the specified user, setting it to the new
value.
@@ -88,12 +131,27 @@
$ok = $usr->set_admin($id);
$ok = $usr->unset_admin($id);
-Sets or removes the administrative status of this user.
+Sets or removes the administrative status of this user. Please note that this
+is done relative to the value specified as C<$adm_level> upon the
+User::Simple::Admin object's instantiation - By calling C<set_admin>, the
+user's level will be set to the minimum administrative value (this means, to
+the current C<$adm_level>). By calling unsed_admin, it will be set to zero.
+Note that the C<set_admin> and C<unset_admin> methods are provided for
+backwards compatibility and should be considered as B<deprecated> - In order
+to set a user's level, you should call C<set_level> instead. Support for these
+two methods (and to the is_admin idea in general) will be dropped in the
+future.
+
+=head2 SESSIONS
+
$ok = $usr->clear_session($id);
Removes the session which the current user had open, if any.
+Note that you cannot create a new session through this module - The only way of
+creating a session is through the C<ck_login> method of L<User::Simple>.
+
=head1 DEPENDS ON
L<Digest::MD5>
@@ -123,10 +181,11 @@
# Constructor
sub new {
- my ($self, $class, $db, $table);
+ my ($self, $class, $db, $table, $adm_level);
$class = shift;
$db = shift;
$table = shift;
+ $adm_level = shift;
# Verify we got the right arguments
unless (isa($db, 'DBI::db')) {
@@ -134,6 +193,12 @@
return undef;
}
+ $adm_level = 1 unless defined $adm_level;
+ if ($adm_level !~ /^\d+$/) {
+ carp "adm_level must be a non-negative integer";
+ return undef;
+ }
+
# In order to check if the table exists, check if it consists only of
# valid characters and query for a random user
unless ($table =~ /^[\w\_]+$/) {
@@ -146,7 +211,7 @@
return undef;
}
- $self = { db => $db, tbl => $table };
+ $self = { db => $db, tbl => $table, adm_level => $adm_level };
bless $self, $class;
return $self;
@@ -168,7 +233,8 @@
login varchar NOT NULL UNIQUE,
name varchar NOT NULL,
passwd varchar,
- is_admin bool NOT NULL DEFAULT 'f',
+-- is_admin bool NOT NULL DEFAULT 'f',
+ level integer NOT NULL DEFAULT 0,
session varchar UNIQUE,
session_exp varchar)") and $sth->execute) {
carp "Could not create database structure using table $table";
@@ -189,7 +255,7 @@
# data, if the ID is not linked to a trigger and a sequence, and so on...
# But usually, this check will be enough just to determine if we have the
# structure ready.
- return 1 if ($sth=$db->prepare("SELECT id, login, name, passwd, is_admin,
+ return 1 if ($sth=$db->prepare("SELECT id, login, name, passwd, level,
session, session_exp FROM $table LIMIT 1") and $sth->execute);
return 0;
}
@@ -201,7 +267,7 @@
my ($self, $order, $sth, %users);
$self = shift;
- unless ($sth = $self->{db}->prepare("SELECT id, login, name, is_admin
+ unless ($sth = $self->{db}->prepare("SELECT id, login, name, level
FROM $self->{tbl}") and $sth->execute) {
carp 'Could not query for the user list';
return undef;
@@ -210,7 +276,8 @@
while (my @row = $sth->fetchrow_array) {
$users{$row[0]} = {login => $row[1],
name => $row[2],
- is_admin => $row[3]
+ level => $row[3],
+ is_admin => ($row[3] >= $self->{adm_level}) ? 1 : 0
};
}
@@ -244,11 +311,19 @@
return $self->_get_field($id, 'name');
}
+sub level {
+ my ($self, $id);
+ $self = shift;
+ $id = shift;
+ return $self->_get_field($id, 'level');
+}
+
sub is_admin {
my ($self, $id);
$self = shift;
$id = shift;
- return $self->_get_field($id, 'is_admin');
+ $self->_debug(2,"is_admin is deprecated! Please use level instead");
+ return ($self->{adm_level} <= $self->level($id)) ? 1 : 0;
}
######################################################################
@@ -270,18 +345,28 @@
return $self->_set_field($id, 'name', $new);
}
+sub set_level {
+ my ($self, $id, $new);
+ $self = shift;
+ $id = shift;
+ $new = shift;
+ return $self->_set_field($id, 'level', $new);
+}
+
sub set_admin {
my ($self, $id);
$self = shift;
$id = shift;
- return $self->_set_field($id, 'is_admin', 1);
+ $self->_debug(2,"set_admin is deprecated! Please use level instead");
+ return $self->set_level($id, $self->{adm_level});
}
sub unset_admin {
my ($self, $id);
$self = shift;
$id = shift;
- return $self->_set_field($id, 'is_admin', 0);
+ $self->_debug(2,"unset_admin is deprecated! Please use level instead");
+ return $self->set_level($id, 0);
}
sub set_passwd {
@@ -307,12 +392,12 @@
# User creation and removal
sub new_user {
- my ($self, $login, $name, $passwd, $is_adm, $id, $orig_re);
+ my ($self, $login, $name, $passwd, $level, $id, $orig_re);
$self = shift;
$login = shift;
$name = shift;
$passwd = shift;
- $is_adm = shift || 0; # Don't whine on undef
+ $level = shift || 0; # Don't whine on undef
$orig_re = $self->{db}->{RaiseError};
eval {
@@ -326,7 +411,8 @@
# Yes, this could lead to a race condition and to the attempt to insert
# two users with the same ID - We have, however, the column as a
# 'primary key'. Any DBD implementing unicity will correctly fail.
- # And... Well, nobody expects too high trust from DBD::CSV, right? :)
+ # And... Well, nobody expects too high trust from a DBD backend which
+ # does not implement unicity, right? :)
$sth = $self->{db}->prepare("SELECT id FROM $self->{tbl} ORDER BY
id desc LIMIT 1");
$sth->execute;
@@ -334,8 +420,8 @@
$id++;
$sth = $self->{db}->prepare("INSERT INTO $self->{tbl} (id, login, name,
- is_admin) VALUES (?, ?, ?, ?)");
- $sth->execute($id, $login, $name, $is_adm?1:0);
+ level) VALUES (?, ?, ?, ?)");
+ $sth->execute($id, $login, $name, $level);
$id = $self->id($login);
$self->set_passwd($id, $passwd);
@@ -409,7 +495,7 @@
sub _is_valid_field {
my $field = shift;
- return ($field =~ /^(login|name|is_admin)$/) ? 1 : 0;
+ return ($field =~ /^(login|name|level)$/) ? 1 : 0;
}
1;
Modified: packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple.pm
===================================================================
--- packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple.pm 2005-08-15 15:16:52 UTC (rev 1293)
+++ packages/libuser-simple-perl/branches/upstream/current/lib/User/Simple.pm 2005-08-16 17:35:53 UTC (rev 1294)
@@ -13,7 +13,8 @@
$usr = User::Simple->new(db => $db,
[tbl => $user_table],
[durat => $duration],
- [debug => $debug] );
+ [debug => $debug],
+ [adm_level => $level]);
$ok = $usr->ck_session($session);
$ok = $usr->ck_login($login, $passwd, [$no_sess]);
@@ -24,27 +25,38 @@
$login = $usr->login;
$id = $usr->id;
$session = $usr->session;
+ $level = $usr->level;
$ok = $usr->is_admin;
=head1 DESCRIPTION
User::Simple provides a very simple framework for validating users,
managing their sessions and storing a minimal set of information (this
-is, a meaningful user login/password pair and the user's name) via a
-database. The sessions can be used as identifiers for i.e. cookies on
-a Web system. The passwords are stored as MD5 hashes (this means, the
-password is not stored in clear text).
+is, a meaningful user login/password pair, the user's name and privilege
+level) via a database. The sessions can be used as identifiers for i.e.
+cookies on a Web system. The passwords are stored as MD5 hashes (this means,
+the password is never stored in clear text).
User::Simple was originally developed with a PostgreSQL database in
mind, but should work with any real DBMS. Sadly, this rules out DBD::CSV,
-DBD::XBase, DBD::Excel and many others - The user table requires the driver
-to implement primary keys and NOT NULL/UNIQUE constraints.
+DBD::XBase, DBD::Excel and many other implementations based on SQL::Statement -
+The user table requires the driver to implement primary keys and
+NOT NULL/UNIQUE constraints.
+The functionality is split into two modules, L<User::Simple> and
+L<User::Simple::Admin>. This module provides the functionality your system
+will need for any interaction started by the user - Authentication, session
+management, querying the user's data and changing the password. Any other
+changes (i.e., changing the user's name, login or level) should be carried out
+using L<User::Simple::Admin>.
+
+=head2 CONSTRUCTOR
+
In order to create a User::Simple object, call the new argument with an
active DBI (database connection) object as its only argument:
$usr = User::Simple->new(db => $db, [tbl => $table], [durat => $duration],
- [debug => $debug]);
+ [debug => $debug], [adm_level => $level]);
Of course, the database must have the right structure in it - please check
L<User::Simple::Admin> for more information.
@@ -63,6 +75,20 @@
debug is set to 5, information such as cleartext passwords will be logged as
well!
+C<adm_level> gives us an extra way to tell if a user has administrative
+privileges - The users with a level under the number specified here will be
+seen as unprivileged, and those whose level is equal or higher than it will
+be treated as administrative users. The user level assigned to a user does not
+mean anything for User::Simple, but might be used inside your application. If
+C<adm_level> is not specified, it will default to 1 (meaning that regular
+users' level is only 0, and any positive integer is an administrative user, as
+traditional in Perl's truth management). Please note (explanation follows
+below) that using C<adm_level> and the C<is_admin> method is deprecated in
+favor of directly querying C<$usr-E<gt>level>, and will be dropped in the
+future.
+
+=head2 SESSION CREATION/DELETION
+
Once the object is created, we can ask it to verify that a given user is
valid, either by checking against a session string or against a login/password
pair::
@@ -75,10 +101,6 @@
password matches (i.e. when asking for the current password as a confirmation
in order to change a user's password). It will almost always be left false.
-To change the user's password:
-
- $ok = $usr->set_passwd($nvo_pass);
-
To end a session:
$ok = $usr->end_session;
@@ -87,17 +109,37 @@
$ok = $usr->is_valid;
+=head2 QUERYING THE CURRENT USER'S DATA
+
To check the user's attributes (name, login and ID):
$name = $usr->name;
$login = $usr->login;
$id = $usr->id;
-To check if the user has administrative access (again, see
-L<User::Simple::Admin> for further details):
+To change the user's password:
+ $ok = $usr->set_passwd($new_pass);
+
+=head2 USER LEVEL / ADMINISTRATIVE ACCESS
+
+To check for the user level (or simply to check if the user has administrative
+access) (again, see L<User::Simple::Admin> for further details):
+
+ $level = $usr->level;
$ok = $usr->is_admin;
+Please note that User::Simple will only tell your application whether a user
+has administrative access (that is, C<$usr-E<gt>is_admin> is true, or
+C<$usr-E<gt>level> is equal or larger than C<adm_level>. The C<is_admin> method
+is for integration to your system, and does not mean that the user can access
+the functionality of User::Simple::Admin.
+
+Yes, this last note takes away part of the nice simplicity of User::Simple, and
+that is not a good thing. This is still a very young module, but has already
+some systems depending on its way of working. Consider C<is_admin> as
+B<deprecated>, support for it will be dropped in the future.
+
=head1 DEPENDS ON
L<Date::Calc>
@@ -114,6 +156,10 @@
automatic, we need to be able to operate without a real RDBMS, i.e., with
DBD::CSV.
+The C<is_admin>, C<adm_level> and related infrastructure feels like a kludge,
+and cries to be removed. As for now, a simple warning about it being deprecated
+will do.
+
I would also like to separate a bit the table structure, allowing for
flexibility - This means, if you added some extra fields to the table,
provide an easy way to access them. Currently, you have to reach in from
@@ -138,7 +184,7 @@
use Digest::MD5 qw(md5_hex);
use UNIVERSAL qw(isa);
-our $VERSION = '0.8';
+our $VERSION = '0.9';
######################################################################
# Constructor
@@ -150,7 +196,7 @@
# Verify we got the right arguments
for my $key (keys %init) {
- next if $key =~ /^(db|debug|durat|tbl)$/;
+ next if $key =~ /^(db|debug|durat|tbl|adm_level)$/;
carp "Unknown argument received: $key";
return undef;
}
@@ -159,6 +205,7 @@
$init{tbl} = 'user_simple' unless defined $init{tbl};
$init{durat} = 30 unless defined $init{durat};
$init{debug} = 2 unless defined $init{debug};
+ $init{adm_level} = 1 unless defined $init{adm_level};
unless (defined($init{db}) and isa($init{db}, 'DBI::db')) {
carp "Mandatory db argument must be a valid (DBI) database handle";
@@ -171,7 +218,7 @@
carp "Invalid table name $init{tbl}";
return undef;
}
- unless ($sth=$init{db}->prepare("SELECT id, login, name, is_admin
+ unless ($sth=$init{db}->prepare("SELECT id, login, name, level
FROM $init{tbl} LIMIT 1") and $sth->execute) {
carp "Table $init{tbl} does not exist or has wrong structure";
return undef;
@@ -182,11 +229,17 @@
return undef;
}
- unless ($init{debug} =~ /^\d+$/ and $init{debug} <= 5) {
+ unless ($init{debug} =~ /^\d+$/ and $init{debug} >= 0 and
+ $init{debug} <= 5) {
carp "Debug level must be an integer between 0 and 5";
return undef;
}
+ unless ($init{adm_level} =~ /^\d+$/ and $init{adm_level} >= 0) {
+ carp "Administrative level must be a non-negative integer";;
+ return undef;
+ }
+
$self = { %init };
bless $self, $class;
@@ -284,7 +337,7 @@
session_exp = NULL WHERE id = ?");
$sth->execute($self->{id});
- for my $key qw(id is_admin login name session session_exp) {
+ for my $key qw(id level login name session session_exp) {
delete $self->{$key};
}
@@ -299,8 +352,15 @@
sub login { my $self = shift; return $self->{login}; }
sub id { my $self = shift; return $self->{id}; }
sub session { my $self = shift; return $self->{session}; }
-sub is_admin { my $self = shift; return $self->{is_admin}; }
+sub level { my $self = shift; return $self->{level}; }
+sub is_admin {
+ my $self = shift;
+ $self->_debug(2,"is_admin is deprecated! Please use level instead");
+ return 1 if $self->level >= $self->{adm_level};
+ return 0;
+}
+
sub set_passwd {
my ($self, $pass, $crypted, $sth);
$self = shift;
@@ -343,11 +403,11 @@
my ($self, $sth);
$self=shift;
- $sth=$self->{db}->prepare("SELECT login, name, is_admin, session,
+ $sth=$self->{db}->prepare("SELECT login, name, level, session,
session_exp FROM $self->{tbl} WHERE id=?");
$sth->execute($self->{id});
- ($self->{login}, $self->{name}, $self->{is_admin}, $self->{session},
+ ($self->{login}, $self->{name}, $self->{level}, $self->{session},
$self->{session_exp}) = $sth->fetchrow_array;
return 1;
More information about the Pkg-perl-cvs-commits
mailing list