From 5ef7038d366c3dbc12e4d14389367d1c2eeb0fac Mon Sep 17 00:00:00 2001 From: Chris Date: Wed, 13 Feb 2013 14:16:31 +0000 Subject: [PATCH] Overhaul of capability interrogation, addition of policy support. --- Webperl/Auth.pm | 205 ++++++++++++++++++---------- Webperl/AuthMethod.pm | 237 ++++++++++++++++++++++++++------- Webperl/AuthMethod/Database.pm | 183 +++++++++++++++++-------- Webperl/AuthMethod/LDAPS.pm | 38 +++--- Webperl/AuthMethod/SSH.pm | 34 ++--- 5 files changed, 484 insertions(+), 213 deletions(-) diff --git a/Webperl/Auth.pm b/Webperl/Auth.pm index 96a5612..56ef98d 100644 --- a/Webperl/Auth.pm +++ b/Webperl/Auth.pm @@ -235,15 +235,15 @@ sub valid_user { or return undef; # Check whether the user can authenticate if the implementation was found - $valid = $methodimpl -> authenticate($username, $password, $self) - if($methodimpl); + $valid = $methodimpl -> authenticate($username, $password, $self); + + # errors should halt auth attempts + return undef if(!defined($valid)); } # If no authmethod was found for the user, or the auth failed and fallback is enabled, - # all the available auth methods should be checked. Note that !$methodimpl is here so - # that, if an auth method is removed for some reason, the system will try other auth - # methods instead. - if(!$valid && (!$authmethod || !$methodimpl || $self -> {"settings"} -> {"Auth:enable_fallback"})) { + # all the available auth methods should be checked. + if(!$valid && (!$authmethod || $self -> {"settings"} -> {"Auth:enable_fallback"})) { foreach my $trymethod (@{$methods}) { my $methodimpl = $self -> get_authmethod_module($trymethod) or return undef; @@ -265,7 +265,7 @@ sub valid_user { if($valid); # Authentication failed. - return $self -> self_error("Invalid username or password specified."); + return undef; } @@ -280,6 +280,8 @@ sub get_user_authmethod_module { my $self = shift; my $username = shift; + $self -> clear_error(); + # Does the user have an authmethod set? my $authmethod = $self -> {"app"} -> get_user_authmethod($username); @@ -321,38 +323,30 @@ sub get_authmethod_module { # 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. + +## @method $ capabilities($username, $capability) +# Interrogate the capabilities of the authentication method. This will either +# return a reference to a hash containing the capability information for the +# auth method or, if a valid capability argument is specified, this returns +# the value for that capability. # -# @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; +# @param username The name of the user to check +# @param capability The optional name of the capability to obtain the value for. +# @return If no 'capabilities' argument is provided, a reference to a hash +# containing all of the authmethod's capabilities. If a capability is +# specified, this returns the value for it, or undef if the requested +# capability is unknown. +sub capabilities { + my $self = shift; + my $username = shift; + my $capability = shift; + + $self -> clear_error(); my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; - return $methodimpl -> require_activate() - or return $self -> self_error($methodimpl -> errstr()); -} - - -## @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(); + return $methodimpl -> capabilities($capability); } @@ -367,6 +361,8 @@ sub activated { my $self = shift; my $username = shift; + $self -> clear_error(); + my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; @@ -404,42 +400,6 @@ sub activate_user { } -## @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() - or return $self -> self_error($methodimpl -> errstr()); -} - - -## @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() - or return $self -> self_error($methodimpl -> errstr()); -} - - ## @method @ reset_password_actcode($username) # Forcibly reset the user's password and activation code to new random values. # @@ -449,6 +409,8 @@ sub reset_password_actcode { my $self = shift; my $username = shift; + $self -> clear_error(); + my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; @@ -469,6 +431,8 @@ sub reset_password { my $self = shift; my $username = shift; + $self -> clear_error(); + my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; @@ -483,7 +447,7 @@ sub reset_password { ## @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 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 { @@ -491,6 +455,8 @@ sub set_password { my $username = shift; my $password = shift; + $self -> clear_error(); + my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; @@ -511,6 +477,8 @@ sub generate_actcode { my $self = shift; my $username = shift; + $self -> clear_error(); + my $methodimpl = $self -> get_user_authmethod_module($username) or return undef; @@ -522,4 +490,99 @@ sub generate_actcode { } +## @method $ force_passchange($username) +# Determine whether the user needs to reset their password (either because they are +# using a temporary system-allocated password, or the password policy requires it). +# +# @param username The name of the user who to check password status for. +# @return 'temporary' if the user must change their password because it is a +# temporary one, 'expired' if the password has expired, the empty string if +# the password does not need to be changed, undef on error. +sub force_passchange { + my $self = shift; + my $username = shift; + + $self -> clear_error(); + + my $methodimpl = $self -> get_user_authmethod_module($username) + or return undef; + + my $user = $self -> get_user($username) + or return undef; + + return $methodimpl -> force_passchange($user -> {"user_id"}) + or return $self -> self_error($methodimpl -> errstr()); +} + + +## @method @ mark_loginfail($username) +# For method implementations that support it, mark the user as failing a login. +# Some authmethods may limit user login failures and deactivate accounts that +# have failed repeatedly. +# +# @param username The name of the user who failed to log in. If this user does +# not exist, this returns undef. +# @return An array containing two values: The first is the number of login failures +# recorded for the user, the second is the number of allowed failures. If +# the second value is zero, no failure limiting is being performed. If an error +# occurs, both values are undef. +sub mark_loginfail { + my $self = shift; + my $username = shift; + + $self -> clear_error(); + + my $methodimpl = $self -> get_user_authmethod_module($username) + or return (undef, undef); + + my $user = $self -> get_user($username) + or return (undef, undef); + + # Don't actually need to check $methodimpl -> capabilities("failcount") here, as + # the default implementation returns usably sane values. + my ($failcount, $limit) = $methodimpl -> mark_loginfail($user -> {"user_id"}); + return ($self -> self_error($methodimpl -> errstr()), undef) + unless(defined($failcount)); + + return ($failcount, $limit); +} + + +## @method $ apply_policy($username, $password) +# Apply the configured password policy to the specified password string. +# The following configuration parameters (which should be set for each applicable +# authmethod in the auth_method_params table) are used to control the policy. If +# no value is set for a given parameter, the policy is assumed to not care about +# the parameter: +# +# - `policy_min_length`, passwords must be at least this number of characters long. +# - `policy_min_lowercase`, at least this number of lowercase characters must be present. +# - `policy_min_uppercase`, at least this many uppercase characters must be included. +# - `policy_min_digits`, the minimum number of digits that must be used. +# - `policy_min_other`, the number of non-alphanumeric characters that must be present. +# - `policy_min_entropy`, the minimum password entropy (as calculated by Data::Password::Entropy) +# to allow for passwords. See +# - `policy_use_cracklib`, if true, passwords are checked using cracklib. +# +# @param username The name of the user to check the password for. +# @param password The password string to check against the password policy. +# @return undef if the password passes the password policy, otherwise a reference to +# a hash, the keys forming the names of the policy rules failed, and the values +# being array references containing the settings for the policy rule and the value +# detected. +sub apply_policy { + my $self = shift; + my $username = shift; + my $password = shift; + + $self -> clear_error(); + + my $methodimpl = $self -> get_user_authmethod_module($username) + or return undef; + + return $methodimpl -> apply_policy($password) + or return $self -> self_error($methodimpl -> errstr()); +} + + 1; diff --git a/Webperl/AuthMethod.pm b/Webperl/AuthMethod.pm index 523214e..a9f01f0 100644 --- a/Webperl/AuthMethod.pm +++ b/Webperl/AuthMethod.pm @@ -26,6 +26,35 @@ package Webperl::AuthMethod; use strict; use base qw(Webperl::SystemModule); +# ============================================================================ +# Constructor + +## @cmethod $ new(%args) +# Construct a new AuthMethod object. This will create a new AuthMethod object +# initialised with the provided arguments. +# +# @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 = $class -> SUPER::new(@_) + or return undef; + + $self -> {"capabilities"} = {"activate" => 0, + "activate_message" => $self -> {"noactivate_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::noactivate_message"}, + "recover" => 0, + "recover_message" => $self -> {"norecover_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::norecover_message"}, + "passchange" => 0, + "passchange_message" => $self -> {"nopasschange_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::nopasschange_message"}, + "failcount" => 0, + "failcount_message" => $self -> {"nofailcount_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::nofailcount_message"}, + }; + + return $self; +} + + # ============================================================================ # Interface code @@ -84,28 +113,39 @@ sub authenticate { } -## @method $ require_activate() -# Determine whether the AuthMethod module requires that user accounts -# be activated before they can be used. +## @method $ capabilities($capability) +# Interrogate the capabilities of the authentication method. This will either +# return a reference to a hash containing the capability information for the +# auth method or, if a valid capability argument is specified, this returns +# the value for that capability. # -# @return true if the AuthMethod requires activation, false if it does not. -sub require_activate { - my $self = shift; +# @param capability The optional name of the capability to obtain the value for. +# @return If no 'capabilities' argument is provided, a reference to a hash +# containing all of the authmethod's capabilities. If a capability is +# specified, this returns the value for it, or undef if the requested +# capability is unknown. +sub capabilities { + my $self = shift; + my $capability = shift; - # By default, AuthMethods do not require account activation - return 0; + return($self -> {"capabilities"} -> {$capability}) + if($capability && $self -> {"capabilities"}); + + return $self -> {"capabilities"}; } -## @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. +## @method $ generate_actcode($userid) +# Generate a new activation code for the specified user. # -# @return A message to show to the user when redundantly attempting to activate. -sub noactivate_message { - my $self = shift; +# @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; - return $self -> {"noactivate_message"} || $self -> {"settings"} -> {"config"} -> {"AuthMethod::noactivate_message"}; + # do nothing as activation is not required + return $self -> self_error($self -> capabilities("activate_message")); } @@ -135,32 +175,7 @@ sub activate_user { 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. -# -# @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"}; + return $self -> self_error($self -> capabilities("activate_message")); } @@ -174,7 +189,7 @@ sub reset_password_actcode { 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"); + return $self -> self_error($self -> capabilities("recover_message")); } @@ -188,7 +203,7 @@ sub reset_password { my $userid = shift; # Do nothing as password changes are not supported - return $self -> self_error("Unsupported password change requested"); + return $self -> self_error($self -> capabilities("passchange_message")); } @@ -203,21 +218,141 @@ sub set_password { my $userid = shift; # Do nothing as password changes are not supported - return $self -> self_error("Unsupported password change requested"); + return $self -> self_error($self -> capabilities("passchange_message")); } -## @method $ generate_actcode($userid) -# Generate a new activation code for the specified user. +## @method $ force_passchange($userid) +# Determine whether the user needs to reset their password (either because they are +# using a temporary system-allocated password, or the password policy requires it). # -# @param userid The ID of the user to reset the actcode for -# @return The new activation code for the user -sub generate_actcode { +# If a password expiration policy is in use, `policy_max_passwordage` should be set +# in the auth_method_params for the applicable authmethods. The parameter should contain +# the maximum age of any given password in seconds. If not set, expiration is not +# enforced. +# +# @param userid The ID of the user to check for password change requirement. +# @return A string indicating why the user must change their password if they need +# to, the empty string if they do not, undef on error. +sub force_passchange { my $self = shift; my $userid = shift; - # do nothing as activation is not required - return $self -> self_error("Unsupported activation code change requested"); + # By default, AuthMethods do not support password changing, so they can't force it. + return '' +} + + +## @method @ mark_loginfail($userid) +# Increment the login failure count for the specified user. The following configuration +# parameter (which should be set for each applicable authmethod in the auth_method_params +# table) is used to control the login failure marking process: +# +# - `policy_max_loginfail`, the number of login failures a user may have before their +# account is deactivated. +# +# @warning Login failure limiting should not be performed unless account activation +# and password changes are supported. Otherwise the system has no means of +# preventing attempts to log in past the limit. +# +# @param userid The ID of the user to increment the login failure counter for. +# @return An array containing two values: The first is the number of login failures +# recorded for the user, the second is the number of allowed failures. If +# the second value is zero, no failure limiting is being performed. If an error +# occurs or the user does not exist, both values are undef. +sub mark_loginfail { + my $self = shift; + my $userid = shift; + + # login failure counting is not supported by default, so users never get deactivated. + return (0, 0); +} + + +## @method $ apply_policy($password) +# Apply the configured password policy to the specified password string. +# The following configuration parameters (which should be set for each applicable +# authmethod in the auth_method_params table) are used to control the policy. If +# no value is set for a given parameter, the policy is assumed to not care about +# the parameter: +# +# - `policy_min_length`, passwords must be at least this number of characters long. +# - `policy_min_lowercase`, at least this number of lowercase characters must be present. +# - `policy_min_uppercase`, at least this many uppercase characters must be included. +# - `policy_min_digits`, the minimum number of digits that must be used. +# - `policy_min_other`, the number of non-alphanumeric characters that must be present. +# - `policy_min_entropy`, the minimum password entropy (as calculated by Data::Password::Entropy) +# to allow for passwords. See +# - `policy_use_cracklib`, if true, passwords are checked using cracklib. +# +# @param password The password string to check against the password policy. +# @return undef if the password passes the password policy, otherwise a reference to +# a hash, the keys forming the names of the policy rules failed, and the values +# being array references containing the settings for the policy rule and the value +# detected. +sub apply_policy { + my $self = shift; + my $password = shift; + my $failures = {}; + + $failures -> {"policy_min_length"} = [ $self -> {"policy_min_length"}, length($password) ] + if($self -> {"policy_min_length"} && length($password) < $self -> {"policy_min_length"}); + + my $lowercount = $password =~ tr/a-z//; + $failures -> {"policy_min_lowercase"} = [ $self -> {"policy_min_lowercase"}, $lowercount ] + if($self -> {"policy_min_lowercase"} && $lowercount < $self -> {"policy_min_lowercase"}); + + my $uppercount = $password =~ tr/A-Z//; + $failures -> {"policy_min_uppercase"} = [ $self -> {"policy_min_uppercase"}, $uppercount ] + if($self -> {"policy_min_uppercase"} && $uppercount < $self -> {"policy_min_uppercase"}); + + my $digitcount = $password =~ tr/0-9//; + $failures -> {"policy_min_digits"} = [ $self -> {"policy_min_digits"}, $digitcount ] + if($self -> {"policy_min_digits"} && $digitcount < $self -> {"policy_min_digits"}); + + my $othercount = length($password) - ($lowercount + $uppercount + $digitcount); + $othercount = 0 if($othercount < 0); # Impossibru! But check it anyway. + $failures -> {"policy_min_others"} = [ $self -> {"policy_min_others"}, $othercount ] + if($self -> {"policy_min_others"} && $othercount < $self -> {"policy_min_others"}); + + # Check against Data::Password::Entropy if possible + if($self -> {"policy_min_entropy"}) { + # Load the entropy module at runtime, so that systems that don't test entropy don't need it... + eval { + require Data::Password::Entropy; + Data::Password::Entropy -> import(); + }; + + # Handle attempted load that fails. This is transparent to users, which may be a bad thing.... + if($@) { + $self -> {"logger"} -> log("error", 0, undef, "policy_min_entropy is set, but unable to load Data::Password::Entropy!"); + } else { + my $entropy = password_entropy($password); + $failures -> {"policy_min_entropy"} = [ $self -> {"policy_min_entropy"}, $entropy ] + if($entropy < $self -> {"policy_min_entropy"}); + } + } + + # Potentially invoke cracklib + if($self -> {"policy_use_cracklib"}) { + # Load the cracklib module at runtime, so that systems that don't test against it don't need it... + eval { + require Crypt::Cracklib; + Crypt::Cracklib -> import(); + }; + + # Handle attempted load that fails. This is transparent to users, which may be a bad thing.... + if($@) { + $self -> {"logger"} -> log("error", 0, undef, "policy_use_cracklib is set, but unable to load Crypt::Cracklib!"); + } else { + my $crackres = fascist_check($password); + + $failures -> {"policy_use_cracklib"} = [1, $crackres] + if($crackres ne "ok"); + } + } + + return scalar(keys(%$failures)) ? $failures : undef; } 1; diff --git a/Webperl/AuthMethod/Database.pm b/Webperl/AuthMethod/Database.pm index 5f16abe..41df045 100644 --- a/Webperl/AuthMethod/Database.pm +++ b/Webperl/AuthMethod/Database.pm @@ -22,26 +22,25 @@ # The users' passwords are never stored as plain text - this uses a # salted, hashed storage mechanism for passwords. # -# This module will expect at least the following configuration values -# to be passed to the constructor. +# This module supports the following comfiguration variables: # -# * table - The name of the database table to authenticate against. -# This must be accessible to the system-wide dbh object. -# * userfield - The name of the column in the table that stores usernames. -# * passfield - The password column in the table. The field in the table -# must be able to store a 59 character hashed password. +# - table (required) The name of the database table to authenticate against. +# This table must be accessible to the system-wide dbh object. +# - bcrypt_cost (optional) the number of iterations of hashing to perform. This +# defaults to Webperl::AuthMethod::Database::COST_DEFAULT if not +# specified. # -# The following arguments may also be provided to the module constructor: -# -# * bcrypt_cost - the number of iterations of hashing to perform. This -# defaults to COST_DEFAULT if not specified. +# These will generally be provided by supplying the configuration variables +# in the auth_methods_params table and using Webperl::AuthMethods to load +# the AuthMethod at runtime. package Webperl::AuthMethod::Database; use strict; use base qw(Webperl::AuthMethod); # This class extends AuthMethod use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64); -use constant COST_DEFAULT => 14; # The default cost to use if bcrypt_cost is not set. +## The default cost to use if bcrypt_cost is not passed to the constructor. +use constant COST_DEFAULT => 14; # ============================================================================ @@ -58,19 +57,27 @@ use constant COST_DEFAULT => 14; # The default cost to use if bcrypt_cost is not sub new { my $invocant = shift; my $class = ref($invocant) || $invocant; - my $self = $class -> SUPER::new(@_); - - # bomb if the parent constructor failed. - return $class -> SUPER::get_error() if(!$self); - - # Set default values as needed - $self -> {"bcrypt_cost"} = COST_DEFAULT; + my $self = $class -> SUPER::new(@_) + or return undef; # check that required settings are set... - return "Webperl::AuthMethod::Database missing 'table' argument in new()" if(!$self -> {"table"}); - return "Webperl::AuthMethod::Database missing 'userfield' argument in new()" if(!$self -> {"userfield"}); - return "Webperl::AuthMethod::Database missing 'passfield' argument in new()" if(!$self -> {"passfield"}); + return set_error("Webperl::AuthMethod::Database missing 'table' argument in new()") + if(!$self -> {"table"}); + # Set default values as needed + $self -> {"bcrypt_cost"} = COST_DEFAULT + unless($self -> {"bcrypt_cost"}); + + # replace the stock capabilities + $self -> {"capabilities"} = {"activate" => 1, + "activate_message" => '', + "recover" => 1, + "recover_message" => '', + "passchange" => 1, + "passchange_message" => '', + "failcount" => 1, + "failcount_message" => '', + }; return $self; } @@ -130,8 +137,8 @@ sub create_user { # 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(), ?)"); + (user_auth, username, password, password_set, force_change, email, created, act_code) + VALUES(?, ?, ?, UNIX_TIMESTAMP(), 1, ?, 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"); @@ -166,10 +173,13 @@ sub authenticate { my $password = shift; my $auth = shift; - my $userh = $self -> {"dbh"} -> prepare("SELECT ".$self -> {"passfield"}." FROM ".$self -> {"table"}." - WHERE ".$self -> {"userfield"}." LIKE ?"); + return $auth -> self_error("Database login failed: Username and password are required.") + if(!$username || !$password); + + my $userh = $self -> {"dbh"} -> prepare("SELECT password FROM ".$self -> {"table"}." + WHERE username LIKE ?"); $userh -> execute($username) - or $self -> {"logger"} -> die_log($self -> {"cgi"} -> remote_host(), "Unable to execute user lookup query: ".$self -> {"dbh"} -> errstr); + or return $auth -> self_error("Database login failed: Unable to execute user lookup query: ".$self -> {"dbh"} -> errstr); # If a user has been found with the specified username, check the password... my $user = $userh -> fetchrow_arrayref(); @@ -184,18 +194,6 @@ sub authenticate { } -## @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 $ activated($userid) # Determine whether the user account specified has been activated. # @@ -232,7 +230,7 @@ sub activate_user { $self -> clear_error(); my $activate = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}." - SET activated = UNIX_TIMESTAMP(), act_code = NULL + SET activated = UNIX_TIMESTAMP(), act_code = NULL, fail_count = 0 WHERE user_id = ?"); my $rows = $activate -> execute($userid); return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows); @@ -242,18 +240,6 @@ sub activate_user { } -## @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; -} - - ## @method @ reset_password_actcode($userid) # Forcibly reset the user's password and activation code to new random values. # @@ -270,7 +256,7 @@ sub reset_password_actcode { my $cryptpass = $self -> hash_password($password); my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}." - SET password = ?, act_code = ? + SET password = ?, act_code = ?, password_set = UNIX_TIMESTAMP(), force_change = 1, activated = NULL WHERE user_id = ?"); my $rows = $reseth -> execute($cryptpass, $actcode, $userid); return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows); @@ -295,7 +281,7 @@ sub reset_password { my $cryptpass = $self -> hash_password($password); my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}." - SET password = ? + SET password = ?, password_set = UNIX_TIMESTAMP(), force_change = 1 WHERE user_id = ?"); my $rows = $reseth -> execute($cryptpass, $userid); return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows); @@ -320,7 +306,7 @@ sub set_password { my $cryptpass = $self -> hash_password($password); my $reseth = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}." - SET password = ? + SET password = ?, password_set = UNIX_TIMESTAMP() WHERE user_id = ?"); my $rows = $reseth -> execute($cryptpass, $userid); return $self -> self_error("Unable to perform user update: ". $self -> {"dbh"} -> errstr) if(!$rows); @@ -352,6 +338,93 @@ sub generate_actcode { } +## @method @ mark_loginfail($userid) +# Increment the login failure count for the specified user. The following configuration +# parameter (which should be set for each applicable authmethod in the auth_method_params +# table) is used to control the login failure marking process: +# +# - `policy_max_loginfail`, the number of login failures a user may have before their +# account is deactivated. +# +# @warning Login failure limiting should not be performed unless account activation +# and password changes are supported. Otherwise the system has no means of +# preventing attempts to log in past the limit. +# +# @param userid The ID of the user to increment the login failure counter for. +# @return An array containing two values: The first is the number of login failures +# recorded for the user, the second is the number of allowed failures. If +# the second value is zero, no failure limiting is being performed. If an error +# occurs or the user does not exist, both values are undef. +sub mark_loginfail { + my $self = shift; + my $userid = shift; + + my $userh = $self -> {"dbh"} -> prepare("SELECT fail_count + FROM ".$self -> {"settings"} -> {"database"} -> {"users"}." + WHERE user_id = ?"); + $userh -> execute($userid) + or return $self -> self_error("Unable to perform user lookup: ". $self -> {"dbh"} -> errstr); + + my $failcount = $userh -> fetchrow_arrayref(); + + # Halt if the user does not exist + return (undef, undef) unless($failcount); + + # Do nothing if limiting is not enabled + return (0, 0) unless($self -> {"policy_max_loginfail"}); + + ++$failcount; + + # update the login fail counter + $userh = $self -> {"dbh"} -> prepare("UPDATE ".$self -> {"settings"} -> {"database"} -> {"users"}." + SET fail_count = ? + WHERE user_id = ?"); + my $rows = $userh -> execute($failcount, $userid); + return $self -> self_error("Unable to perform user failcount update: ". $self -> {"dbh"} -> errstr) if(!$rows); + return $self -> self_error("Unable to perform user failcount update: no rows changed") if($rows eq "0E0"); + + return ($failcount, $self -> {"policy_max_loginfail"}); +} + + +## @method $ force_passchange($userid) +# Determine whether the user needs to reset their password (either because they are +# using a temporary system-allocated password, or the password policy requires it). +# +# If a password expiration policy is in use, `policy_max_passwordage` should be set +# in the auth_method_params for the applicable authmethods. The parameter should contain +# the maximum age of any given password in seconds. If not set, expiration is not +# enforced. +# +# @param userid The ID of the user to check for password change requirement. +# @return 'temporary' if the user must change their password because it is a +# temporary one, 'expired' if the password has expired, the empty string if +# the password does not need to be changed, undef on error. +sub force_passchange { + my $self = shift; + my $userid = shift; + + my $passh = $self -> {"dbh"} -> prepare("SELECT force_change, password_set + FROM ".$self -> {"settings"} -> {"database"} -> {"users"}." + WHERE user_id = ?"); + $passh -> execute($userid) + or return $self -> self_error("Unable to perform passchange check: ". $self -> {"dbh"} -> errstr); + + my $pass_data = $passh -> fetchrow_hashref() + or return ''; # Unknown user? Can't change the password even if we'd like to. + + # Check for password expiration based on policy settings + my $age = time() - ($pass_data -> {"password_set"} || 0); # Handle NULL password_set's sanely + return 'expired' if($self -> {"policy_max_passwordage"} && ($age > $self -> {"policy_max_passwordage"})); + + # Check for temporary passwords + return 'temporary' if($pass_data -> {"force_change"}); + + # Otherwise, no need to change the password + return ''; +} + + # ============================================================================ # Ghastly internals diff --git a/Webperl/AuthMethod/LDAPS.pm b/Webperl/AuthMethod/LDAPS.pm index 212b3b2..395a320 100644 --- a/Webperl/AuthMethod/LDAPS.pm +++ b/Webperl/AuthMethod/LDAPS.pm @@ -21,21 +21,21 @@ # users to be authenticated against most LDAPS servers, provided that # it is configured with the appropriate incantations to talk to it. # -# This module will expect at least the following configuration values -# to be passed to the constructor. +# This module supports the following comfiguration variables: # -# * server - the server to authenticate the user against, can be either -# a hostname, IP address, or URI. -# * base - the base dn to use when searching for the user's dn. -# * searchfield - the field to use when searching for the user dn. +# - `server` (required) the server to authenticate the user against, can be either +# a hostname, IP address, or URI. +# - `base` (required) the base dn to use when searching for the user's dn. +# - `searchfield` (required) the field to use when searching for the user dn. +# - `adminuser` (optional) if specified, searching for the user's DN will be done +# using this user rather than anonymously. +# - `adminpass` (optional) The password to use when logging in as the admin user. +# - `reuseconn` (optional) If set to a true value, the connection to the LDAPS is reused +# for authentication after finding the user's dn. # -# The following arguments may be provided: -# -# * adminuser - if specified, searching for the user's DN will be done -# using this user rather than anonymously. -# * adminpass - The password to use when logging in as the admin user. -# * reuseconn - If set to a true value, the connection to the LDAPS is reused -# for authentication after finding the user's dn. +# These will generally be provided by supplying the configuration variables +# in the auth_methods_params table and using Webperl::AuthMethods to load +# the AuthMethod at runtime. package Webperl::AuthMethod::LDAPS; use strict; @@ -53,15 +53,13 @@ use Net::LDAPS; sub new { my $invocant = shift; my $class = ref($invocant) || $invocant; - my $self = $class -> SUPER::new(@_); - - # bomb if the parent constructor failed. - return $class -> SUPER::get_error() if(!$self); + my $self = $class -> SUPER::new(@_) + or return undef; # check that required settings are set... - return "Webperl::AuthMethod::LDAPS missing 'server' argument in new()" if(!$self -> {"server"}); - return "Webperl::AuthMethod::LDAPS missing 'base' argument in new()" if(!$self -> {"base"}); - return "Webperl::AuthMethod::LDAPS missing 'searchfield' argument in new()" if(!$self -> {"searchfield"}); + return set_error("Webperl::AuthMethod::LDAPS missing 'server' argument in new()") if(!$self -> {"server"}); + return set_error("Webperl::AuthMethod::LDAPS missing 'base' argument in new()") if(!$self -> {"base"}); + return set_error("Webperl::AuthMethod::LDAPS missing 'searchfield' argument in new()") if(!$self -> {"searchfield"}); return $self; } diff --git a/Webperl/AuthMethod/SSH.pm b/Webperl/AuthMethod/SSH.pm index 5c87423..76d87af 100644 --- a/Webperl/AuthMethod/SSH.pm +++ b/Webperl/AuthMethod/SSH.pm @@ -22,18 +22,18 @@ # this module involves potentially significant delays in authentication # as a result of its reliance on Net::SSH::Expect. # -# This module expects at least the following configuration values -# to be passed to the constructor. +# This module supports the following comfiguration variables: # -# * server - the server to authenticate the user against, can be either -# a hostname or ip address. +# - `server` (required) the server to authenticate the user against, can be either +# a hostname or ip address. +# - `timeout` (optional) the conection timeout in seconds. This defaults to 5 if not +# specified (values less than 5 are only recommended on fast +# networks and when talking to servers that respond rapidly). +# - `binary` (optional) the location of the ssh binary. Defaults to `/usr/bin/ssh`. # -# The following configuration options may also be supplied: -# -# * timeout - the conection timeout in seconds. This defaults to 5 if not -# specified (values less than 5 are only recommended on fast -# networks and when talking to servers that respond rapidly). -# * binary - the location of the ssh binary. Defaults to /usr/bin/ssh. +# These will generally be provided by supplying the configuration variables +# in the auth_methods_params table and using Webperl::AuthMethods to load +# the AuthMethod at runtime. package Webperl::AuthMethod::SSH; use strict; @@ -55,13 +55,12 @@ use Utils qw(blind_untaint); sub new { my $invocant = shift; my $class = ref($invocant) || $invocant; - my $self = $class -> SUPER::new(@_); - - # bomb if the parent constructor failed. - return $class -> SUPER::get_error() if(!$self); + my $self = $class -> SUPER::new(@_) + or return undef; # check that required settings are set... - return "Webperl::AuthMethod::SSH missing 'server' argument in new()" if(!$self -> {"server"}); + return set_error("Webperl::AuthMethod::SSH missing 'server' argument in new()") + if(!$self -> {"server"}); # Check whether the timeout and binary settings are, well, set... $self -> {"timeout"} = 5 unless(defined($self -> {"timeout"})); @@ -95,6 +94,9 @@ sub authenticate { my $resp; eval { + # FIXME: This is really godawful ghastly nasty shit that should not exist upon + # the living Earth, but if this is run in tainted mode perl will freak out. + # Fix this by untainting more safely! my $ssh = Net::SSH::Expect -> new(host => blind_untaint($self -> {"server"}), user => blind_untaint($username), password => blind_untaint($password), @@ -119,7 +121,7 @@ sub authenticate { return 0; } - return $auth -> self_error("SSH login failed: username and password are required."); + return $auth -> self_error("SSL Login failed: Username and password are required."); } 1;