view release on metacpan or  search on metacpan

lib/Captcha/Peoplesign.pm  view on Meta::CPAN

    # TODO: remove this
    my $ps_wversion = '';

    my $status = '';
    ($status, $ps_sessionid) = $self->_get_peoplesign_sessionid(
       $ps_key,
       $ps_clientip,
       $ps_options,
       $ps_location,
       $ps_wversion,
       $ps_sessionid,
    );

    if ($status eq 'success') {
        # An iframe will only be displayed if javascript is disabled
        # in the browser.
        my $iframe_width = $args->{iframe_width} || PEOPLESIGN_IFRAME_WIDTH;
        my $iframe_height = $args->{iframe_height} || PEOPLESIGN_IFRAME_HEIGHT;
        
        return $self->_get_html_js(
            $ps_sessionid,
            $iframe_width,
            $iframe_height,
        );
    }
    
    return $self->_html->p('peoplesign is unavailable ($status)');
}

sub check_answer {
    my ($self, $args) = @_;

    ref $args eq 'HASH' || croak 'Arguments must be an hashref';
    my $ps_key = $args->{ps_key} || croak 'Provide ps_key';
    my $ps_location = $args->{ps_location} || croak 'Provide ps_location';
    my $ps_sessionid = $args->{ps_sessionid} || 'Provide ps_sessioid';
    my $ps_response = $args->{ps_response} || croak 'Provide ps_response';

    my $status = $self->_get_peoplesign_session_status(
        $ps_sessionid,
        $ps_response,
        $ps_location,
        $ps_key,
    );

    # If CAPTCHA is solved correcly, pass
    return { is_valid => 1 } if $status eq 'pass';

    # Usual states for which the user can not pass
    return { is_valid => 0, error => $status } if
        $status eq 'fail' || $status eq 'notRequested'
        || $status eq 'awaitingResponse';
    
    # If Peoplesign server has problems, do not pass but return
    # error so call decide if he/she wants to pass in such case
    return { is_valid => 0, error => $status }
        if $status eq 'badHTTPResponseFromServer';

    # If $status is invalidChallengeSessionID we can not allow the user to pass.
    # It's highly unusual for this to occur, and probably means the
    # peoplesignSession expired and the client session was still alive.
    # We now abandon this client session. This will trigger a new client session
    # and a new peoplesign session.
    return { is_valid => 0, error => $status . ' [' .$self->_get_caller_info_string() . ']' }
        if $status eq 'invalidChallengeSessionID';
        
    # All other cases are an exception, so croak!
    croak "Exception processing Peoplesign response: [status $status]"
        . $self->_get_caller_info_string();
}

# ## Private methods ##

# Contacts the peoplesign server to validate the user's response.
# Return: string ('pass', 'fail', 'awaitingResponse', 'badHTTPResponseFromServer')
sub _get_peoplesign_session_status {
    my $self = shift;
    my $peoplesignSessionID = shift || croak 'Provide challengeSessionID';
    my $peoplesignResponseString = shift || croak 'Provide response string';
    my $clientLocation = shift || "default";
    my $peoplesignKey = shift;

    $peoplesignResponseString = $self->_trim($peoplesignResponseString);

    my $ua = LWP::UserAgent->new();

    # Note that the constant values are referenced below using CONSTANT()
    # when they are needed as hash names. 
    my $response = $ua->post(
        PEOPLESIGN_GET_CHALLENGE_SESSION_STATUS_URL, {
            PEOPLESIGN_CHALLENGE_SESSION_ID_NAME()  => $peoplesignSessionID,
            PEOPLESIGN_CHALLENGE_RESPONSE_NAME()    => $peoplesignResponseString,
            privateKey                              => $peoplesignKey,
            clientLocation                          => $clientLocation
        }
    );

    return $self->_trim( $response->content )
        if ($response->is_success);
    
    $self->_print_error("bad HTTP response from server: " .$response ->status_line."\n", $self->_get_caller_info_string());
    return 'badHTTPResponseFromServer';
}

# Return value : array with 2 elements (status, eoplesignSessionID)
# A peoplesignSessionID is assigned to a given visitor and is valid
# until he/she passes a challenge
sub _get_peoplesign_sessionid {
    my $self = shift;
    my $peoplesignKey = shift;
    my $visitorIP = shift;
    my $peoplesignOptions = shift;
    my $clientLocation = shift || "default";
    my $pluginWrapperVersionInfo = shift;
    my $peoplesignSessionID = shift;

    my $ua = LWP::UserAgent->new();

    my $status;

    # Peoplesign callenge option string