Apache2-AuthCookieDBImg

 view release on metacpan or  search on metacpan

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

# 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
#===============================================================================

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

#-------------------------------------------------------------------------------
# _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

        }
        $session_key = $cipher->decrypt_hex( $encrypted_session_key );
    }
    
    # Break up the session key.
    my( $enc_user, $issue_time, $expire_time, $session_id,
      $supplied_hash, @rest ) = split /:/, $session_key;

    # Let's check that we got passed sensible values in the cookie.
    unless ( $enc_user =~ /^[a-zA-Z0-9_\%]+$/ ) {
        $r->log_error( "Apache2::AuthCookieDBImg: bad percent-encoded user $enc_user recovered from session ticket for auth_realm $auth_name", $r->uri );
        return undef;
    }
    # decode the user
    my $user = _percent_decode $enc_user;
    unless ( $issue_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) {
        $r->log_error( "Apache2::AuthCookieDBImg: bad issue time $issue_time recovered from ticket for user $user for auth_realm $auth_name", $r->uri );
        return undef;
    }
    unless ( $expire_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) {
        $r->log_error( "Apache2::AuthCookieDBImg: bad expire time $expire_time recovered from ticket for user $user for auth_realm $auth_name", $r->uri );
        return undef;
    }
    unless ( $supplied_hash =~ /^[0-9a-fA-F]{32}$/ ) {
        $r->log_error( "Apache2::AuthCookieDBImg: bad hash $supplied_hash recovered from ticket for user $user for auth_realm $auth_name", $r->uri );

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

        $expire_time = sprintf(
            '%04d-%02d-%02d-%02d-%02d-%02d',
            Add_Delta_DHMS( Today_and_Now,
                            $deltaday, $deltahour,
                    $deltaminute, $deltasecond )
        );
    }

    # 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;

	#---- CSA :: NEW 2.03 Session Stuff
	# If we are using sessions, we create a new session for this login.
	my $session_id = '';
	if ( defined $c{ DBI_sessionmodule } ) {
	    my $dbh = DBI->connect( $c{ DBI_DSN },
	                            $c{ DBI_user }, $c{ DBI_password } );
	    unless ( defined $dbh ) {
	        $r->log_error( "Apache2::AuthCookieDBI: couldn't connect to $c{ DBI_DSN } for auth realm $auth_name", $r->uri );
	        return undef;