view release on metacpan or  search on metacpan

AuthCookieLDAP.pm  view on Meta::CPAN

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

#-------------------------------------------------------------------------------
# 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 = $credentials[ 0 ];
	unless ( $user =~ /^.+$/ ) {
		$r->log_reason( "Apache::AuthCookieLDAP: no username supplied for auth realm $auth_name", $r->uri );
		return 'bad';
	}
	# Password goes in credential_1
	my $password = $credentials[ 1 ];
	unless ( $password =~ /^.+$/ ) {
		$r->log_reason( "Apache::AuthCookieLDAP: no password supplied for auth realm $auth_name", $r->uri );
		return 'bad';
	}

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




	# Connect to the host
	my $con;
	unless ($con = Net::LDAP->new($c{LDAP_host}))
	{
	    $r->log_reason("LDAP Connection Failed", $r->uri);
	    return 'bad';
	}
		
	# Bind annonymously


	my $mess = $con->bind();
	unless ($mess->code == LDAP_SUCCESS) {
	    $r->log_reason("LDAP Bind Failed", $r->uri);
	    return 'bad';
	}


	# Search for the user
	my $filter = "($c{LDAP_user}=$user)";
	if($c{LDAP_filter} ne "")
	{
	 $filter = "(& $filter ($c{LDAP_filter}))";
	}	
	$mess = $con->search(base => $c{LDAP_DN}, filter => $filter);
	unless ($mess->code == LDAP_SUCCESS) {
	    $r->log_reason("LDAP Search Failed", $r->uri);
	    return 'bad';
	}


	# Does the user exsists
	unless ($mess->count) {
	    $r->log_reason("User: $user does not excist", $r->uri);
	    return 'bad';
	}
  
	# Take the first user
	my $entry = $mess->first_entry;
	my $dn = $entry->dn;

	# Bind as the user we're authenticating
	$mess = $con->bind($dn, password => $password);
	unless ($mess->code == LDAP_SUCCESS) {
	    $r->log_reason("User $user har wrong password", $r->uri);
	    return 'bad';
	}
	$con->unbind;



	# Create the expire time for the ticket.
	my $expire_time;
	# expire time in a zillion years if it's forever.
	if ( lc $c{ LDAP_sessionlifetime } eq 'forever' ) {
		$expire_time = '9999-01-01-01-01-01';
	} else {
		my( $deltaday, $deltahour, $deltaminute, $deltasecond )
		   = split /-/, $c{ LDAP_sessionlifetime };
		# Figure out the expire time.
		$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.  *** DEBUG *** check this
	my $enc_user = _percent_encode $user;

	# OK, now we stick the username and the current time and the expire
	# time 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";

	# Now we calculate the hash of this and the secret key and then
	# calculate the hash of *that* and the secret key again.
	my $secret_key = $SECRET_KEYS{ $auth_name };
	unless ( defined $secret_key ) {
		$r->log_reason( "Apache::AuthCookieLDAP: didn't have the secret key for auth realm $auth_name", $r->uri );
		return 'bad';
	}
	my $hash = md5_hex( join ':', $secret_key, md5_hex(
		join ':', $public_part, $secret_key
	) );

	# 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;
	if ( $c{ LDAP_encryptiontype } eq 'none' ) {
		$encrypted_session_key = $session_key;
	} elsif ( lc $c{ LDAP_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{ LDAP_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{ LDAP_encryptiontype } eq 'blowfish' ) {