Apache-AuthCookieDBIRadius

 view release on metacpan or  search on metacpan

AuthCookieDBIRadius.pm  view on Meta::CPAN

use Apache::AuthCookie;
use vars qw( @ISA );
@ISA = qw( Apache::AuthCookie );

use Apache;
use Apache::DBI;
use Apache::Constants;
use Apache::File;
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.

# Added IPC::ShareLite.
use IPC::ShareLite qw( LOCK_EX LOCK_SH LOCK_UN LOCK_NB );

# Added Radius.
use Authen::Radius;
use Tie::IxHash;


#===============================================================================

AuthCookieDBIRadius.pm  view on Meta::CPAN

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.

use vars qw( %SECRET_KEYS );
# Stores secret keys for MD5 checksums and encryption for each auth realm in
# $SECRET_KEYS{ AuthName }.

#===============================================================================
# S E R V E R   S T A R T   I N I T I A L I Z A T I O N
#===============================================================================

AuthCookieDBIRadius.pm  view on Meta::CPAN

	#<WhatEverDBI_EncryptionType>
	#What kind of encryption to use to prevent the user from looking at the fields
	#in the ticket we give them.  This is almost completely useless, so don't
	#switch it on unless you really know you need it.  It does not provide any
	#protection of the password in transport; use SSL for that.  It can be 'none',
	#'des', 'idea', 'blowfish', or 'blowfish_pp'.
	#This is not required and defaults to 'none'.'

	$c{ DBI_encryptiontype } = _dir_config_var( $r, 'DBI_EncryptionType' ) || 'none';

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

	#<WhatEverDBI_SessionLifetime>
	#How long tickets are good for after being issued.  Note that presently
	#Apache::AuthCookie does not set a client-side expire time, which means that
	#most clients will only keep the cookie until the user quits the browser.
	#However, if you wish to force people to log in again sooner than that, set
	#this value.  This can be 'forever' or a life time specified as:
	#DD-hh-mm-ss -- Days, hours, minute and seconds to live.
	#This is not required and defaults to '00-12-00-00' or 12 hours.

AuthCookieDBIRadius.pm  view on Meta::CPAN

	# Now we encrypt this and return it.
	my $encrypted_session_key;
	if ( $c{ DBI_encryptiontype } eq 'none' ) 
	{
		$encrypted_session_key = $session_key;
	} 
	elsif ( lc $c{ DBI_encryptiontype } eq 'des' ) 
	{
		$CIPHERS{ "des:$auth_name"      }
		   ||= Crypt::CBC->new( $secret_key, 'DES' );
		$encrypted_session_key = $CIPHERS{
			"des:$auth_name"
		}->encrypt_hex( $session_key );
	} 
	elsif ( lc $c{ DBI_encryptiontype } eq 'idea' ) 
	{
		$CIPHERS{ "idea:$auth_name"      }
		   ||= Crypt::CBC->new( $secret_key, 'IDEA'     );
		$encrypted_session_key = $CIPHERS{
			"idea:$auth_name"
		}->encrypt_hex( $session_key );
	} 
	elsif ( lc $c{ DBI_encryptiontype } eq 'blowfish' ) 
	{
		$CIPHERS{ "blowfish:$auth_name" }
		   ||= Crypt::CBC->new( $secret_key, 'Blowfish' );
		$encrypted_session_key = $CIPHERS{
			"blowfish:$auth_name"
		}->encrypt_hex( $session_key );
	}

	# update log_field field.
   if ($c{ DBI_log_field })
   {
	   my $cmd = "UPDATE $c{DBI_userstable} SET $c{DBI_log_field} = 'NOW' WHERE $c{DBI_userfield} = \'$user\';";

AuthCookieDBIRadius.pm  view on Meta::CPAN

		{
			$r->log_reason( "Apache::AuthCookieDBIRadius: encrypted session key $encrypted_session_key doesn't look like it's properly hex-encoded for auth realm $auth_name", $r->uri );
			return undef;
		}

		# Get the cipher from the cache, or create a new one if the
		# cached cipher hasn't been created, & decrypt the session key.
		my $cipher;
		if ( lc $c{ DBI_encryptiontype } eq 'des' ) {
			$cipher = $CIPHERS{ "des:$auth_name" }
			   ||= Crypt::CBC->new( $secret_key, 'DES' );
		} elsif ( lc $c{ DBI_encryptiontype } eq 'idea' ) {
			$cipher = $CIPHERS{ "idea:$auth_name" }
			   ||= Crypt::CBC->new( $secret_key, 'IDEA' );
		} elsif ( lc $c{ DBI_encryptiontype } eq 'blowfish' ) {
			$cipher = $CIPHERS{ "blowfish:$auth_name" }
			   ||= Crypt::CBC->new( $secret_key, 'Blowfish' );
		} elsif ( lc $c{ DBI_encryptiontype } eq 'blowfish_pp' ) {
			$cipher = $CIPHERS{ "blowfish_pp:$auth_name" }
			   ||= Crypt::CBC->new( $secret_key, 'Blowfish_PP' );
		} else {
			$r->log_reason( "Apache::AuthCookieDBIRadius: unknown encryption type $c{ DBI_encryptiontype } for auth realm $auth_name", $r->uri );
			return undef;
		}
		$session_key = $cipher->decrypt_hex( $encrypted_session_key );
	}
	
	# Break up the session key.
   my( $enc_user,$issue_time,$expire_time,$activeuser,$a,$b,$c,$d,$e,$f,$g,$supplied_hash )
	   = split /:/, $session_key;