Overhaul of capability interrogation, addition of policy support.
This commit is contained in:
parent
2fb530567d
commit
5ef7038d36
199
Webperl/Auth.pm
199
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 {
|
||||
# @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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 {
|
||||
# @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 {
|
||||
# @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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
# - `server` (required) 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.
|
||||
#
|
||||
# The following arguments may be provided:
|
||||
#
|
||||
# * adminuser - if specified, searching for the user's DN will be done
|
||||
# - `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 - 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
|
||||
# - `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.
|
||||
#
|
||||
# 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;
|
||||
}
|
||||
|
||||
@ -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
|
||||
# - `server` (required) the server to authenticate the user against, can be either
|
||||
# a hostname or ip address.
|
||||
#
|
||||
# The following configuration options may also be supplied:
|
||||
#
|
||||
# * timeout - the conection timeout in seconds. This defaults to 5 if not
|
||||
# - `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 - the location of the ssh binary. Defaults to /usr/bin/ssh.
|
||||
# - `binary` (optional) 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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user