Chris/webperl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Refactored authentication/activation/password reset code.

Browse Source
This commit is contained in:
Chris 2013-01-11 15:44:20 +00:00
parent dac55ff239
commit 55b442b761
5 changed files with 599 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
Webperl/AppUser.pm
View File

@ -197,6 +197,27 @@ sub get_user {
}
## @method $ get_user_byactcode($actcode, $onlyreal)
# Obtain the user record for the user with the specified activation code, if they
# exist. This returns a reference to a hash of user data for the user with the
# code, or undef if the code does not correspond to a valid user. If the onlyreal
# argument is set, the userid must correspond to 'real' user - bots or inactive
# users are not be returned.
#
# @param actcode The actcode to look for in the user table.
# @param onlyreal If true, only users of type 0 or 3 are returned.
# @return A reference to a hash containing the user's data, or undef if the user
# can not be located (or is not real)
sub get_user_byactcode {
my $self = shift;
my $actcode = shift;
my $onlyreal = shift;
# Return the user record
return $self -> _get_user("act_code", $actcode, $onlyreal);
}
## @method $ get_user_authmethod($username)
# Attempt to obtain the auth method id set for the user with the specified
# username. If the user does not exist, or does not have an authmethod set,
@ -244,78 +265,6 @@ sub set_user_authmethod {
}
## @method $ activated($userid)
# Determine whether the user account specified has been activated.
#
# @param userid The ID of the user account to check the activation status of.
# @return true if the user has been activated (actually, the unix timestamp of
# their activation), 0 if the user has not been activated/does not exist,
# or undef on error.
sub activated {
my $self = shift;
my $userid = shift;
$self -> clear_error();
my $acth = $self -> {"dbh"} -> prepare("SELECT activated FROM ".$self -> {"settings"} -> {"database"} -> {"users"}."
WHERE user_id = ?");
$acth -> execute($userid)
or return $self -> self_error("Unable to perform user activation check: ". $self -> {"dbh"} -> errstr);
my $act = $acth -> fetchrow_arrayref();
return $act ? $act -> [0] : 0;
}
## @method $ activate_user_byid($userid)
# Activate the user account with the specified id. This clears the user's
# activation code, and sets the activation timestamp.
#
# @param userid The ID of the user account to activate.
# @return true on success, undef on error.
sub activate_user_byid {
my $self = shift;
my $userid = shift;
$self -> clear_error();
my $activate = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET activated = UNIX_TIMESTAMP(), act_code = NULL
WHERE user_id = ?");
my $rows = $activate -> execute($userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows modified - bad userid?") if($rows eq "0E0");
return 1;
}
## @method $ activate_user($actcode)
# Activate the user account with the specified code. This clears the user's
# activation code, and sets the activation timestamp.
#
# @param actcode The activation code to look for and clear.
# @return A reference to the user's data on success, undef on error.
sub activate_user {
my $self = shift;
my $actcode = shift;
$self -> clear_error();
# Look up a user with the specified code
my $userh = $self -> {"dbh"} -> prepare("SELECT * FROM ".$self -> {"settings"} -> {"database"} -> {"users"}."
WHERE act_code = ?");
$userh -> execute($actcode)
or return $self -> self_error("Unable to perform user lookup: ". $self -> {"dbh"} -> errstr);
my $user = $userh -> fetchrow_hashref()
or return $self -> self_error("The specified activation code is not set for any users.");
# Activate the user, and return their data if successful.
return $self -> activate_user_byid($user -> {"user_id"}) ? $user : undef;
}
# ============================================================================
# Pre- and Post-auth functions.
@ -363,6 +312,7 @@ sub pre_authenticate {
# @param username The username of the user to perform post-auth tasks on.
# @param password The password the user authenticated with.
# @param auth A reference to the auth object calling this.
# @param authmethod The id of the authmethod to set for the user.
# @return A reference to a hash containing the user's data on success,
# undef otherwise. If this returns undef, an error message will be
# set in the specified auth's errstr field.
@ -370,23 +320,19 @@ sub post_authenticate {
my $self = shift;
my $username = shift;
my $auth = shift;
my $authmethod = shift;
$self -> clear_error();
# Load the authmethod so that it can be called on if needed
my $methodimpl = $auth -> get_authmethod_module($authmethod)
or return undef;
# Determine whether the user exists. If not, create the user.
my $user = $self -> get_user($username);
if(!$user) {
# No record for this user, need to make one...
my $newuser = $self -> {"dbh"} -> prepare("INSERT INTO ".$self -> {"settings"} -> {"database"} -> {"users"}."
(username, created, last_login)
VALUES(?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP())");
$newuser -> execute($username)
or $self -> {"logger"} -> die_log($self -> {"cgi"} -> remote_host(), "FATAL: Unable to create new user record: ".$self -> {"dbh"} -> errstr);
$user = $self -> get_user($username);
}
return $auth -> self_error("User addition failed.")
$user = $methodimpl -> create_user($username, $authmethod) or return $auth -> self_error("User addition failed: ".$methodimpl -> errstr())
if(!$user);
# Touch the user's record...

252
Webperl/Auth.pm
View File

@ -231,7 +231,8 @@ sub valid_user {
# Try the user's set authmethod if possible
if($authmethod) {
$methodimpl = $self -> {"methods"} -> load_method($authmethod);
$methodimpl = $self -> get_authmethod_module($authmethod)
or return undef;
# Check whether the user can authenticate if the implementation was found
$valid = $methodimpl -> authenticate($username, $password, $self)
@ -244,8 +245,8 @@ sub valid_user {
# methods instead.
if(!$valid && (!$authmethod || !$methodimpl || $self -> {"settings"} -> {"Auth:enable_fallback"})) {
foreach my $trymethod (@{$methods}) {
my $methodimpl = $self -> {"methods"} -> load_method($trymethod)
or $self -> {"logger"} -> die_log($self -> {"cgi"} -> remote_host(), "Auth implementation load failed: ".$self -> {"methods"} -> {"errstr"});
my $methodimpl = $self -> get_authmethod_module($trymethod)
or return undef;
$valid = $methodimpl -> authenticate($username, $password, $self);
@ -260,25 +261,8 @@ sub valid_user {
# If one of the auth methods succeeded in validating the user, record it
# invoke the app standard post-auth for the user, and return the user's
# database record.
if($valid) {
# If postauth fails, treat the user as invalid
if($self -> {"app"} -> post_authenticate($username, $password, $self)) {
$self -> {"app"} -> set_user_authmethod($username, $authmethod);
my $user = $self -> {"app"} -> get_user($username);
# Determine whether the user's authentication method requires account activation
my $methodimpl = $self -> {"methods"} -> load_method($authmethod);
return $self -> self_error("AuthMethod implementation failure during post-auth.") if(!$methodimpl);
# If it doesn't require activation, and the user isn't active yet, activate them
$self -> {"app"} -> activate_user($user -> {"user_id"})
unless($methodimpl -> require_activate() || $self -> {"app"} -> activated($user -> {"user_id"}));
return $self -> {"app"} -> get_user($username);
}
return undef;
}
return $self -> {"app"} -> post_authenticate($username, $password, $self, $authmethod)
if($valid);
# Authentication failed.
return $self -> self_error("Invalid username or password specified.");
@ -299,11 +283,233 @@ sub get_user_authmethod_module {
# Does the user have an authmethod set?
my $authmethod = $self -> {"app"} -> get_user_authmethod($username);
return $self -> {"methods"} -> load_method($authmethod)
return $self -> get_authmethod_module($authmethod)
if($authmethod);
# If the user doesn't have an AuthMethod set, fall back on the base class.
return Webperl::AuthMethod -> new();
}
## @method $ get_authmethod_module($moduleid)
# A convenience wrapper around calls to AuthMethods::load_method to help reduce
# exposure throughout the rest of the system somewhat.
#
# @param moduleid The ID of the AuthMethod module to load.
# @return A reference to an AuthMethod on success, undef on error.
sub get_authmethod_module {
my $self = shift;
my $moduleid = shift;
$self -> clear_error();
return $self -> {"methods"} -> load_method($moduleid)
or return $self -> self_error("Auth implementation load failed: ".$self -> {"methods"} -> errstr());
}
# ============================================================================
# AuthMethod abstraction
# These functions exist to insulate the rest of the system from the actual
# authemthod set for a user, and the implementation of the various user ops.
# Direct user access is still supported through AppUser and other modules as
# needed, but credential management and checking should be done through
# these functions to ensure that auth-specific code doesn't leak.
# Note that this doesn't cover user creation, as these can not establish
# which authmodule to use until the user has been created...
## @method $ require_activate($username)
# Determine whether the user's AuthMethod module requires that user accounts
# be activated before they can be used.
#
# @param username The name of the user to check for authentication requirement.
# @return true if the AuthMethod requires activation, false if it does not.
sub require_activate {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
return $methodimpl -> require_activate();
}
## @method $ noactivate_message($username)
# Generate a message (or, better yet, a language variable marker) to show to users
# who attempt to activate an account that uses an AuthMethod that does not require it.
#
# @param username The name of the user trying to activate
# @return A message to show to the user when redundantly attempting to activate.
sub noactivate_message {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
return $methodimpl -> noactivate_message();
}
## @method $ activated($username)
# Determine whether the user account specified has been activated.
#
# @param username The name of the user to check
# @return true if the user has been activated (actually, the unix timestamp of
# their activation), 0 if the user has not been activated/does not exist,
# or undef on error.
sub activated {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
my $user = $self -> get_user($username)
or return undef;
return $methodimpl -> activated($user -> {"user_id"});
}
## @method $ activate_user($actcode)
# Activate the user account with the specified code. This clears the user's
# activation code, and sets the activation timestamp.
#
# @param actcode The activation code to look for and clear.
# @return A reference to the user's data on success, undef on error.
sub activate_user {
my $self = shift;
my $actcode = shift;
$self -> clear_error();
# Look up a user with the specified code
my $user = $self -> {"app"} -> get_user_byactcode($actcode)
or return $self -> self_error("The specified activation code is not set for any users.");
my $methodimpl = $self -> get_user_authmethod_module($user -> {"username"})
or return undef;
# Activate the user, and return their data if successful.
return $methodimpl -> activate_user($user -> {"user_id"});
}
## @method $ supports_recovery($username)
# Determine whether the user's AuthMethod allows users to recover their account details
# within the system.
#
# @param username The name of the user to check for recovery support for.
# @return True if the AuthMethod supports in-system account recovery, false if it does not.
sub supports_recovery {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
return $methodimpl -> supports_recovery();
}
## @method $ norecover_message($username)
# Generate a message to show users who attempt to recover their account using an AuthMethod
# that does not support in-system recovery.
#
# @param username The name of the user to obtain the 'recovery unsupported' message for
# @return A message to show to the user attempting an unsupported recovery operation.
sub norecover_message {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
return $methodimpl -> norecover_message();
}
## @method @ reset_password_actcode($username)
# Forcibly reset the user's password and activation code to new random values.
#
# @param username The username of the user to reset the password and act code for
# @return The new password and activation code set for the user, undef on error.
sub reset_password_actcode {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
my $user = $self -> get_user($username)
or return undef;
return $methodimpl -> reset_password_actcode($user -> {"user_id"});
}
## @method $ reset_password($username)
# Forcibly reset the user's password to a new random value.
#
# @param username The username of the user to reset the password for
# @return The (unencrypted) new password set for the user, undef on error.
sub reset_password {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
my $user = $self -> get_user($username)
or return undef;
return $methodimpl -> reset_password($user -> {"user_id"});
}
## @method $ set_password($username, $password)
# Set the user's password to the specified value.
#
# @param username The ID of the user to set the password for
# @param password The password to set for the user.
# @return True on success, undef on error.
sub set_password {
my $self = shift;
my $username = shift;
my $password = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
my $user = $self -> get_user($username)
or return undef;
return $methodimpl -> set_password($user -> {"user_id"}, $password);
}
## @method $ generate_actcode($username)
# Generate a new activation code for the specified user.
#
# @param username The username of the user to generate a new act code for.
# @return The new activation code for the user
sub generate_actcode {
my $self = shift;
my $username = shift;
my $methodimpl = $self -> get_user_authmethod_module($username)
or return undef;
my $user = $self -> get_user($username)
or return undef;
return $methodimpl -> generate_actcode($user -> {"user_id"});
}
1;

143
Webperl/AuthMethod.pm
View File

@ -24,33 +24,43 @@
package Webperl::AuthMethod;
use strict;
# ============================================================================
# Constructor
## @cmethod $ new(%args)
# Construct a new AuthMethod object. This will create a new AuthMethod object
# initialised with the provided arguments. All the arguments are copied into
# the new object 'as is', with no processing - the caller must make sure they
# are sane before calling this.
#
# @param args A hash of arguments to initialise the AuthMethod object with.
# @return A new AuthMethod object.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {
@_,
};
return bless $self, $class;
}
use base qw(Webperl::SystemModule);
# ============================================================================
# Interface code
## @method $ create_user($username, $authmethod)
# Create a user account in the database. Note that, unless overridden in a subclass,
# this creates a 'stub' user in the database, with minimal information required to
# simply get a user ID needed for other areas of the system. If more complete data
# should be stored with the user, subclasses need to deal with that. For AuthMethods
# that do their authentication against other systems, this user creation function
# is sufficient to pass post_auth requirements - however, they may need to perform
# additional checks in their AppUser implementation to ensure that required fields
# (like email) are populated by the user before they continue.
#
# @param username The name of the user to create.
# @param authmethod The ID of the authmethod to set as the user's default authmethod.
# @return A reference to the new user's database entry on success, undef on error.
sub create_user {
my $self = shift;
my $username = shift;
my $authmethod = shift;
$self -> clear_error();
my $active = !$self -> require_activate();
my $newuser = $self -> {"dbh"} -> prepare("INSERT INTO ".$self -> {"settings"} -> {"database"} -> {"users"}."
(user_auth, activated, username, created, last_login)
VALUES(?, ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP())");
$newuser -> execute($authmethod, $active, $username)
or $self -> self_error("Unable to create new user record: ".$self -> {"dbh"} -> errstr);
return $self -> get_user($username);
}
## @method $ authenticate($username, $password, $auth)
# Authenticate a user based on the credentials supplied. This will attempt
# to determine whether the user's credentials are valid, and will return
@ -99,6 +109,36 @@ sub noactivate_message {
}
## @method $ activated($userid)
# Determine whether the user account specified has been activated.
#
# @param userid The ID of the user account to check the activation status of.
# @return true if the user has been activated (actually, the unix timestamp of
# their activation), 0 if the user has not been activated/does not exist,
# or undef on error.
sub activated {
my $self = shift;
# By default, users are always active, as activation is not required.
return 1;
}
## @method $ activate_user($userid)
# Activate the user account with the specified id. This clears the user's
# activation code, and sets the activation timestamp.
#
# @param userid The ID of the user account to activate.
# @return true on success, undef on error.
sub activate_user {
my $self = shift;
my $userid = shift;
# Activation will always fail if not needed
return $self -> self_error("Unsupported activation requested");
}
## @method $ supports_recovery()
# Determine whether the AuthMethod allows users to recover their account details
# within the system.
@ -123,4 +163,61 @@ sub norecover_message {
return $self -> {"norecover_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::norecover_message"};
}
## @method @ reset_password_actcode($userid)
# Forcibly reset the user's password and activation code to new random values.
#
# @param userid The ID of the user to reset the password and act code for
# @return The new password and activation code set for the user, undef on error.
sub reset_password_actcode {
my $self = shift;
my $userid = shift;
# Do nothing, as by default activation and password change are not supported
return $self -> self_error("Unsupported password and activation code change requested");
}
## @method $ reset_password($userid)
# Forcibly reset the user's password to a new random value.
#
# @param userid The ID of the user to reset the password for
# @return The (unencrypted) new password set for the user, undef on error.
sub reset_password {
my $self = shift;
my $userid = shift;
# Do nothing as password changes are not supported
return $self -> self_error("Unsupported password change requested");
}
## @method $ set_password($userid, $password)
# Set the user's password to the specified value.
#
# @param userid The ID of the user to set the password for
# @param password The password to set for the user.
# @return True on success, undef on error.
sub set_password {
my $self = shift;
my $userid = shift;
# Do nothing as password changes are not supported
return $self -> self_error("Unsupported password change requested");
}
## @method $ generate_actcode($userid)
# Generate a new activation code for the specified user.
#
# @param userid The ID of the user to reset the actcode for
# @return The new activation code for the user
sub generate_actcode {
my $self = shift;
my $userid = shift;
# do nothing as activation is not required
return $self -> self_error("Unsupported activation code change requested");
}
1;

238
Webperl/AuthMethod/Database.pm
View File

@ -78,6 +78,75 @@ sub new {
# ============================================================================
# Interface code
## @method $ hash_password($password, $settings)
# Generate a salted hash of the supplied password. This will create a 59 character
# long string containing the hashed password and its salt suitable for storing in
# the database. If the $settings string is not provided, one will be generated.
# When creating accounts, $settings will be omitted unless the caller wants to
# provide its own salting system. When checking passwords, password should be the
# password being checked, and settings should be a hash string previously
# generated by this function. The result of this function can then be compared to
# the stored hash to determine whether the password is correct.
#
# @param password The plain-text password to check.
# @param settings An optional settings string, leave undefined for new accounts,
# set to a previously generated hash string when doing password
# validity checking.
# @return A bcrypt() generated, 59 character hash containing the settings string
# and the hashed, salted password.
sub hash_password {
my $self = shift;
my $password = shift;
my $settings = shift || generate_settings($self -> {"bcrypt_cost"});
return bcrypt($password, $settings);
}
## @method @ create_user($username, $authmethod, $email)
# Create a new user, with a randomly generated password and activation code.
# This will set the user's name, email, password, activation code, and creation
# date, all other fields will be defaults.
#
# @param username The username of the user to create a record for.
# @param authmethod The ID of the authmethod to set as the user's default authmethod.
# @param email The email address of the new user.
# @return An array of two values: the first is either a reference to the user's
# new record data on success, or undef on failure; the second is the
# 10 character alphanumeric unencrypted password to send to the user.
sub create_user {
my $self = shift;
my $username = shift;
my $authmethod = shift;
my $email = shift;
# Generate some randomness for the authcode and password. These don't need
# to be Insanely Secure, so this should be sufficient...
my $actcode = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..64);
my $password = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..10);
# Hash the password using the method AuthMethod::Database uses internally
my $cryptpass = Webperl::AuthMethod::Database::hash_password({"bcrypt_cost" => 14}, $password);
# Do the insert
my $userh = $self -> {"dbh"} -> prepare("INSERT INTO ".$self -> {"settings"} -> {"database"} -> {"users"}."
(user_auth, username, password, email, created, act_code)
VALUES(?, ?, ?, ?, UNIX_TIMESTAMP(), ?)");
my $rows = $userh -> execute($authmethod, $username, $cryptpass, $email, $actcode);
return $self -> self_error("Unable to perform user insert: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User insert failed, no rows added.") if($rows eq "0E0");
# FIXME: This ties to MySQL, but is more reliable that last_insert_id in general.
# Try to find a decent solution for this mess...
my $userid = $self -> {"dbh"} -> {"mysql_insertid"};
return $self -> self_error("Unable to obtain id for user '$username'") if(!$userid);
my $user = $self -> get_user_byid($userid);
return ($user, $password);
}
## @method $ authenticate($username, $password, $auth)
# Attempt to authenticate the user against the database. This will check the user's
# login against the configured database tabke, and return true if the login is valid.
@ -112,31 +181,6 @@ sub authenticate {
}
## @method $ hash_password($password, $settings)
# Generate a salted hash of the supplied password. This will create a 59 character
# long string containing the hashed password and its salt suitable for storing in
# the database. If the $settings string is not provided, one will be generated.
# When creating accounts, $settings will be omitted unless the caller wants to
# provide its own salting system. When checking passwords, password should be the
# password being checked, and settings should be a hash string previously
# generated by this function. The result of this function can then be compared to
# the stored hash to determine whether the password is correct.
#
# @param password The plain-text password to check.
# @param settings An optional settings string, leave undefined for new accounts,
# set to a previously generated hash string when doing password
# validity checking.
# @return A bcrypt() generated, 59 character hash containing the settings string
# and the hashed, salted password.
sub hash_password {
my $self = shift;
my $password = shift;
my $settings = shift || generate_settings($self -> {"bcrypt_cost"});
return bcrypt($password, $settings);
}
## @method $ require_activate()
# Determine whether the AuthMethod module requires that user accounts
# be activated before they can be used.
@ -149,6 +193,52 @@ sub require_activate {
}
## @method $ activated($userid)
# Determine whether the user account specified has been activated.
#
# @param userid The ID of the user account to check the activation status of.
# @return true if the user has been activated (actually, the unix timestamp of
# their activation), 0 if the user has not been activated/does not exist,
# or undef on error.
sub activated {
my $self = shift;
my $userid = shift;
$self -> clear_error();
my $acth = $self -> {"dbh"} -> prepare("SELECT activated FROM ".$self -> {"settings"} -> {"database"} -> {"users"}."
WHERE user_id = ?");
$acth -> execute($userid)
or return $self -> self_error("Unable to perform user activation check: ". $self -> {"dbh"} -> errstr);
my $act = $acth -> fetchrow_arrayref();
return $act ? $act -> [0] : 0;
}
## @method $ activate_user($userid)
# Activate the user account with the specified id. This clears the user's
# activation code, and sets the activation timestamp.
#
# @param userid The ID of the user account to activate.
# @return true on success, undef on error.
sub activate_user {
my $self = shift;
my $userid = shift;
$self -> clear_error();
my $activate = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET activated = UNIX_TIMESTAMP(), act_code = NULL
WHERE user_id = ?");
my $rows = $activate -> execute($userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows modified - bad userid?") if($rows eq "0E0");
return 1;
}
## @method $ supports_recovery()
# Determine whether the AuthMethod allows users to recover their account details
# within the system.
@ -161,6 +251,104 @@ sub supports_recovery {
}
## @method @ reset_password_actcode($userid)
# Forcibly reset the user's password and activation code to new random values.
#
# @param userid The ID of the user to reset the password and act code for
# @return The new password and activation code set for the user
sub reset_password_actcode {
my $self = shift;
my $userid = shift;
my $actcode = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..64);
my $password = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..10);
# Hash the password using the method AuthMethod::Database uses internally
my $cryptpass = $self -> hash_password({"bcrypt_cost" => 14}, $password);
my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET password = ?, act_code = ?
WHERE user_id = ?");
my $rows = $reseth -> execute($cryptpass, $actcode, $userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows changed.") if($rows eq "0E0");
return ($password, $actcode);
}
## @method $ reset_password($userid)
# Forcibly reset the user's password to a new random value.
#
# @param userid The ID of the user to reset the password for
# @return The (unencrypted) new password set for the user
sub reset_password {
my $self = shift;
my $userid = shift;
my $password = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..10);
# Hash the password using the method AuthMethod::Database uses internally
my $cryptpass = $self -> hash_password({"bcrypt_cost" => 14}, $password);
my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET password = ?
WHERE user_id = ?");
my $rows = $reseth -> execute($cryptpass, $userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows changed.") if($rows eq "0E0");
return $password;
}
## @method $ set_password($userid, $password)
# Set the user's password to the specified value.
#
# @param userid The ID of the user to set the password for
# @param password The password to set for the user.
# @return True on success, undef on error.
sub set_password {
my $self = shift;
my $userid = shift;
my $password = shift;
# Hash the password using the method AuthMethod::Database uses internally
my $cryptpass = $self -> hash_password({"bcrypt_cost" => 14}, $password);
my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET password = ?
WHERE user_id = ?");
my $rows = $reseth -> execute($cryptpass, $userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows changed.") if($rows eq "0E0");
return 1;
}
## @method $ generate_actcode($userid)
# Generate a new activation code for the specified user.
#
# @param userid The ID of the user to reset the act code for
# @return The new activation code for the user
sub generate_actcode {
my $self = shift;
my $userid = shift;
my $actcode = join("", map { ("a".."z", "A".."Z", 0..9)[rand 62] } 1..64);
my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}."
SET act_code = ?
WHERE user_id = ?");
my $rows = $reseth -> execute($actcode, $userid);
return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows);
return $self -> self_error("User update failed, no rows changed.") if($rows eq "0E0");
return $actcode;
}
# ============================================================================
# Ghastly internals

4
Webperl/AuthMethods.pm
View File

@ -104,7 +104,7 @@ sub load_method {
my $moduleh = $self -> {"dbh"} -> prepare("SELECT perl_module, enabled FROM ".$self -> {"settings"} -> {"database"} -> {"auth_methods"}."
WHERE id = ?");
$moduleh -> execute($method_id)
or $self -> {"logger"} -> die_log($self -> {"cgi"} -> remote_host(), "Unable to execute auth method lookup query: ".$self -> {"dbh"} -> errstr);
or $self -> self_error("Unable to execute auth method lookup query: ".$self -> {"dbh"} -> errstr);
my $module = $moduleh -> fetchrow_hashref();
return $self -> self_error("Unknown auth method requested in load_method($method_id)") if(!$module);
@ -116,7 +116,7 @@ sub load_method {
my $paramh = $self -> {"dbh"} -> prepare("SELECT name, value FROM ".$self -> {"settings"} -> {"database"} -> {"auth_params"}."
WHERE method_id = ?");
$paramh -> execute($method_id)
or $self -> {"logger"} -> die_log($self -> {"cgi"} -> remote_host(), "Unable to execute auth method parameter query: ".$self -> {"dbh"} -> errstr);
or $self -> self_error("Unable to execute auth method parameter query: ".$self -> {"dbh"} -> errstr);
# Build up a settings hash using the standard objects, and settings for the
# module loaded from the database.