view release on metacpan or  search on metacpan

lib/Apache2/AuthCookieDBI.pm  view on Meta::CPAN

            return Digest::SHA::sha384_hex($password) eq $crypted_password;
        },
        'sha512' => sub {
            return Digest::SHA::sha512_hex($password) eq $crypted_password;
        },
    );
    return $password_checker{$crypt_type}->();
}

#-------------------------------------------------------------------------------
# _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 ( $class, $r, $config_hash ) = @_;
    Carp::confess('Failed to pass Apache request object') if not $r;

lib/Apache2/AuthCookieDBI.pm  view on Meta::CPAN

    # Successful login
    my $message = "${class}\tSuccessful login for $user";
    $class->logger( $r, Apache2::Const::LOG_DEBUG, $message, $user,
        LOG_TYPE_AUTH, $r->uri );

    # 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 = $class->_get_new_session( $r, $user, $auth_name,
            $c{'DBI_sessionmodule'}, \@extra_data );
        $r->pnotes( $auth_name, $session );
        $session_id = $session->{_session_id};
    }

lib/Apache2/AuthCookieDBI.pm  view on Meta::CPAN

    # 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
            = "${class}\tbad percent-encoded user '$enc_user' recovered from session ticket for auth_realm '$auth_name'";
        $class->logger( $r, Apache2::Const::LOG_ERR, $message, undef,
            LOG_TYPE_SYSTEM, $r->uri );
        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
            = "${class}\tbad issue time '$issue_time' recovered from ticket for user $user for auth_realm $auth_name";
        $class->logger( $r, Apache2::Const::LOG_ERR, $message, $user,
            LOG_TYPE_SYSTEM, $r->uri );
        return;
    }