XAO-Web

 view release on metacpan or  search on metacpan

lib/XAO/DO/Web/IdentifyUser.pm  view on Meta::CPAN

known. This adds an extra protection layer in case the database content
is stolen, but the site code is not.

=item vf_key_prop

The purpose of two optional parameters 'vf_key_cookie' and 'vf_key_prop'
is to limit verification to just one computer at a time. When
these parameters are present in the configuration on login success
'IdentifyUser' object generates random key, stores it into user's
profile, and creates a cookie named according to 'vf_key_cookie' with
the value of the generated key.

=item vf_key_length

By default keys are 8 characters long. Use this option to set a custom
key length. This only works for vf_key_prop single login keys. For
key_list_uri based keys they are auto-generated based on the storage
settings.

=item vf_key_cookie

Temporary verifiction key cookie.

=item vf_time_prop

Attribute of a user or key object that stores the time of the most
recent verified access.

Cleared on logout. Use 'vf_time_last_prop' for a persistent value.

=item vf_time_user_prop

Optional attribute of a user object that stores the time of the most
recent verified access. Useful when key_list_uri is in use and
vf_time_prop point to a value within the key store, not the user.

=item vf_time_last_prop

Optional persistent user property name where the time of the most recent
verified access is stored. It is not cleared on logout.

=item vf_expire_time

Time period for which user remains verified.

Please note, that the cookie with the customer key will be set to expire
in 10 years and actual expiration will only be checked using the content
of 'vf_time_prop' field value. The reason for such behavior is that many
(if not all) versions of Microsoft IE have what can be considered a
serious bug -- they compare the cookie expiration time to the local time
on the computer. And therefore if customer computer is accidentally set
to some future date the cookie might expire immediately and prevent this
customer from logging into the system at all. Most (if not all) versions
of Netscape and Mozilla do not have this problem.

Therefore, when possible we do not trust customer's computer to measure
time for us and do that ourselves.

=item cb_uri

URI of clipboard where IdentifyUser stores identification and
verification information about user and makes it globally available.

=back

=head1 RESULTS

In addition to displaying the correct template, results of user
verification or identification are stored in the clipboard. Base
clipboard location is determined by 'cb_uri' configuration parameter and
defaults to '/IdentifyUser/TYPE', where TYPE is the type of user.

Parameters that are stored into the clipboard are:

=over

=item id

The internal ID of the user object (same as returned by container_key()
method on the object).

=item name

Name as used in the 'login' mode. If 'user_prop' configuration parameter
is not used then it is always the same as 'id'.

=item object

Reference to the user object loaded from the database.

=item verified

This is only set when user has 'verified' status.

=back

Additional information will also be stored if 'user_prop'
refers to deeper objects. For example, if user_prop is equal to
'Nicknames/nickname' then it is assumed that there is a list inside
of user objects called Nicknames and there is a property in that list
called 'nickname'. It is also implied that the 'nickname' is unique
throughout all objects of its class.

Information that gets stored in the clipboard in that case is:

=over

=item list_prop

Name of the list property of the user object that is used in
'user_prop'. In our example it will be 'Nicknames'.

=item Nicknames (only for the example above)

Name of the list property is used to store a hash containing 'id',
'object' and probably 'list_prop' for the next object in the 'user_prop'
path (although in practice it is hard to imagine a situation where more
then one level is required).

=back

=head1 EXAMPLES

Now, let us look at some examples that show how each mode works.

=head2 LOGIN MODE

 <%IdentifyUser mode="login"
   type="customer"
   username="<%CgiParam param="username" %>
   password="<%CgiParam param="password" %>
   anonymous.path="/bits/login.html"
   verified.path="/bits/thankyou.html"
 %>

=head2 LOGOUT MODE

 <%IdentifyUser mode="logout"
   type="customer"
   anonymous.path="/bits/thankyou.html"
   identified.path="/bits/thankyou.html"
   hard_logout="<%CgiParam param="hard_logout" %>"
 %>

=head2 CHECK MODE

 <%IdentifyUser mode="check"
   type="customer"
   anonymous.path="/bits/login.html"
   identified.path="/bits/order.html"
   verified.path="/bits/order.html"
 %>

=head1 METHODS

=over

=cut

###############################################################################
package XAO::DO::Web::IdentifyUser;
use strict;
use Authen::SASL::SASLprep qw(saslprep);
use Crypt::URandom qw();

lib/XAO/DO/Web/IdentifyUser.pm  view on Meta::CPAN

use MIME::Base64 qw(encode_base64 decode_base64);
use Unicode::Normalize qw(NFKC);
use XAO::Errors qw(XAO::DO::Web::IdentifyUser);
use XAO::Objects;
use XAO::Utils;
use base XAO::Objects->load(objname => 'Web::Action');

our $VERSION='2.16';

###############################################################################

sub check_mode($;%);
sub check ($@);
sub before_display ($@);
sub display_results ($$$;$);
sub _get_user_props($$$);
sub find_user ($$$;$);
sub login_errstr ($@);
sub login ($;%);
sub login_password_encrypt ($@);
sub login_check ($%);
sub logout ($@);
sub data_password_check ($@);
sub data_password_encrypt ($@);
sub _get_config ($@);
sub verify_check ($%);

###############################################################################

=item check_mode (%)

Checks operation mode and redirects to a method accordingly.

=cut

sub check_mode($;%){
    my $self=shift;
    my $args=get_args(\@_);
    my $mode=$args->{'mode'} || 'check';

    if($mode eq 'check') {
        $self->check($args);
    }
    elsif($mode eq 'login') {
        $self->login($args);
    }
    elsif($mode eq 'logout') {
        $self->logout($args);
    }
    else {
        throw $self "- no such mode '$mode'";
    }
}

##############################################################################

=item check ()

Checks identification/verification status of the user.

To determine identification status, first check clipboard to determine
if there is such object present. If so, then that object identifies the
user.

If not, then depending on 'id_cookie_type' parameter (that defaults to
'name') check whether there is an identification cookie or key cookie
and if so, perform a search for object in database. If this search
yields a positive result, the user's status is 'identified' and an
attempt to verify user is made, otherwise the status is 'anonymous'.

Identification by key only works when keys are stored in a separate list.

Once identity is established, to determine verification status, first
check the clipboard to determine if there is a 'verified' flag set. If
so, then the user's status is 'verified'. If not, check whether the
difference between the current time and the time of the latest visit is
less than vf_expire_time property. If so, the user status considered
'verified', a new time is stored.

If optional 'vf_key_prop' and 'vf_key_cookie' parameters are present in
the configuration then one additional check must be performed before
changing status to 'verified' - the content of the key cookie and
apropriate field in the user profile must match.

=cut

sub check ($@) {
    my $self=shift;
    my $args=get_args(\@_);

    my ($config,$type)=$self->_get_config($args);

    my $clipboard=$self->clipboard;

    my $cookie_domain=$config->{'domain'};

    my $without_cookies=$args->{'without_cookies'};

    # These are useful for both verification and identification cookies.
    #
    my $vf_time_prop=$config->{'vf_time_prop'} ||
        throw $self "No 'vf_time_prop' in the configuration";
    my $current_time=time;
    my $last_vf;

    # Checking if we already have user in the clipboard. If not -- checking
    # the cookie and trying to load from the database.
    #
    my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
    my $id_cookie_type=$config->{'id_cookie_type'} || 'name';
    my $key_list_uri=$config->{'key_list_uri'};
    my $key_ref_prop=$config->{'key_ref_prop'};

    my $data=$clipboard->get($cb_uri);
    my $user=$data ? $data->{'object'} : undef;
    my $key_object=$data ? $data->{'key_object'} : undef;

    if(!$data || !$user) {
        $data=undef;

        my $id_cookie=$config->{'id_cookie'} ||
            throw $self "- no 'id_cookie' in the configuration";

        my $cookie_value=$without_cookies
                ? $args->{'id_cookie_value'}
                : $self->siteconfig->get_cookie($id_cookie);

        if(!$cookie_value) {
            return $self->display_results($args,'anonymous');
        }

        my $list_uri=$config->{'list_uri'} ||
            throw $self "- no 'list_uri' in the configuration";

        # With key we may have multiple logins from the same user at the
        # same time. Finding the specific key and verifying.
        #
        if($id_cookie_type eq 'key') {
            $key_list_uri || throw $self "- key_list_uri required";
            $key_ref_prop || throw $self "- key_ref_prop required";

            my $user_list=$self->odb->fetch($list_uri);
            my $key_list=$self->odb->fetch($key_list_uri);
            my $user_id;
            my $user_obj;
            try {
                $key_list->check_name($cookie_value) ||
                    throw $self "- invalid cookie value";

                $key_object=$key_list->get($cookie_value);

                ($user_id,$last_vf)=$key_object->get($key_ref_prop,$vf_time_prop);

                $user_obj=$user_list->get($user_id);
            }
            otherwise {
                my $e=shift;
                dprint "IGNORED(OK): $e";
            };

            $user_obj || return $self->display_results($args,'anonymous');

            $data={
                object          => $user_obj,
                id              => $user_id,
                name            => $cookie_value,
                key_object      => $key_object,
                key             => $cookie_value,
            };
        }

        # When cookie is based on ID we can't use find_user() as the
        # value in cookie is not the same as what was given in login.
        #

lib/XAO/DO/Web/IdentifyUser.pm  view on Meta::CPAN


            foreach my $user_prop (@$user_props) {
                my @names=split(/\/+/,$user_prop);

                next unless scalar(@names)==scalar(@ids);

                my %d;

                try {
                    my $obj;
                    my $dref=\%d;

                    for(my $i=0; $i!=@names; $i++) {
                        my $name=$names[$i];
                        my $id=$ids[$i];

                        my $obj=$list->get($id);

                        $dref->{'object'}=$obj;
                        $dref->{'id'}=$id;

                        $list=$obj->get($name);

                        if(ref $list) {
                            $dref->{'list_prop'}=$name;
                            $dref=$dref->{$name}={};
                        }
                        else {
                            $d{'name'}=$list;
                        }
                    }
                }
                otherwise {
                    my $e=shift;
                    dprint "IGNORED(OK): $e";
                    %d=();
                };

                if($d{'object'}) {
                    $d{'property'}=$user_prop;
                    $data=\%d;
                    last;
                }
            }
        }
        elsif($id_cookie_type eq 'name') {
            $data=$self->find_user($config,$cookie_value,$args->{'skip_user_condition'});
        }
        else {
            throw $self "- unknown id_cookie_type ($id_cookie_type)";
        }

        if(!$data) {
            return $self->display_results($args,'anonymous');
        }

        # This is mostly useful for multi-key logins
        #
        $data->{'cookie_value'}=$cookie_value;

        # Saving identified user to the clipboard
        #
        $clipboard->put($cb_uri => $data);
        $user=$data->{'object'};

        # Updating cookie
        #
        unless($without_cookies) {
            my $id_cookie_expire=$config->{'id_cookie_expire'} || 4*365*24*60*60;

            $self->siteconfig->add_cookie(
                -name    => $id_cookie,
                -value   => $cookie_value,
                -path    => '/',
                -expires => '+' . $id_cookie_expire . 's',
                -domain  => $cookie_domain,
            );
        }
    }

    # Checking clipboard to determine if 'verified' flag is set and
    # if so user's status is 'verified'.
    #
    my $verified=$clipboard->get("$cb_uri/verified");
    if(!$verified) {
        my $vcookie;

        my $vf_key_cookie=$config->{'vf_key_cookie'};
        my $key_cookie_value;
        if($vf_key_cookie) {
            $key_cookie_value=$without_cookies
                                ? $args->{'key_cookie_value'}
                                : $self->siteconfig->get_cookie($vf_key_cookie);
        }

        # If we have a list of keys find the key that belongs to this
        # browser. If there is not one, assume at most 'identified'
        # status.
        #
        my $key_expire_ext_prop=$config->{'key_expire_ext_prop'};
        my $extended;
        if(!$key_list_uri) {
            $last_vf=$user->get($vf_time_prop);
        }
        else {
            if(!$key_object) {
                $vf_key_cookie ||
                    throw $self "- either vf_key_cookie or id_cookie_type=key required for key_list_uri";

                my $key_list=$self->odb->fetch($key_list_uri);

                if($key_cookie_value && $key_list->check_name($key_cookie_value)) {
                    try {
                        $key_object=$key_list->get($key_cookie_value);
                    }
                    otherwise {
                        my $e=shift;
                        dprint "IGNORED(OK): $e";
                        $key_object=undef;
                    };
                }
            }

            if(!$key_object) {
                $last_vf=0;
            }
            else {
                my ($key_user_id,$key_last_vf);

                if($key_expire_ext_prop) {
                    ($key_user_id,$key_last_vf,$extended)=$key_object->get($key_ref_prop,$vf_time_prop,$key_expire_ext_prop);
                    $data->{'extended'}=$extended;
                }
                else {
                    ($key_user_id,$key_last_vf)=$key_object->get($key_ref_prop,$vf_time_prop);
                }

                if($key_user_id eq $user->container_key) {
                    $last_vf=$key_last_vf;
                }
                else {
                    $key_object=undef;
                    $last_vf=0;
                }
            }

            $clipboard->put("$cb_uri/key_object" => $key_object);
        }

        # Checking the difference between the current time and the time
        # of last verification
        #
        my $vf_expire_time=$config->{'vf_expire_time'} ||
            throw $self "No 'vf_expire_time' in the configuration";

        my $vf_expire_ext_time=$config->{'vf_expire_ext_time'} || 0;

        $vf_expire_time=$vf_expire_ext_time if $extended && $vf_expire_ext_time;

        if($last_vf && $current_time - $last_vf <= $vf_expire_time) {

            # If optional 'vf_key_prop' and 'vf_key_cookie' parameters
            # are present checking the content of the key cookie and
            # appropriate field in the user profile
            #
            if(!$key_list_uri && $config->{'vf_key_prop'} && $vf_key_cookie) {
                if($key_cookie_value && $key_cookie_value eq ($user->get($config->{'vf_key_prop'}) || '')) {
                    $verified=1;

                    $vcookie={
                        -name    => $config->{'vf_key_cookie'},
                        -value   => $key_cookie_value,
                        -path    => '/',
                        -expires => '+4y',
                        -domain  => $cookie_domain,
                    };
                }
            }
            else {
                $verified=1;
            }
        }

        # Calling external overridable function to check if it is OK to
        # verify that user.
        #
        if($verified) {
            my $errstr=$self->verify_check(
                args    => $args,
                object  => $user,
                type    => $type,
            );

            if(!$errstr) {
                $clipboard->put("$cb_uri/verified" => 1);

                $clipboard->put("$cb_uri/key" => $key_cookie_value);

                my %user_data;

                $user_data{$config->{'vf_time_last_prop'}} = $current_time
                    if $config->{'vf_time_last_prop'};

                if($key_object) {
                    my $key_expire_prop=$config->{'key_expire_prop'} ||
                        throw $self "- key_expire_prop required";

                    $key_object->put(
                        $vf_time_prop       => $current_time,
                        $key_expire_prop    => $current_time+$vf_expire_time,
                    );

                    $user_data{$config->{'vf_time_user_prop'}} = $current_time
                        if $config->{'vf_time_user_prop'};
                }
                else {
                    $user_data{$vf_time_prop} = $current_time;
                }

                $user->put(%user_data) if %user_data;

                if($vcookie && !$without_cookies) {
                    $self->siteconfig->add_cookie($vcookie);
                }
            }
            else {
                $verified=0;
            }
        }
    }

    # If we failed to verify we remove the verification cookie.
    # That might help better track verification from browser side
    # applications and should not hurt anything else.
    #
    unless($without_cookies) {
        my $expire_mode=$config->{'expire_mode'} || 'keep';
        if(!$verified && $expire_mode eq 'clean') {
            if($id_cookie_type eq 'key') {
                $self->siteconfig->add_cookie(
                    -name    => $config->{'id_cookie'},
                    -value   => 0,
                    -path    => '/',
                    -expires => '-1d',
                    -domain  => $cookie_domain,
                );
            }
            elsif($config->{'vf_key_cookie'}) {
                $self->siteconfig->add_cookie(
                    -name    => $config->{'vf_key_cookie'},
                    -value   => 0,
                    -path    => '/',
                    -expires => '-1d',
                    -domain  => $cookie_domain,
                );
            }
        }
    }

    # Displaying results
    #
    my $status=$verified ? 'verified' : 'identified';

    $self->display_results($args,$status);
}

##############################################################################

=item before_display (%)

Overridable method that gets called just before displaying results after
all checks are done. Parameters it gets are:

 status     - one of 'anonymous', 'identified', or 'verified'
 type       - user type
 cbdata     - reference to clipboard data for the user
 config     - reference to the config for the user
 errstr     - error string, only available when called as part of login

Typically the method is used to add some other useful data to the
clipboard on successful checks and logins. By default does nothing.

=cut

sub before_display ($@) {
    return;
}

##############################################################################

=item display_results ($$;$)

Displays template according to the given status. Third optinal parameter
may include the content of 'ERRSTR'.

=cut

sub display_results ($$$;$) {
    my ($self,$args,$status,$errstr)=@_;

    my ($config,$type)=$self->_get_config($args);

    my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
    my $clipboard=$self->clipboard;

    $self->before_display(
        type        => $type,
        config      => $config,
        cbdata      => $clipboard->get($cb_uri) || { },
        status      => $status,
        errstr      => $errstr,
    );

    if($args->{"$status.template"} || $args->{"$status.path"}) {
        my $page=$self->object;
        $page->display($args,{
            path        => $args->{"$status.path"},
            template    => $args->{"$status.template"},
            CB_URI      => $cb_uri || '',
            ERRSTR      => $errstr || '',
            TYPE        => $type,
            NAME        => $clipboard->get("$cb_uri/name") || '',
            VERIFIED    => $clipboard->get("$cb_uri/verified") || '',
        });

        $self->finaltextout('') if $args->{'stop'};
    }
}

###############################################################################

sub _get_user_props($$$) {
    my ($self,$config,$list)=@_;

    my $user_props=$config->{'user_props'} || $config->{'user_prop'};

    # The default user name property is the list object key.
    #
    if(!$user_props) {
        my $obj=$list->get_new;
        my @x=grep { $obj->describe($_)->{'type'} eq 'key' } ($obj->keys);

        @x==1 || throw $self "- keyless list '".$list->uri."'";

        $user_props=\@x;
    }

    # User prop is a scalar or an array
    #
    if(!ref $user_props) {
        $user_props=[$user_props];
    }

    # This is a (deprecated) optional parameter to make it possible for
    # users to log in using this property as well as the default method.
    #
    my $alt_user_prop=$config->{'alt_user_prop'};
    if($alt_user_prop) {
        ref $alt_user_prop && throw $self "- 'alt_user_prop' needs to be a scalar";

        unshift(@$user_props,$alt_user_prop);
    }

    return $user_props;
}

##############################################################################

=item find_user ($$;$)

Searches for the user in the list according to the configuration:

    my $data=$self->find_user($config,$username);

Sets the same parameters in the returned hash as stored in the clipboard
except 'verified'.

=cut

sub find_user ($$$;$) {
    my ($self,$config,$username,$skip_user_condition)=@_;

    my $list_uri=$config->{'list_uri'} ||
        throw $self "- no 'list_uri' in the configuration";

    my $list=$self->odb->fetch($list_uri);

    my $user_props=$self->_get_user_props($config,$list);

    # We may optionally get a user selection condition in case the same
    # list contains elements not supposed to be used for log ins.
    #
    my $user_condition=$skip_user_condition ? undef : $config->{'user_condition'};

    # Finding the user.
    #
    foreach my $user_prop (@$user_props) {

        my $cond=[$user_prop,'eq',$username];

        # The user condition can be a hash or an array
        #
        my $ucond=$user_condition;
        if($ucond && ref($ucond) eq 'HASH') {
            $ucond=$ucond->{$user_prop};
        }
        if($ucond) {
            $cond=[$cond,'and',$ucond];
        }

        my $sr=$list->search($cond,{
            result => [ '#id',$user_prop ],
        });

        # Found?
        #
        if(@$sr==1) {
            my $obj=$list->get($sr->[0]->[0]);

            # Real username can be different even though we used
            # 'eq' to get to it (if props are not case sensitive).
            #
            my $real_username=$sr->[0]->[1];

            if($config->{'id_case_sensitive'}) {
                if($real_username ne $username) {
                    eprint "Case difference between '$real_username' and '$username'";
                    return undef;
                }
            }
            else {
                $username=$real_username;
            }

            my $result={

lib/XAO/DO/Web/IdentifyUser.pm  view on Meta::CPAN

                my $password_matches;

                my $errcode;

                try {
                    my $pwdata=$self->data_password_check(
                        type            => $type,
                        object          => $user,
                        config          => $config,
                        #
                        username        => $username,
                        password        => $password,
                        password_stored => $dbpass,
                    );

                    $pwdata ||
                        throw $self "- {{INTERNAL: No data returned}}";

                    $password_matches=$pwdata->{'password_matches'};
                }
                otherwise {
                    my $etext=''.shift;
                    $etext=$2 if $etext=~/\{\{\s*(?:([A-Z0-9_]+):\s*)?(.*)\}\}/;
                    $errcode=$1 || 'BAD_PASSWORD';
                    $password_matches=0;
                };

                # Empty passwords are never accepted
                #
                if(!length($dbpass) || $errcode || !$password_matches) {
                    $errstr=$self->login_errstr(
                        type    => $type,
                        object  => $user,
                        errcode => ($errcode || 'BAD_PASSWORD'),
                    );
                }
            }
        }
    }

    # Calling overridable function that can check some additional
    # conditions. Return a string with the suggested error message or an
    # empty string on success.
    #
    if(!$errstr) {
        $errstr=$self->login_check(
            name        => $username,
            object      => $user,
            password    => $password,
            type        => $type,
            cbdata      => $data,
            force       => $args->{'force'},
        );
    }

    # We know our fate at this point. Displaying anonymous path and
    # bailing out if there were errors.
    #
    # Also updating the count of failures if available.
    #
    my $clipboard=$self->clipboard;
    my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
    if($errstr) {

        # Anonymous user should not propagate anything identifyable -
        # resetting the data
        #
        $data={
            fail_locked => $fail_locked,
        };

        # We only increase failure counts when it's really a failure,
        # not when the account is locked
        #
        if($user) {
            if($fail_locked) {
                $data->{'fail_count'}=$user->get($fail_count_prop);
                $data->{'fail_max_count'}=$fail_max_count;
                $data->{'fail_max_count_reached'}=1;
            }
            else {
                my %ud;

                $ud{$fail_time_prop}=time if $fail_time_prop;

                if($fail_count_prop) {
                    $ud{$fail_count_prop}=($user->get($fail_count_prop) || 0) + 1;

                    # Making sure that the new failure count does not
                    # cross the maximum storable value.
                    #
                    my $fail_count_prop_maxvalue=$user->describe($fail_count_prop)->{'maxvalue'};
                    $ud{$fail_count_prop}=$fail_count_prop_maxvalue
                        if $fail_count_prop_maxvalue && $ud{$fail_count_prop}>$fail_count_prop_maxvalue;

                    $data->{'fail_count'}=$ud{$fail_count_prop};

                    if($fail_max_count) {
                        $data->{'fail_max_count'}=$fail_max_count;
                        $data->{'fail_max_count_reached'}=1 if $ud{$fail_count_prop}>$fail_max_count;
                    }
                }

                $user->put(\%ud) if %ud;
            }
        }

        $clipboard->put($cb_uri => $data);

        # A failure to login resets existing key cookies
        #
        unless($without_cookies) {
            if($id_cookie_type eq 'key') {
                $self->siteconfig->add_cookie(
                    -name    => $id_cookie,
                    -value   => '0',
                    -path    => '/',
                    -expires => '-1d',
                    -domain  => $cookie_domain,
                );
            }
            elsif($config->{'vf_key_cookie'}) {
                $self->siteconfig->add_cookie(
                    -name    => $config->{'vf_key_cookie'},
                    -value   => '0',
                    -path    => '/',
                    -expires => '-1d',
                    -domain  => $cookie_domain,
                );
            }
        }

        # Returning anonymouse, failed login verification
        #
        return $self->display_results($args,'anonymous',$errstr);
    }

    # Success!
    #
    # When we get here it means a successful login. Removing failure
    # time & count if needed.
    #
    if($fail_time_prop || $fail_count_prop) {
        $user->put(
            ($fail_time_prop ? ($fail_time_prop => 0) : ()),
            ($fail_count_prop ? ($fail_count_prop => 0) : ()),
        );
    }

    # If we have key_list_uri we store verification key there and ignore
    # vf_key_prop even if it exists.
    #
    my $vf_time_prop=$config->{'vf_time_prop'} ||
        throw $self "- no 'vf_time_prop' in the configuration";

    my $key_list_uri=$config->{'key_list_uri'};

    my $now=time;

    my %user_data;

    $user_data{$config->{'vf_time_last_prop'}} = $now
        if $config->{'vf_time_last_prop'};

    if($key_list_uri) {
        my $key_ref_prop=$config->{'key_ref_prop'} ||
            throw $self "- key_ref_prop required";
        my $key_expire_prop=$config->{'key_expire_prop'} ||

lib/XAO/DO/Web/IdentifyUser.pm  view on Meta::CPAN

    }

    # Setting login time
    #
    if(!$key_list_uri) {
        $user_data{$vf_time_prop} = $now;
    }

    # Storing user updates in one go (might be empty in rare case of
    # key-only tracking).
    #
    $user->put(%user_data) if %user_data;

    # Setting user name cookie depending on id_cookie_type parameter.
    #
    unless($without_cookies) {
        my $expire=$config->{'id_cookie_expire'}
                            ? "+$config->{'id_cookie_expire'}s"
                            : '+10y';

        if($id_cookie_type eq 'id') {
            my $cookie_value=$data->{'id'};
            my $r=$data;
            while($r->{'list_prop'}) {
                $r=$r->{$r->{'list_prop'}};
                $cookie_value.="/$r->{'id'}";
            };
            $self->siteconfig->add_cookie(
                -name    => $id_cookie,
                -value   => $cookie_value,
                -path    => '/',
                -expires => $expire,
                -domain  => $cookie_domain,
            );
            $data->{'cookie_value'}=$cookie_value;
        }
        elsif($id_cookie_type eq 'name') {
            $self->siteconfig->add_cookie(
                -name    => $id_cookie,
                -value   => $username,
                -path    => '/',
                -expires => $expire,
                -domain  => $cookie_domain,
            );
            $data->{'cookie_value'}=$username;
        }
        elsif($id_cookie_type eq 'key') {
            # already set above
        }
        else {
            throw $self "- unsupported id_cookie_type ($id_cookie_type)";
        }
    }

    # Yay! Verified.
    #
    $data->{'verified'}=1;

    $data->{'extended'}=($extended ? 1 : 0);

    # Storing values into the clipboard
    #
    $clipboard->put($cb_uri => $data);

    # Displaying results
    #
    $self->display_results($args,'verified');
}

###############################################################################

sub login_password_encrypt ($@) {
    my $self=shift;
    throw $self "- this method must be implemented in a derived class";
}

###############################################################################

=item login_check ()

A method that can be overriden in a derived object to check additional
conditions for letting a user in. Gets the following arguments as its
input:

 name       => name of user object
 password   => password
 object     => reference to a database object containing user info
 type       => user type
 cbdata     => reference to a hash that will be stored in clipboard on
               successful login

This method is called after all standard checks - it is guaranteed that
user object exists and password matches its database record.

Must return empty string on success or suggested error message on
failure. That error message will be passed in ERRSTR argument to the
templates.

=cut

sub login_check ($%) {
    return '';
}

###############################################################################

=item logout ()

Logs the user out.

Resets vf_time_prop if there is no vf_key_prop set as it is our only
proof of authentication in this case. If vf_key_prop is in use, then we
clear the key, but leave the time alone -- helps to see when this user
last logged in.

Clears identification cookie as well for hard logout mode. Sets user
status to 'anonymous' (hard logout mode) or 'identified'.

Will install data into clipboard in soft logout mode just the same way
as mode='check' does.

=cut

sub logout ($@) {
    my $self=shift;
    my $args=get_args(\@_);

    my ($config,$type)=$self->_get_config($args);

    my $without_cookies=$args->{'without_cookies'};
    my $cookie_domain=$config->{'domain'};

    # Logging in the user first. Skipping if 'logged_in' to avoid
    # recursion when we need to log the user out after some failed
    # checks.
    #
    unless($args->{'logged_in'}) {

        # Need to reset templates to avoid contaminating the output from
        # logout.
        #
        $self->check($args,{
            'mode'                  => 'check',
            'anonymous.path'        => undef,
            'anonymous.template'    => undef,
            'identified.path'       => undef,
            'identified.template'   => undef,
            'verified.path'         => undef,
            'verified.template'     => undef,
        });
    }

    # Checking if we're currently logged in at all -- either verified or
    # identified.
    #
    my $clipboard=$self->clipboard;
    my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
    my $cb_data=$clipboard->get($cb_uri);
    my $user=$cb_data->{'object'};

    # If there is no user at all -- then we're already logged out
    #
    $user || return $self->display_results($args,'anonymous');

    # Removing user last verification time only as a last resort --
    # it's useful to have it to know when the user last logged in. When
    # possible removing either the key from the list, or the key
    # property.
    #
    my $vf_time_prop=$config->{'vf_time_prop'} ||
        throw $self "- no 'vf_time_prop' in the configuration";
    my $key_list_uri=$config->{'key_list_uri'};
    my $vf_key_prop=$config->{'vf_key_prop'};
    my $vf_key_cookie=$config->{'vf_key_cookie'};
    my $deleted;

    if($vf_key_prop && $vf_key_cookie) {
        $user->put($vf_key_prop => '');
        $deleted=1;
    }

    my $key_object=$cb_data->{'key_object'};

    if($key_object) {
        $key_object->put($vf_time_prop => 0);
        $clipboard->delete("$cb_uri/key_object");
        $clipboard->delete("$cb_uri/extended");
        $deleted=1;
    }

    # Up to 1.93 the behavior was to only clear user level vf_time if
    # really necessary. The misguided idea was to preserve vf_time_prop
    # database value across logouts when the key is enough for security.
    # The leads to inconsistent behavior that depends on whether the key
    # is present and is deleted.
    #
    # With the introduction of persistent 'vf_time_last_prop' value, the
    # 'vf_time_prop/vf_time_user_prop' is always cleared.
    #
    my $vf_time_last_prop = $config->{'vf_time_last_prop'};
    if($vf_time_last_prop || (!$deleted && $cb_data->{'verified'})) {
        if($key_list_uri) {
            my $vf_time_user_prop=$config->{'vf_time_user_prop'};
            if($vf_time_user_prop) {
                $user->put($vf_time_user_prop => 0);
            }
            else {
                throw $self "- no key and no vf_time_user_prop in logout";
            }
        }
        else {
            $user->put($vf_time_prop => 0);
        }
    }

    # Deleting verification status from the clipboard
    #
    $clipboard->delete("$cb_uri/verified");
    $clipboard->delete("$cb_uri/key");

    # Not sure, but setting value to an empty string triggered a bug
    # somewhere, setting it to '0' instead and expiring it immediately.
    #
    # This is mainly so the user does not feel paranoid -- if if we were
    # to keep this cookie the user won't be in verified status any more
    # because last verification time was dropped to zero.
    #
    if(!$without_cookies && $vf_key_cookie) {
        $self->siteconfig->add_cookie(
            -name    => $vf_key_cookie,
            -value   => '0',
            -path    => '/',
            -expires => '-1d',
            -domain  => $cookie_domain,
        );
    }

    # Deleting user identification if hard_logout is set.
    #
    if($args->{'hard_logout'}) {
        $clipboard->delete($cb_uri);

        if($key_object) {
            $key_object->container_object->delete($key_object->container_key);
            $clipboard->delete("$cb_uri/key_object");
        }

        unless($without_cookies) {
            my $id_cookie=$config->{'id_cookie'} ||
                throw $self "- no 'id_cookie' in the configuration";

            $self->siteconfig->add_cookie(
                -name    => $id_cookie,
                -value   => '0',
                -path    => '/',
                -expires => '-1d',
                -domain  => $cookie_domain,
            );
        }

        return $self->display_results($args,'anonymous');
    }

    # We only get here if user is known, so returning 'identified'
    # status.
    #
    return $self->display_results($args,'identified');
}

###############################################################################

# Looping through possibly multiple password encryption algorithms to
# find the one potentially matching the stored password

sub data_password_check ($@) {
    my $self=shift;
    my $args=get_args(\@_);

    my $pass_encrypt=$args->{'pass_encrypt'};
    my $pass_pepper=$args->{'pass_pepper'};
    my $pass_normalize=$args->{'pass_normalize'};

    if(!defined $pass_encrypt || !defined $pass_pepper || !defined $pass_normalize) {
        my $config=$self->_get_config($args);
        $pass_encrypt//=$config->{'pass_encrypt'};
        $pass_pepper//=$config->{'pass_pepper'};
        $pass_normalize//=$config->{'pass_normalize'};
    }

    my $password_stored=$args->{'password_stored'} ||
        throw $self "- no password_stored given";

    # New stored passwords follow this format:
    #
    #  $ALG$SALT$DIGEST
    #
    # It overrides whatever specs were given as that is what we need to
    # compare to.
    #
    if((!$pass_encrypt || $pass_encrypt ne 'plaintext') && $password_stored=~/^\$(\w+)(?:-(\w+))?\$(.*?)\$.+/) {
        $pass_encrypt=lc($1);
        $pass_normalize=lc($2 // '');
    }

    # The legacy compatibility default.



( run in 0.617 second using v1.01-cache-2.11-cpan-f03e8824b8d )