Apache2_4-AuthCookieMultiDBI
view release on metacpan or search on metacpan
lib/Apache2_4/AuthCookieMultiDBI.pm view on Meta::CPAN
},
idea => sub {
return $CIPHERS{"idea:$auth_name"}
|| Crypt::CBC->new( -key => $secret_key, -cipher => 'IDEA' );
},
blowfish => sub {
return $CIPHERS{"blowfish:$auth_name"}
|| Crypt::CBC->new(
-key => $secret_key,
-cipher => 'Blowfish'
);
},
blowfish_pp => sub {
return $CIPHERS{"blowfish_pp:$auth_name"}
|| Crypt::CBC->new(
-key => $secret_key,
-cipher => 'Blowfish_PP'
);
},
);
my $code_ref = $cipher_for_type{$lc_encryption_type}
|| Carp::confess("Unsupported encryption type: '$dbi_encryption_type'");
my $cbc_object = $code_ref->();
# Cache the object. Caught bug where we were not, thanks to unit tests.
$CIPHERS{"$lc_encryption_type:$auth_name"} = $cbc_object;
return $cbc_object;
}
#-------------------------------------------------------------------------------
# _defined_or_empty - Takes a list and returns a list of the same size.
# Any element in the inputs that is defined is returned unchanged. Elements that
# were undef are returned as empty strings.
#
sub _defined_or_empty {
my @args = @_;
my @all_defined = ();
foreach my $arg (@args) {
if ( defined $arg ) {
push @all_defined, $arg;
}
else {
push @all_defined, EMPTY_STRING;
}
}
return @all_defined;
}
#-------------------------------------------------------------------------------
# _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;
my ( $pkg, $file, $line, $sub ) = caller(1);
my $info_message = "${self} -> _dbi_connect called in $sub at line $line";
$r->server->log_error( $info_message );
my %c = $self->_dbi_config_vars($r);
my $auth_name = $r->auth_name;
# get the crypted password from the users database for this user.
my $dbh = DBI->connect_cached( $c{'DBI_DSN'}, $c{'DBI_User'}, $c{'DBI_Password'} );
if ( !defined $dbh ) {
my $error_message = "${self} => couldn't connect to $c{'DBI_DSN'} for auth realm $auth_name";
$r->server->log_error( $error_message );
return;
}
if($c{'DBI_LoadClientDB'}) {
my $client = $self->get_client_name($r);
$dbh = $self->_dbi_connect_to_client($r, $client);
}
if ( defined $dbh ) {
my $info_message = "${self} => connect to $c{'DBI_DSN'} for auth realm $auth_name";
$r->server->log_error( $info_message );
return $dbh;
}
}
#-------------------------------------------------------------------------------
# _dbi_connect_to_client -- Get a database handle for client database.
#
sub _dbi_connect_to_client {
my ($self, $r, $client) = @_;
my $auth_name = $r->auth_name;
my %c = $self->get_client_database_info($r, $client);
$r->server->log_error("dbhost = $c{'dbhost'}; dbname = $c{'dbname'}; dblogin = $c{'dblogin'}; dbpass = $c{'dbpass'}:");
my $dbi_dns = "DBI:mysql:database=$c{'dbname'}:host=$c{'dbhost'}";
my $dbh = DBI->connect_cached( $dbi_dns, $c{'dblogin'}, $c{'dbpass'});
if ( !defined $dbh ) {
my $error_message = "${self} => couldn't connect to $c{'DBI_DSN'} for auth realm $auth_name";
$r->server->log_error( $error_message );
lib/Apache2_4/AuthCookieMultiDBI.pm view on Meta::CPAN
if ( $encryptiontype eq 'none' ) {
return $encrypted_session_key;
}
my $auth_name = $r->auth_name;
my $session_key;
# Check that this looks like an encrypted hex-encoded string.
if ( $encrypted_session_key !~ HEX_STRING_REGEX ) {
my $message = "${self}\tencrypted session key '$encrypted_session_key' doesn't look like it's properly hex-encoded for auth realm $auth_name";
$r->server->log_error( $message );
return;
}
my $cipher = $self->_get_cipher_for_type( $encryptiontype, $auth_name,
$secret_key );
if ( !$cipher ) {
my $message = "${self}\tunknown encryption type '$encryptiontype' for auth realm $auth_name";
$r->server->log_error( $message );
return;
}
$session_key = $cipher->decrypt_hex($encrypted_session_key);
return $session_key;
}
#===============================================================================
# O V E R R I D F U N C T I O N S
#===============================================================================
#-------------------------------------------------------------------------------
# authen_ses_key -- Overrid authen_ses_key method from Apache2_4::AuthCookie
#
sub authen_ses_key ($$$) {
my ( $self, $r, $encrypted_session_key ) = @_;
my $auth_name = $r->auth_name;
# Get the configuration information.
my %c = $self->_dbi_config_vars($r);
# Get the secret key.
my $secret_key = $c{'DBI_SecretKey'};
if ( !defined $secret_key ) {
my $message = "${self} -> didn't have the secret key from for auth realm $auth_name";
$r->server->log_error( $message );
return;
}
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 ) {
my $message = "${self} -> bad expire time $expire_time recovered from ticket for user $user for auth_realm $auth_name";
$r->server->log_error( $message );
return;
}
if ( $hashed_string !~ THIRTY_TWO_CHARACTER_HEX_STRING_REGEX ) {
my $message = "${self} -> bad encrypted session_key $hashed_string recovered from ticket for user $user for auth_realm $auth_name";
$r->server->log_error( $message );
return;
}
# If we're using a session module, check that their session exist.
if ( $c{'DBI_sessionmodule'} ne 'none' ) {
my %session;
my $dbh = $self->_dbi_connect($r) || return;
my $tie_result = eval {
tie %session, $c{'DBI_sessionmodule'}, $session_id,
+{
Handle => $dbh,
LockHandle => $dbh,
};
};
if ( ( !$tie_result ) || $EVAL_ERROR ) {
my $message
= "${self} -> failed to tie session hash to '$c{'DBI_sessionmodule'}' using session id $session_id for user $user for auth_realm $auth_name, error was '$EVAL_ERROR'";
$r->server->log_error( $message );
return;
}
# Update a timestamp at the top level to make sure we sync.
$session{timestamp} = _now_year_month_day_hour_minute_second;
$r->pnotes( $auth_name, \%session );
}
# Calculate the hash of the user, issue time, expire_time and
# the secret key and the session_id and then the hash of that
# and the secret key again.
my $new_hash = md5_hex(
join q{:},
$secret_key,
md5_hex(
join q{:}, $enc_user, $issue_time, $expire_time,
$session_id, @rest, $secret_key
)
);
# Compare it to the hash they gave us.
if ( $new_hash ne $hashed_string ) {
my $message = "${self} -> hash '$hashed_string' in cookie did not match calculated hash '$new_hash' of contents for user $user for auth realm $auth_name";
$r->server->log_error( $message );
lib/Apache2_4/AuthCookieMultiDBI.pm view on Meta::CPAN
# They must be okay, so return the user.
return $user;
}
#-------------------------------------------------------------------------------
# authen_cred -- Overrid authen_cred method from Apache2_4::AuthCookie
#
sub authen_cred ($$\@) {
my $self = shift;
my $r = shift;
my $user = shift;
my $password = shift;
my @extra_data = @_;
my $auth_name = $r->auth_name;
( $user, $password ) = _defined_or_empty( $user, $password );
$user = trim($user);
if ( !length $user ) {
$r->server->log_error( "${self} no username supplied for auth realm $auth_name" );
return;
}
if ( !length $password ) {
$r->server->log_error( "${self} no password supplied for auth realm $auth_name" );
return;
}
if ( !$self->user_is_active( $r, $user ) ) {
my $message
= "${self}\tUser '$user' is not active for auth realm $auth_name.";
$r->server->log_error( $message );
return;
}
# get the configuration information.
my %c = $self->_dbi_config_vars($r);
# get the crypted password from the users database for this user.
my $crypted_password = $self->_get_crypted_password( $r, $user, \%c );
# now return unless the passwords match.
my $crypt_type = lc $c{'DBI_CryptType'};
if ( !$self->_check_password( $password, $crypted_password, $crypt_type ) )
{
my $message = "${self} crypt_type: '$crypt_type' - passwords didn't match for user '$user' for auth realm $auth_name";
$r->server->log_error( $message );
return;
}
# 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};
}
# OK, now we stick the username and the current time and the expire
# time and the session id (if any) together to make the public part
# of the session key:
my $current_time = _now_year_month_day_hour_minute_second;
my $public_part = "$enc_user:$current_time:$expire_time:$session_id";
$public_part
.= $self->extra_session_info( $r, $user, $password, @extra_data );
# Now we calculate the hash of this and the secret key and then
# calculate the hash of *that* and the secret key again.
my $secretkey = $c{'DBI_SecretKey'};
if ( !defined $secretkey ) {
my $message = "${self} -> didn't have the secret key for auth realm $auth_name";
$r->server->log_error( $message );
return;
}
my $hash = md5_hex( join q{:}, $secretkey,
md5_hex( join q{:}, $public_part, $secretkey )
);
# Now we add this hash to the end of the public part.
my $session_key = "$public_part:$hash";
# Now we encrypt this and return it.
my $encrypted_session_key = $self->_encrypt_session_key( $session_key, $secretkey, $auth_name, $c{'DBI_EncryptionType'} );
return $encrypted_session_key;
}
#-------------------------------------------------------------------------------
# get_client_name -- get cleint name for uri using config var
#
sub get_client_name {
my $self = shift;
my $r = shift || Apache->request;
my %c = $self->_dbi_config_vars($r);
my $uri_regx = $c{'DBI_URIRegx'};
my $uri = $r->uri;
my @metching = ($uri =~ /$uri_regx/);
return $metching[$c{'DBI_URIClientPos'}];
}
##
# trim value
##
sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
# sub get_cookie_path {
( run in 0.806 second using v1.01-cache-2.11-cpan-5a3173703d6 )