From a2fa55729c6a79c26faab302269619dc1c1a2b9b Mon Sep 17 00:00:00 2001 From: Chris Date: Wed, 9 Jan 2013 14:01:02 +0000 Subject: [PATCH] Support for per-AuthMethod control of recovery and activation. Note that this still requires the webapp to do work to perform the activation or recovery. --- Webperl/AppUser.pm | 76 ++++++++++++++++++++++++++++++++++ Webperl/Auth.pm | 10 +++++ Webperl/AuthMethod.pm | 50 ++++++++++++++++++++++ Webperl/AuthMethod/Database.pm | 24 +++++++++++ 4 files changed, 160 insertions(+) diff --git a/Webperl/AppUser.pm b/Webperl/AppUser.pm index 41395cd..66c829d 100644 --- a/Webperl/AppUser.pm +++ b/Webperl/AppUser.pm @@ -244,6 +244,78 @@ 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. @@ -299,6 +371,8 @@ sub post_authenticate { my $username = shift; my $auth = shift; + $self -> clear_error(); + # Determine whether the user exists. If not, create the user. my $user = $self -> get_user($username); if(!$user) { @@ -351,6 +425,8 @@ sub _get_user { my $onlyreal = shift; my $uselike = shift; + $self -> clear_error(); + my $userh = $self -> {"dbh"} -> prepare("SELECT * FROM ".$self -> {"settings"} -> {"database"} -> {"users"}." WHERE $field ".($uselike ? "LIKE" : "=")." ?". ($onlyreal ? " AND user_type IN (0,3)" : "")); diff --git a/Webperl/Auth.pm b/Webperl/Auth.pm index 5aadc7d..641afb4 100644 --- a/Webperl/Auth.pm +++ b/Webperl/Auth.pm @@ -265,6 +265,16 @@ sub valid_user { 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; diff --git a/Webperl/AuthMethod.pm b/Webperl/AuthMethod.pm index c2c2dc4..268662a 100644 --- a/Webperl/AuthMethod.pm +++ b/Webperl/AuthMethod.pm @@ -73,4 +73,54 @@ sub authenticate { return 0; } + +## @method $ require_activate() +# Determine whether the AuthMethod module requires that user accounts +# be activated before they can be used. +# +# @return true if the AuthMethod requires activation, false if it does not. +sub require_activate { + my $self = shift; + + # By default, AuthMethods do not require account activation + return 0; +} + + +## @method $ noactivate_message() +# 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. +# +# @return A message to show to the user when redundantly attempting to activate. +sub noactivate_message { + my $self = shift; + + return $self -> {"noactivate_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::noactivate_message"}; +} + + +## @method $ supports_recovery() +# Determine whether the AuthMethod allows users to recover their account details +# within the system. +# +# @return True if the AuthMethod supports in-system account recovery, false if it does not. +sub supports_recovery { + my $self = shift; + + # By default, AuthMethods do not support recovery + return 0; +} + + +## @method $ norecover_message() +# Generate a message to show users who attempt to recover their account using an AuthMethod +# that does not support in-system recovery. +# +# @return A message to show to the user attempting an unsupported recovery operation. +sub norecover_message { + my $self = shift; + + return $self -> {"norecover_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::norecover_message"}; +} + 1; diff --git a/Webperl/AuthMethod/Database.pm b/Webperl/AuthMethod/Database.pm index c92fcd8..0a6cbc5 100644 --- a/Webperl/AuthMethod/Database.pm +++ b/Webperl/AuthMethod/Database.pm @@ -137,6 +137,30 @@ sub hash_password { } +## @method $ require_activate() +# Determine whether the AuthMethod module requires that user accounts +# be activated before they can be used. +# +# @return true if the AuthMethod requires activation, false if it does not. +sub require_activate { + my $self = shift; + + return 1; +} + + +## @method $ supports_recovery() +# Determine whether the AuthMethod allows users to recover their account details +# within the system. +# +# @return True if the AuthMethod supports in-system account recovery, false if it does not. +sub supports_recovery { + my $self = shift; + + return 1; +} + + # ============================================================================ # Ghastly internals