Apache2-AuthCookieDBImg

 view release on metacpan or  search on metacpan

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

use Apache2::ServerUtil;
use Digest::MD5 qw( md5_hex );
use Date::Calc qw( Today_and_Now Add_Delta_DHMS );
# Also uses Crypt::CBC if you're using encrypted cookies.
# Also uses Apache2::Session if you're using sessions.

#===============================================================================
# F U N C T I O N   D E C L A R A T I O N S
#===============================================================================

sub _log_not_set($$);
sub _dir_config_var($$);
sub _dbi_config_vars($);
sub _now_year_month_day_hour_minute_second();
sub _percent_encode($);
sub _percent_decode($);

sub extra_session_info($$\@);
sub authen_cred($$\@);
sub authen_ses_key($$$);
sub group($$\@);

#===============================================================================
# P A C K A G E   G L O B A L S
#===============================================================================

use vars qw( %CIPHERS );
# Stores Cipher::CBC objects in $CIPHERS{ idea:AuthName },
# $CIPHERS{ des:AuthName } etc.
our @Extra_Data;		# CSA Patch - needed for keeping cookie active


#===============================================================================
# P R I V A T E   F U N C T I O N S
#===============================================================================

#-------------------------------------------------------------------------------
# _log_not_set -- Log that a particular authentication variable was not set.

sub _log_not_set($$) {
    my( $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    $r->log_error( "Apache2::AuthCookieDBImg: $variable not set for auth realm $auth_name", $r->uri );
}

#-------------------------------------------------------------------------------
# _dir_config_var -- Get a particular authentication variable.

sub _dir_config_var($$) {
    my( $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    return $r->dir_config( "$auth_name$variable" );
}

#-------------------------------------------------------------------------------
# _dbi_config_vars -- Gets the config variables from the dir_config and logs
# errors if required fields were not set, returns undef if any of the fields
# had errors or a hash of the values if they were all OK.  Takes a request
# object.

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

Force the session cookie expiration to reset whenever user activity is
detected (new page loaded, etc.).  This allows a low expiration time (5 minutes)
that logs off when a session is inactive.  Active sessions will be granted
more time each time they perform an action.

This is not required and defaults to 0 (Expire X minutes after initial logon).

=cut

sub _dbi_config_vars($) {
    my( $r ) = @_;
    my %c; # config variables hash

    unless ( $c{ DBI_DSN } = _dir_config_var $r, 'DBI_DSN' ) {
        _log_not_set $r, 'DBI_DSN';
        return undef;
    }

    unless ( $c{ DBI_secretkey } = _dir_config_var $r, 'DBI_SecretKey' ) {
        _log_not_set $r, 'DBI_SecretKey';

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

    # If we used encryption we need to pull in Crypt::CBC.
    require Crypt::CBC if ( $c{ DBI_encryptiontype } ne 'none' );

    return %c;
}

#-------------------------------------------------------------------------------
# _now_year_month_day_hour_minute_second -- Return a string with the time in
# this order separated by dashes.

sub _now_year_month_day_hour_minute_second()
{
    return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now;
}

#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.

sub _percent_encode($)
{
    my( $str ) = @_;
    $str =~ s/([^\w])/ uc sprintf '%%%02x', ord $1 /eg;
    return $str;
}

#-------------------------------------------------------------------------------
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in
# the supplied string.

sub _percent_decode($)
{
    my( $str ) = @_;
    $str =~ s/%([0-9a-fA-F]{2})/ pack( "c",hex( $1 ) ) /ge;
    return $str;
}

#===============================================================================
# P U B L I C   F U N C T I O N S
#===============================================================================

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

sub extra_session_info ($$\@) {
    my ($self, $r, @credentials) = @_;
    return '';
}

#-------------------------------------------------------------------------------
# Take the credentials for a user and check that they match; if so, return
# a new session key for this user that can be stored in the cookie.
# If there is a problem, return a bogus session key.

sub authen_cred($$\@)
{
    my( $self, $r, @credentials ) = @_;

    my $auth_name = $r->auth_name;

    # Username goes in credential_0
    my $user = shift @credentials;
    unless ( $user =~ /^.+$/ ) {
        $r->log_error( "Apache2::AuthCookieDBI: no username supplied for auth realm $auth_name", $r->uri );
        return undef;

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

    # CSA Patch - New gen_key function for activity reset
	 # on cookies
    #
    return $self->gen_key($r, $user, \@Extra_Data);
}

#-------------------------------------------------------------------------------
# Take a session key and check that it is still valid; if so, return the user.

sub authen_ses_key($$$)
{
    my( $self, $r, $encrypted_session_key ) = @_;

    my $auth_name = $r->auth_name;

	 # Enable Debugging In Here
    my $debug = $r->dir_config("AuthCookieDebug") || 0;

    # Get the configuration information.
    my %c = _dbi_config_vars $r;

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

    # They must be okay, so return the user.
    return $user;
}

#-------------------------------------------------------------------------------
# 
# Separated gen_key from authen_cred
#
sub gen_key($$$)
{
	my( $self, $r, $user, $refExtraData ) = @_;

	my %c 			= _dbi_config_vars $r;
	my $auth_name 	= $r->auth_name;

	#----- Generate The Key Stuff...

    # Create the expire time for the ticket.
    my $expire_time;

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

    }

    return $encrypted_session_key;
}


#-------------------------------------------------------------------------------
# Take a list of groups and make sure that the current remote user is a member
# of one of them.

sub group($$\@)
{
    my( $self, $r, $groups ) = @_;
    my @groups = split(/\s+/o, $groups);

    my $auth_name = $r->auth_name;

    # Get the configuration information.
    my %c = _dbi_config_vars $r;

    my $user = $r->user;