view release on metacpan or  search on metacpan

lib/Apache2_4/AuthCookieMultiDBI.pm  view on Meta::CPAN

# _is_empty - check empty string
# 
sub _is_empty {
    my $string = shift;
    return TRUE if not defined $string;
    return TRUE if $string eq EMPTY_STRING;
    return;
}

#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.
# 
sub _percent_encode {
    my ($str) = @_;
    my $not_a_word = qr/ ( \W ) /x;
    $str =~ s/$not_a_word/ uc sprintf '%%%02x', ord $1 /xmeg;
    return $str;
}

#-------------------------------------------------------------------------------
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in
# the supplied string.
# 
sub _percent_decode {
    my ($str) = @_;
    my $percent_hex_string_regex = qr/ %([0-9a-fA-F]{2}) /x;
    $str =~ s/$percent_hex_string_regex/ pack( "c",hex( $1 ) ) /xmge;
    return $str;
}

#-------------------------------------------------------------------------------
# _dbi_connect -- Get a database handle.
# 
sub _dbi_connect {
    my ($self, $r) = @_;

    Carp::confess('Failed to pass Apache request object') if not $r;

lib/Apache2_4/AuthCookieMultiDBI.pm  view on Meta::CPAN

    my $session_key = $self->decrypt_session_key( $r, $c{'DBI_EncryptionType'}, $encrypted_session_key, $secret_key ) || return;

    # Break up the session key.
    my ( $enc_user, $issue_time, $expire_time, $session_id, @rest ) = split COLON_REGEX, $session_key;
    my $hashed_string = pop @rest;

    # Let's check that we got passed sensible values in the cookie.
    ($enc_user) = _defined_or_empty($enc_user);
    if ( $enc_user !~ PERCENT_ENCODED_STRING_REGEX ) {
        my $message = "${self} -> bad percent-encoded user '$enc_user' recovered from session ticket for auth_realm '$auth_name'";
        $r->server->log_error( $message );
        return;
    }

    # decode the user
    my $user = _percent_decode($enc_user);

    ($issue_time) = _defined_or_empty($issue_time);
    if ( $issue_time !~ DATE_TIME_STRING_REGEX ) {
        my $message = "${self} -> bad issue time '$issue_time' recovered from ticket for user $user for auth_realm $auth_name";
        $r->server->log_error( $message );
        return;
    }

    ($expire_time) = _defined_or_empty($expire_time);
    if ( $expire_time !~ DATE_TIME_STRING_REGEX ) {

lib/Apache2_4/AuthCookieMultiDBI.pm  view on Meta::CPAN

    # Successful login
    my $message = "${self} Successful login for $user for auth realm $auth_name";
    $r->server->log_error( $message );

    # Create the expire time for the ticket.
    my $expire_time = _get_expire_time( $c{'DBI_SessionLifetime'} );

    # Now we need to %-encode non-alphanumberics in the username so we
    # can stick it in the cookie safely.
    my $enc_user = _percent_encode($user);

    # If we are using sessions, we create a new session for this login.
    my $session_id = EMPTY_STRING;
    if ( $c{'DBI_sessionmodule'} ne 'none' ) {
        my $session = $self->_get_new_session( $r, $user, $auth_name,
            $c{'DBI_sessionmodule'}, \@extra_data );
        $r->pnotes( $auth_name, $session );
        $session_id = $session->{_session_id};
    }