view release on metacpan or  search on metacpan

lib/CGI/Ex/Auth.pm  view on Meta::CPAN

    my $form = $self->form;

    # bounce to redirect
    if (my $redirect = $form->{ $self->key_redirect }) {
        $self->location_bounce($redirect);
        eval { die "Success login - bouncing to redirect" };
        return;

    # if they have cookies we are done
    } elsif (scalar(keys %{$self->cookies}) || $self->no_cookie_verify) {
        $self->success_hook;
        return $self;

    # need to verify cookies are set-able
    } elsif ($args->{'is_form'}) {
        $form->{$self->key_verify} = $self->server_time;
        my $url = $self->script_name . $self->path_info . "?". $self->cgix->make_form($form);

        $self->location_bounce($url);
        eval { die "Success login - bouncing to test cookie" };
        return;
    }
}

sub success_hook {
    my $self = shift;
    if (my $meth = $self->{'success_hook'}) {
        return $meth->($self);
    }
    return;
}

sub logout_hook {
    my $self = shift;
    if (my $meth = $self->{'logout_hook'}) {
        return $meth->($self);
    }
    return;
}

sub handle_failure {
    my $self = shift;
    my $args = shift || {};
    if (my $meth = $self->{'handle_failure'}) {
        return $meth->($self, $args);
    }
    my $form = $self->form;

    # make sure the cookie is gone
    my $key_c = $self->key_cookie;
    $self->delete_cookie({name => $key_c}) if exists $self->cookies->{$key_c};

    # no valid login and we are checking for cookies - see if they have cookies
    if (my $value = delete $form->{$self->key_verify}) {
        if (abs(time() - $value) < 15) {
            $self->no_cookies_print;
            return;
        }
    }

    # oh - you're still here - well then - ask for login credentials
    my $key_r = $self->key_redirect;
    local $form->{$key_r} = $form->{$key_r} || $self->script_name . $self->path_info . (scalar(keys %$form) ? "?".$self->cgix->make_form($form) : '');
    local $form->{'had_form_data'} = $args->{'had_form_data'} || 0;
    $self->login_print;
    my $data = $self->last_auth_data;
    eval { die defined($data) ? $data : "Requesting credentials" };

    # allow for a sleep to help prevent brute force
    sleep($self->failed_sleep) if defined($data) && $data->error ne 'Login expired' && $self->failed_sleep;
    $self->failure_hook;

    return;
}

sub failure_hook {
    my $self = shift;
    if (my $meth = $self->{'failure_hook'}) {
        return $meth->($self);
    }
    return;
}

sub check_valid_auth {
    my $self = shift;
    $self = $self->new(@_) if ! ref $self;

    local $self->{'location_bounce'} = sub {}; # but don't bounce to other locations
    local $self->{'login_print'}     = sub {}; # check only - don't login if not
    local $self->{'set_cookie'}      = $self->{'no_set_cookie'} ? sub {} : $self->{'set_cookie'};
    return $self->get_valid_auth;
}

###----------------------------------------------------------------###

sub script_name { shift->{'script_name'} || $ENV{'SCRIPT_NAME'} || '' }

sub path_info { shift->{'path_info'} || $ENV{'PATH_INFO'} || '' }

sub server_time { time }

sub cgix {
    my $self = shift;
    $self->{'cgix'} = shift if @_ == 1;
    return $self->{'cgix'} ||= CGI::Ex->new;
}

sub form {
    my $self = shift;
    $self->{'form'} = shift if @_ == 1;
    return $self->{'form'} ||= $self->cgix->get_form;
}

sub cookies {
    my $self = shift;
    $self->{'cookies'} = shift if @_ == 1;
    return $self->{'cookies'} ||= $self->cgix->get_cookies;
}

sub delete_cookie {
    my $self = shift;
    my $args = shift;
    return $self->{'delete_cookie'}->($self, $args) if $self->{'delete_cookie'};
    local $args->{'value'}   = '';
    local $args->{'expires'} = '-10y';
    if (my $dom = $ENV{HTTP_HOST}) {
        $dom =~ s/:\d+$//;