Local modifications to ClusterLabs/Anvil by Alteeve
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

980 lines
34 KiB

package Anvil::Tools::Account;
#
# This module contains methods used to handle user accounts, logging in and out.
#
use strict;
use warnings;
use Digest::SHA qw(sha256_base64 sha384_base64 sha512_base64);
use Scalar::Util qw(weaken isweak);
our $VERSION = "3.0.0";
my $THIS_FILE = "Account.pm";
### Methods;
# encrypt_password
# login
# logout
# read_cookies
# read_details
# validate_password
# _build_cookie_hash
# _write_cookies
=pod
=encoding utf8
=head1 NAME
Anvil::Tools::Account
Provides all methods related to user management and log in/out features.
=head1 SYNOPSIS
use Anvil::Tools;
# Get a common object handle on all Anvil::Tools modules.
my $anvil = Anvil::Tools->new();
# Access to methods using '$anvil->Account->X'.
=head1 METHODS
Methods in the core module;
=cut
sub new
{
my $class = shift;
my $self = {};
bless $self, $class;
return ($self);
}
# Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent.
sub parent
{
my $self = shift;
my $parent = shift;
$self->{HANDLE}{TOOLS} = $parent if $parent;
# Defend against memory leads. See Scalar::Util'.
if (not isweak($self->{HANDLE}{TOOLS}))
{
weaken($self->{HANDLE}{TOOLS});;
}
return ($self->{HANDLE}{TOOLS});
}
#############################################################################################################
# Public methods #
#############################################################################################################
=head2 encrypt_password
This takes a string (a new password from a user), generates a salt, appends the salt to the string and hashes that using C<< sys::password::algorithm >>, the re-hashes the string C<< sys::password::hash_count >> times. The default algorithm is 'sha512' and the default rehashing count is '500,000' times.
This method returns a hash reference with the following keys;
* user_password_hash: The final encrypted hash.
* user_salt: The salt created (or used) to generate the hash.
* user_algorithm: The algorithm used to compute the hash.
* user_hash_count: The number of re-encryptions of the initial hash.
If anything goes wrong, all four keys will have empty strings.
Parameters
=head3 algorithm (optional)
If set, the password will be encrypted using the given algoritm. Otherwise, c<< sys::password::algorithm >> is used. If that is not set, C<< sha256 >> is used.
=head3 hash_count (Optional, default 500000)
This controls how many times we re-encrypt the password hash. This is designed to slow down how quickly a brute-force attacker can test hashes. This should be a high enough number to take some time (~0.5 seconds) on a modern machine, but not so high that it noticeably slows down user login attempts.
If set to C<< 0 >>, no re-hashing will occur, but the initial hash still will.
=head3 password (required)
This is the password (string) to encrypt.
=head3 salt (optional)
This is the salt to use when hashing the password. If this is not passed, a new salt will be generated.
=cut
sub encrypt_password
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $algorithm = defined $parameter->{algorithm} ? $parameter->{algorithm} : "";
my $hash_count = defined $parameter->{hash_count} ? $parameter->{hash_count} : "";
my $password = defined $parameter->{password} ? $parameter->{password} : "";
my $salt = defined $parameter->{salt} ? $parameter->{salt} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
algorithm => $algorithm,
hash_count => $hash_count,
password => $anvil->Log->secure ? $password : $anvil->Words->string({key => "log_0186"}),
salt => $salt,
}});
# We'll fill these out below if we succeed.
my $answer = {
user_password_hash => "",
user_salt => "",
user_hash_count => "",
user_algorithm => "",
};
# Make sure we got a string
if (not $password)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Account->encrypt_password()", parameter => "password" }});
return($answer);
}
my $user_password_hash = $password;
# Set the re-hash count, if not already set.
my $user_hash_count = $hash_count;
if ($user_hash_count eq "")
{
$user_hash_count = $anvil->data->{sys}{password}{hash_count} =~ /^\d+$/ ? $anvil->data->{sys}{password}{hash_count} : 500000;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
}
# Generate a salt.
my $user_salt = $salt;
if (not $user_salt)
{
$user_salt = $anvil->Get->_salt;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_salt => $user_salt }});
}
### TODO: Look at using/support bcrypt as the default algorithm. Needed RPMs are already in the el7 AN!Repo.
# We support sha256, sha384 and sha512, possible new ones later.
my $user_algorithm = $algorithm;
if (not $algorithm)
{
$user_algorithm = $anvil->data->{sys}{password}{algorithm} ? $anvil->data->{sys}{password}{algorithm} : "sha512";
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_algorithm => $user_algorithm }});
if ($user_algorithm eq "sha256" )
{
$user_password_hash = sha256_base64($user_password_hash.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$user_password_hash = sha256_base64($user_password_hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
}
}
elsif ($user_algorithm eq "sha384" )
{
$user_password_hash = sha384_base64($user_password_hash.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$user_password_hash = sha384_base64($user_password_hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
}
}
elsif ($user_algorithm eq "sha512" )
{
$user_password_hash = sha512_base64($user_password_hash.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$user_password_hash = sha512_base64($user_password_hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_password_hash => $user_password_hash }});
}
}
else
{
# Bash algorith.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0171", variables => { user_algorithm => $user_algorithm }});
return($answer);
}
$answer = {
user_password_hash => $user_password_hash,
user_salt => $user_salt,
user_hash_count => $user_hash_count,
user_algorithm => $user_algorithm,
};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
'answer->user_password_hash' => $answer->{user_password_hash},
'answer->user_salt' => $answer->{user_salt},
'answer->user_hash_count' => $answer->{user_hash_count},
'answer->user_algorithm' => $answer->{user_algorithm},
}});
return($answer);
}
=head2 login
This checks to see if the CGI C<< username >> and C<< password >> passed in are for a valid user or not. If so, their details are loaded and C<< 0 >> is returned. If not, C<< 1 >> is returned.
This method takes no parameters.
=cut
sub login
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
if ((not $anvil->data->{cgi}{username}{value}) or (not $anvil->data->{cgi}{password}{value}))
{
# The user forgot something...
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0027"}) }});
return(1);
}
my $query = "
SELECT
user_uuid,
user_password_hash,
user_salt,
user_algorithm,
user_hash_count
FROM
users
WHERE
user_algorithm != 'DELETED'
AND
user_name = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{cgi}{username}{value})."
;";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
my $results = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
my $count = @{$results};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
results => $results,
count => $count,
}});
if (not $count)
{
# User not found.
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0027"}) }});
return(1);
}
my $user_uuid = $results->[0]->[0];
my $user_password_hash = $results->[0]->[1];
my $user_salt = $results->[0]->[2];
my $user_algorithm = $results->[0]->[3];
my $user_hash_count = $results->[0]->[4];
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
user_uuid => $user_uuid,
user_password_hash => $user_password_hash,
user_salt => $user_salt,
user_algorithm => $user_algorithm,
user_hash_count => $user_hash_count,
}});
# Test the passed-in password.
my $test_password_answer = $anvil->Account->encrypt_password({
password => $anvil->data->{cgi}{password}{value},
salt => $user_salt,
algorithm => $user_algorithm,
hash_count => $user_hash_count,
});
my $test_password_hash = $test_password_answer->{user_password_hash};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { test_password_hash => $test_password_hash }});
if ($test_password_hash eq $user_password_hash)
{
# User passed a valid username/password. Create a session hash.
my ($session_hash, $session_salt) = $anvil->Account->_build_cookie_hash({
debug => $debug,
uuid => $user_uuid,
offset => 0,
});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
session_hash => $session_hash,
session_salt => $session_salt,
}});
if (not $session_hash)
{
# Something went wrong generating the session cookie, login failed.
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0028"}) }});
return(1);
}
else
{
my $query = "
UPDATE
users
SET
user_session_salt = ".$anvil->data->{sys}{use_db_fh}->quote($session_salt).",
modified_date = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{db_timestamp})."
WHERE
user_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($user_uuid)."
;";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0183", variables => { user => $anvil->data->{cgi}{username}{value} }});
$anvil->Account->_write_cookies({
debug => $debug,
hash => $session_hash,
uuid => $user_uuid,
});
}
}
else
{
# User DID NOT passed a valid username/password.
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0027"}) }});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0184", variables => {
user_agent => $ENV{HTTP_USER_AGENT} ? $ENV{HTTP_USER_AGENT} : "#!string!log_0185!#",
source_ip => $ENV{REMOTE_ADDR} ? $ENV{REMOTE_ADDR} : "#!string!log_0185!#",
user => $anvil->data->{cgi}{username}{value},
}});
# Slow them down a bit...
sleep 5;
return(1);
}
return(0);
}
=head2 logout
This deletes the user's UUID and hash cookies, which effectively logs them out.
This methods takes no parameters and always returns C<< 0 >>.
=cut
sub logout
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
# Delete the user's cookie data. Sending nothing to '_write_cookies' does this.
$anvil->Account->_write_cookies({debug => $debug});
# Delete the user's session salt.
if ($anvil->data->{cookie}{anvil_user_uuid})
{
my $query = "
UPDATE
users
SET
user_session_salt = '',
modified_date = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{db_timestamp})."
WHERE
user_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{cookie}{anvil_user_uuid})."
;";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0183", variables => { user => $anvil->data->{cgi}{username}{value} }});
}
# Log that they're out
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0179"});
return(0);
}
=head2 read_cookies
This method (tries to) read the user's cookies to see if their session is valid. If so, it will read in their account details.
This method takes no parameters.
Return codes;
=head3 0
The cookies were read, the account was validated and the user's details were loaded.
=head3 1
No cookie was found or read. The user needs to log in
=head3 2
There was a problem reading the user's UUID (it wasn't found in the database), so the cookies were deleted (via C<< Account->logout() >>. The user needs to log back in.
=head3 3
There user's hash is invalid, it is probably expired. The user has been logged out and needs to log back in.
=cut
sub read_cookies
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
# Read in any cookies
if (defined $ENV{HTTP_COOKIE})
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "ENV{HTTP_COOKIE}" => $ENV{HTTP_COOKIE} }});
my @data = (split /; /, $ENV{HTTP_COOKIE});
foreach my $pair (@data)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { pair => $pair }});
my ($key, $value) = split/=/, $pair;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
key => $key,
value => $value,
}});
next if ((not defined $value) or ($value eq ""));
if ($key =~ /^anvil_/)
{
$anvil->data->{cookie}{$key} = $value;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "cookie::${key}" => $anvil->data->{cookie}{$key} }});
}
}
}
# Did we read a cookie?
if ((not defined $anvil->data->{cookie}{anvil_user_uuid}) or (not $anvil->data->{cookie}{anvil_user_uuid}))
{
# No cookie read.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0177"});
return(1);
}
elsif (not defined $anvil->data->{cookie}{anvil_user_hash})
{
$anvil->data->{cookie}{anvil_user_hash} = "";
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
"cookie::anvil_user_uuid" => $anvil->data->{cookie}{anvil_user_uuid},
"cookie::anvil_user_hash" => $anvil->data->{cookie}{anvil_user_hash},
}});
# Validate the cookie if there is a User UUID. Pick the random number up from the database.
my $query = "SELECT user_session_salt FROM users WHERE user_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{cookie}{anvil_user_uuid}).";";
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0124", variables => { query => $query }});
my $results = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
my $count = @{$results};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
results => $results,
count => $count,
}});
if ($count < 1)
{
# The user in the cookie isn't in the database. The user was deleted?
$anvil->Account->logout();
# Record the error message for the user.
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0023"}) }});
# We're done.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0178", variables => { uuid => $anvil->data->{cookie}{anvil_user_uuid} }});
return(2);
}
# Read in their "rand" value
$anvil->data->{users}{user_session_salt} = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__})->[0]->[0];
$anvil->data->{users}{user_session_salt} = "" if not defined $anvil->data->{users}{user_session_salt};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "users::user_session_salt" => $anvil->data->{users}{user_session_salt} }});
# Generate a hash using today and yesterday's date.
my ($today_hash) = $anvil->Account->_build_cookie_hash({
debug => $debug,
uuid => $anvil->data->{cookie}{anvil_user_uuid},
salt => $anvil->data->{users}{user_session_salt},
offset => 0,
});
my ($yesterday_hash) = $anvil->Account->_build_cookie_hash({
debug => $debug,
uuid => $anvil->data->{cookie}{anvil_user_uuid},
salt => $anvil->data->{users}{user_session_salt},
offset => -86400,
});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
today_hash => $today_hash,
yesterday_hash => $yesterday_hash,
}});
# See if either hash matches what the user has stored.
if ($anvil->data->{cookie}{anvil_user_hash} eq $today_hash)
{
# Valid hash, user can proceed.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0180"});
# Load the account details
$anvil->Account->read_details({debug => $debug});
}
elsif ($anvil->data->{cookie}{anvil_user_hash} eq $yesterday_hash)
{
# The hash was valid yesterday, so we'll update the cookie with today's hash and proceed
# (which also loads the user's details).
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0181"});
$anvil->Account->_write_cookies({
debug => $debug,
hash => $today_hash,
uuid => $anvil->data->{cookie}{anvil_user_uuid},
});
}
else
{
### TODO: left off here. First check fails and the user is logged out.
#die;
# The user's cookie is invalid, log the user out.
$anvil->Account->logout();
# Record the error message for the user.
$anvil->data->{form}{error_massage} = $anvil->Template->get({file => "main.html", name => "error_message", variables => { error_message => $anvil->Words->string({key => "error_0024"}) }});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0182"});
return(3);
}
return(0);
}
=head2 read_details
This method takes a user uuid and, if the user is found, reads in the details and sets C<< sys::users::<column names> >>. If the user is found, C<< 1 >> is returned. If not, C<< 0 >> is returned.
Parameters;
=head3 user_uuid (optional)
This is the user UUID being searched for. If it is not set, C<< cookie::anvil_user_uuid >>
=cut
sub read_details
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $user_uuid = defined $parameter->{user_uuid} ? $parameter->{user_uuid} : $anvil->data->{cookie}{anvil_user_uuid};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_uuid => $user_uuid }});
if (not $anvil->Validate->is_uuid({uuid => $user_uuid}))
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "error_0025", variables => { uuid => $user_uuid }});
return(0);
}
my $query = "
SELECT
user_name,
user_password_hash,
user_salt,
user_algorithm,
user_hash_count,
user_language,
user_is_admin,
user_is_experienced,
user_is_trusted
FROM
users
WHERE
user_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($user_uuid)."
;";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
my $results = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
my $count = @{$results};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
results => $results,
count => $count,
}});
if (not $count)
{
# User doesn't exist.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "error_0026", variables => { uuid => $user_uuid }});
return(0);
}
my $user_name = $results->[0]->[0];
my $user_password_hash = $results->[0]->[1];
my $user_salt = $results->[0]->[2];
my $user_algorithm = $results->[0]->[3];
my $user_hash_count = $results->[0]->[4];
my $user_language = $results->[0]->[5];
my $user_is_admin = $results->[0]->[6];
my $user_is_experienced = $results->[0]->[7];
my $user_is_trusted = $results->[0]->[8];
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
user_name => $user_name,
user_password_hash => $user_password_hash,
user_salt => $user_salt,
user_algorithm => $user_algorithm,
user_hash_count => $user_hash_count,
user_language => $user_language,
user_is_admin => $user_is_admin,
user_is_experienced => $user_is_experienced,
user_is_trusted => $user_is_trusted,
}});
$anvil->data->{sys}{users}{user_name} = $user_name;
$anvil->data->{sys}{users}{user_uuid} = $user_uuid;
$anvil->data->{sys}{users}{user_password_hash} = $user_password_hash,
$anvil->data->{sys}{users}{user_salt} = $user_salt,
$anvil->data->{sys}{users}{user_algorithm} = $user_algorithm,
$anvil->data->{sys}{users}{user_hash_count} = $user_hash_count,
$anvil->data->{sys}{users}{user_language} = $user_language,
$anvil->data->{sys}{users}{user_is_admin} = $user_is_admin,
$anvil->data->{sys}{users}{user_is_experienced} = $user_is_experienced,
$anvil->data->{sys}{users}{user_is_trusted} = $user_is_trusted,
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
'sys::users::user_name' => $anvil->data->{sys}{users}{user_name},
'sys::users::user_uuid' => $anvil->data->{sys}{users}{user_uuid},
'sys::users::user_password_hash' => $anvil->data->{sys}{users}{user_password_hash},
'sys::users::user_salt' => $anvil->data->{sys}{users}{user_salt},
'sys::users::user_algorithm' => $anvil->data->{sys}{users}{user_algorithm},
'sys::users::user_hash_count' => $anvil->data->{sys}{users}{user_hash_count},
'sys::users::user_language' => $anvil->data->{sys}{users}{user_language},
'sys::users::user_is_admin' => $anvil->data->{sys}{users}{user_is_admin},
'sys::users::user_is_experienced' => $anvil->data->{sys}{users}{user_is_experienced},
'sys::users::user_is_trusted' => $anvil->data->{sys}{users}{user_is_trusted},
}});
# Change the active language, if needed
if ($anvil->data->{sys}{users}{user_language})
{
# Switch to the user's language
$anvil->Words->language({set => $anvil->data->{sys}{users}{user_language}});
}
return(1);
}
=head2 validate_password
This method takes a user name and password and checks to see if the password matches.
If the password is wrong, or if the user isn't found, C<< 0 >> is returned. If the password matches, C<< 1 >> is returned.
Parameters;
=head3 password (required)
This is the password to test.
=head3 user (required)
This is the user whose password we're testing.
=cut
sub validate_password
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $password = defined $parameter->{password} ? $parameter->{password} : "";
my $user = defined $parameter->{user} ? $parameter->{user} : "";
my $valid = 0;
my $hash = "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
password => $anvil->Log->secure ? $password : $anvil->Words->string({key => "log_0186"}),
user => $user,
}});
if (not $password)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Account->validate_password()", parameter => "password" }});
return($valid);
}
if (not $user)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Account->validate_password()", parameter => "user" }});
return($valid);
}
my $query = "
SELECT
user_password_hash,
user_salt,
user_algorithm,
user_hash_count
FROM
users
WHERE
user_name = ".$anvil->data->{sys}{use_db_fh}->quote($user)."
;";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
my $results = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
my $count = @{$results};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
results => $results,
count => $count,
}});
if (not $count)
{
# User not found.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0172", variables => { user => $user }});
return($valid);
}
my $user_password_hash = $results->[0]->[0];
my $user_salt = $results->[0]->[1];
my $user_algorithm = $results->[0]->[2];
my $user_hash_count = $results->[0]->[3];
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
user_password_hash => $user_password_hash,
user_salt => $user_salt,
user_algorithm => $user_algorithm,
user_hash_count => $user_hash_count,
}});
if ($user_algorithm eq "sha256" )
{
$hash = sha256_base64($password.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$hash = sha256_base64($hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
}
}
elsif ($user_algorithm eq "sha384" )
{
$hash = sha384_base64($password.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$hash = sha384_base64($hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
}
}
elsif ($user_algorithm eq "sha512" )
{
$hash = sha512_base64($password.$user_salt);
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
if ($user_hash_count > 0)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user_hash_count => $user_hash_count }});
for (1..$user_hash_count)
{
$hash = sha512_base64($hash);
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { hash => $hash }});
}
}
else
{
# Bad algorith.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0173", variables => { user_algorithm => $user_algorithm }});
return($valid);
}
# Test.
if ($hash eq $user_password_hash)
{
# Good password.
$valid = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
}
return($valid);
}
# =head3
#
# Private Functions;
#
# =cut
#############################################################################################################
# Private functions #
#############################################################################################################
=head2 _build_cookie_hash
This takes a (user) UUID and offset (stated as seconds) and builds a hash approporiate for use in cookies (or a test hash to validate a read cookie hash). The resulting hash and the salt used to generate the hash are returned.
If there is a problem, C<< 0 >> will be returned for both the hash and salt.
Parameters;
=head3 offset (optional, default '0')
This is used to offset the date when generating the date part of the string to hash. It is passed as-is directly to C<< Get->date_and_time >>.
=head3 user_agent (optional, default 'HTTP_USER_AGENT' environment variable)
This is the user agent to use when generating the string to hash.
=head3 uuid (optional, default 'cookie::anvil_user_uuid')
This is the UUID to use when generating the string to hash. Generally it is the user's UUID.
=cut
sub _build_cookie_hash
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $offset = defined $parameter->{offset} ? $parameter->{offset} : 0;
my $user_agent = defined $parameter->{user_agent} ? $parameter->{user_agent} : $ENV{HTTP_USER_AGENT};
my $salt = defined $parameter->{salt} ? $parameter->{salt} : "";
my $uuid = defined $parameter->{uuid} ? $parameter->{uuid} : $anvil->data->{cookie}{anvil_user_uuid};
# I know I could do chained conditionals, but it gets hard to read.
$user_agent = "" if not defined $user_agent;
$uuid = "" if not defined $uuid;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
offset => $offset,
user_agent => $user_agent,
salt => $salt,
uuid => $uuid,
}});
if (not $anvil->Validate->is_uuid({uuid => $uuid}))
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Account->_build_cookie_hash()", parameter => "uuid" }});
return(0, 0);
}
if (not $user_agent)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Account->_build_cookie_hash()", parameter => "user_agent" }});
return(0, 0);
}
my $date = $anvil->Get->date_and_time({date_only => 1, offset => $offset});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { date => $date }});
my $session_string = $uuid.":".$date.":".$user_agent;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { session_string => $session_string }});
if (not $salt)
{
$salt = $anvil->Get->_salt;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { salt => $salt }});
}
# Generate a hash, but unike normal passwords, we won't re-encrypt it.
my $answer = $anvil->Account->encrypt_password({
debug => $debug,
hash_count => 0,
password => $session_string,
salt => $salt,
});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
hash => $answer->{user_password_hash},
salt => $answer->{user_salt},
}});
return($answer->{user_password_hash}, $answer->{user_salt});
}
=head2 _write_cookies
This sets (or clears) the user's cookies.
Parameters;
=head3 hash (optional)
This is the hash to use for the session. If it is blank, it will log the user out.
=head3 uuid (optional)
This is the UUID of the user. If it is blank, it will log the user out.
=cut
sub _write_cookies
{
my $self = shift;
my $parameter = shift;
my $anvil = $self->parent;
my $debug = defined $parameter->{debug} ? $parameter->{debug} : 3;
my $hash = defined $parameter->{hash} ? $parameter->{hash} : "";
my $uuid = defined $parameter->{uuid} ? $parameter->{uuid} : "";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
hash => $hash,
uuid => $uuid,
}});
# If we have a users ID, load the user details
if (($hash) && ($uuid))
{
# Write the cookies
print "Set-Cookie:anvil_user_uuid=".$uuid.";\n";
print "Set-Cookie:anvil_user_hash=".$hash.";\n";
# Load the user's details
$anvil->Account->read_details({
debug => $debug,
user_uuid => $uuid});
# Update the active language, if needed.
if ($anvil->data->{sys}{users}{user_language})
{
# Switch to the user's language
$anvil->Words->language({set => $anvil->data->{sys}{users}{user_language}});
}
}
else
{
print "Set-Cookie:anvil_user_uuid=; expires=-1d;\n";
print "Set-Cookie:anvil_user_hash=; expires=-1d;\n";
}
return(0);
}
1;