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

@@ -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)" : ""));

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;

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;

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