@ -13,8 +13,13 @@ my $THIS_FILE = "Account.pm";
### Methods;
# encrypt_password
# login
# logout
# read_cookies
# read_details
# validate_password
# _build_cookie_hash
# _write_cookies
= pod
@ -90,10 +95,24 @@ 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
{
@ -102,11 +121,15 @@ sub encrypt_password
my $ anvil = $ self - > parent ;
my $ debug = defined $ parameter - > { debug } ? $ parameter - > { debug } : 3 ;
my $ user_password_hash = defined $ parameter - > { password } ? $ parameter - > { password } : "" ;
my $ user_hash_count = $ anvil - > data - > { sys } { password } { hash_count } =~ /^\d+$/ ? $ anvil - > data - > { sys } { password } { hash_count } : 500000 ;
my $ user_algorithm = $ anvil - > data - > { sys } { password } { algorithm } ? $ anvil - > data - > { sys } { password } { algorithm } : "sha512" ;
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 = > {
password = > $ anvil - > Log - > secure ? $ user_password_hash : "--" ,
algorithm = > $ algorithm ,
hash_count = > $ hash_count ,
password = > $ anvil - > Log - > secure ? $ password : "#!string!log_0186!#" ,
salt = > $ salt ,
} } ) ;
# We'll fill these out below if we succeed.
@ -118,18 +141,37 @@ sub encrypt_password
} ;
# Make sure we got a string
if ( not $ user_ password_hash )
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 = $ anvil - > Get - > _salt ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > { user_salt = > $ user_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 ) ;
@ -193,21 +235,307 @@ sub encrypt_password
'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 ( { uuid = > $ anvil - > data - > { cookie } { anvil_user_uuid } , offset = > 0 } ) ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > {
session_hash = > $ session_hash ,
session_salt = > $ session_salt ,
} } ) ;
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 } ) ;
$ 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 )
{
die ;
# 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 ( { uuid = > $ anvil - > data - > { cookie } { anvil_user_uuid } , offset = > 0 } ) ;
my ( $ yesterday_hash ) = $ anvil - > Account - > _build_cookie_hash ( { uuid = > $ anvil - > data - > { cookie } { anvil_user_uuid } , 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
{
# 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 name and , if the user is found , reads in the details and sets C << sys::user:: < column names > >> . If the user is found , C << 1 >> is returned . If not , C << 0 >> is returned .
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_name ( required )
= head3 user_uuid ( optional )
This is the user name being searched for . It is case sensitive .
This is the user UUID being searched for . If i t is not set , C << cookie:: anvil_user_uuid >>
= cut
sub read_details
@ -217,12 +545,18 @@ sub read_details
my $ anvil = $ self - > parent ;
my $ debug = defined $ parameter - > { debug } ? $ parameter - > { debug } : 3 ;
my $ user_name = defined $ parameter - > { user_name } ? $ parameter - > { user_name } : "" ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > { user_name = > $ user_name } } ) ;
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_uuid ,
user_name ,
user_password_hash ,
user_salt ,
user_algorithm ,
@ -234,7 +568,7 @@ SELECT
FROM
users
WHERE
user_name = ".$anvil->data->{sys}{use_db_fh}->quote($user_name )."
user_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($user_uuid )."
; " ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > { query = > $ query } } ) ;
@ -247,9 +581,10 @@ WHERE
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_uuid = $ results - > [ 0 ] - > [ 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 ] ;
@ -259,7 +594,7 @@ WHERE
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_uuid = > $ user_uuid ,
user_name = > $ user_name ,
user_password_hash = > $ user_password_hash ,
user_salt = > $ user_salt ,
user_algorithm = > $ user_algorithm ,
@ -269,30 +604,37 @@ WHERE
user_is_experienced = > $ user_is_experienced ,
user_is_trusted = > $ user_is_trusted ,
} } ) ;
$ anvil - > data - > { sys } { user } { user_name } = $ user_name ;
$ anvil - > data - > { sys } { user } { user_uuid } = $ user_uuid ;
$ anvil - > data - > { sys } { user } { user_password_hash } = $ user_password_hash ,
$ anvil - > data - > { sys } { user } { user_salt } = $ user_salt ,
$ anvil - > data - > { sys } { user } { user_algorithm } = $ user_algorithm ,
$ anvil - > data - > { sys } { user } { user_hash_count } = $ user_hash_count ,
$ anvil - > data - > { sys } { user } { user_language } = $ user_language ,
$ anvil - > data - > { sys } { user } { user_is_admin } = $ user_is_admin ,
$ anvil - > data - > { sys } { user } { user_is_experienced } = $ user_is_experienced ,
$ anvil - > data - > { sys } { user } { 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::user::user_name' = > $ anvil - > data - > { sys } { user } { user_name } ,
'sys::user::user_uuid' = > $ anvil - > data - > { sys } { user } { user_uuid } ,
'sys::user::user_password_hash' = > $ anvil - > data - > { sys } { user } { user_password_hash } ,
'sys::user::user_salt' = > $ anvil - > data - > { sys } { user } { user_salt } ,
'sys::user::user_algorithm' = > $ anvil - > data - > { sys } { user } { user_algorithm } ,
'sys::user::user_hash_count' = > $ anvil - > data - > { sys } { user } { user_hash_count } ,
'sys::user::user_language' = > $ anvil - > data - > { sys } { user } { user_language } ,
'sys::user::user_is_admin' = > $ anvil - > data - > { sys } { user } { user_is_admin } ,
'sys::user::user_is_experienced' = > $ anvil - > data - > { sys } { user } { user_is_experienced } ,
'sys::user::user_is_trusted' = > $ anvil - > data - > { sys } { user } { user_is_trusted } ,
'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 ) ;
}
@ -325,7 +667,7 @@ sub validate_password
my $ valid = 0 ;
my $ hash = "" ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > {
password = > $ anvil - > Log - > secure ? $ password : "-- " ,
password = > $ anvil - > Log - > secure ? $ password : "#!string!log_0186!# " ,
user = > $ user ,
} } ) ;
@ -441,4 +783,128 @@ WHERE
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 ) .
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 $ 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 ,
uuid = > $ uuid ,
} } ) ;
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 } } ) ;
# Generate a hash, but unike normal passwords, we won't re-encrypt it.
my $ answer = $ anvil - > Account - > encrypt_password ( { password = > $ session_string , hash_count = > 0 } ) ;
my $ hash = $ answer - > { user_password_hash } ;
my $ salt = $ answer - > { user_salt } ;
$ anvil - > Log - > variables ( { source = > $ THIS_FILE , line = > __LINE__ , level = > $ debug , list = > {
hash = > $ hash ,
salt = > $ salt ,
} } ) ;
return ( $ hash , $ 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 ;
Digimer
7 years ago