LdapUserLocalOverlay
This code is now deprecated. Please see the new LDAP page instead.
This code is part of the LDAP integration overlay; you'll also need LdapSiteConfigSettings and, optionally, LdapAutocreateAuthCallback.
Put this in [=${RTHOME}/local/lib/RT/User_Local.pm]:
### User_Local.pm overlay for LDAP authentication and information
### v1.1b2 2005.08.03 purp@acm.org
#
# The latest version of this module may be found at:
# http://wiki.bestpractical.com/view/LdapUserLocalOverlay
#
# THIS MODULE REQUIRES SETTINGS IN YOUR RT_SiteConfig.pm;
# you can find these at:
# http://wiki.bestpractical.com/view/LdapSiteConfigSettings
#
### CREDITS
# IsLDAPPassword() based on implementation of IsPassword() found at:
#
# http://www.justatheory.com/computers/programming/perl/rt/User_Local.pm.ldap
#
# Author's credits:
# Modification Originally by Marcelo Bartsch <bartschm_cl@hotmail.com>
# Update by Stewart James <stewart.james@vu.edu.au for rt3.
# Update by David Wheeler <david@kineticode.com> for TLS and
# Group membership support.
#
#
# CaonicalizeEmailAddress(), CanonicalizeUserInfo(), and LookupExternalInfo()
# based on work by Phillip Cole (phillip d cole @ uk d coltgroup d com)
# found at:
#
# http://wiki.bestpractical.com/view/AutoCreateAndCanonicalizeUserInfo
#
# His credits:
# based on CurrentUser_Local.pm and much help from the mailing lists
#
# All integrated, refactored, and updated by Jim Meyer (purp@acm.org)
#
# Changes:
# v1.1b2 (2006.08.03) Modified by Phil Cole
# * Add $LdapEmailAttrMatchPrefix config variable to make alternate email
# addresses work on Windows 2003 AD.
# v1.1b1 (2006.06.05) Punch-Drunk Hamster Release
# * Added UpdateFromLdap() to update the user's info from their LDAP entry;
# this also uses the newly invented $RT::*DisableFilter settings to know
# to disable their RT account when their LDAP account is disabled.
# * Added $RT::*DisableFilter settings for RT_SiteConfig.pm and refactored
# LdapConfigInfo() to include them. Also refactored logic to grep for
# filter keys rather than enumerate them
# * Added _GetBoundLdapObj() and refactored IsLdapPassword() and
# LookupExternalUserInfo() to use it
# * Added LdapConfigAuthAndInfoAreSame() to compare Auth and Info settings
# v1.0b1 (2006.01.06)
# * Added $RT::AuthMethods as basis for auth method lists;
# currently supports LDAP, Internal
# * Implemented Phillip Cole's suggested $RT::LdapAttrMap
# * Implemented $RT::LdapRTAttrMatchList and $RT::LdapEmailAttrMatchList
# to help guide LDAP searches more effectively
# * Added LdapAuth* and LdapInfo* variables to allow authentication
# and information from separate LDAP servers; didn't invalidate
# older Ldap{Server,Base,User,Pass,etc} variables.
# * Added LdapConfigInfo() to get integrated config info
no warnings qw(redefine);
use strict;
use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
# We only need Net::SSLeay if we're using TLS to encrypt our LDAP connections
require Net::SSLeay
if $RT::LdapTLS || $RT::LdapAuthTLS || $RT::LdapInfoTLS;
=head2 LdapConfigInfo
returns the LDAP attr mapped to EmailAddress in $RT::LdapAttrMap.
If no result is found, returns the ADDRESS passed in.
=cut
sub LdapConfigInfo {
my $self = shift;
my %config;
# Figure out what's what
$config{'AuthServer'} = $RT::LdapServer || $RT::LdapAuthServer;
$config{'AuthBase'} = $RT::LdapBase || $RT::LdapAuthBase;
$config{'AuthUser'} = $RT::LdapUser || $RT::LdapAuthUser;
$config{'AuthPass'} = $RT::LdapPass || $RT::LdapAuthPass;
$config{'AuthFilter'} = $RT::LdapFilter || $RT::LdapAuthFilter;
$config{'AuthGroup'} = $RT::LdapGroup || $RT::LdapAuthGroup;
$config{'AuthTLS'} = $RT::LdapTLS || $RT::LdapAuthTLS;
$config{'AuthSSLVersion'} = $RT::LdapSSLVersion || $RT::LdapAuthSSLVersion;
$config{'AuthDisableFilter'} =
$RT::LdapDisableFilter || $RT::LdapAuthDisableFilter;
# We grandfather in LdapGroupAttribute; we'll default
# to 'uniqueMember'
$config{'AuthGroupAttr'} =
$RT::LdapGroupAttribute || $RT::LdapGroupAttr ||
$RT::LdapAuthGroupAttr || 'uniqueMember';
# Figure out what's what
$config{'InfoServer'} = $RT::LdapServer || $RT::LdapInfoServer;
$config{'InfoBase'} = $RT::LdapBase || $RT::LdapInfoBase;
$config{'InfoUser'} = $RT::LdapUser || $RT::LdapInfoUser;
$config{'InfoPass'} = $RT::LdapPass || $RT::LdapInfoPass;
$config{'InfoFilter'} = $RT::LdapFilter || $RT::LdapInfoFilter;
$config{'InfoTLS'} = $RT::LdapTLS || $RT::LdapInfoTLS;
$config{'InfoSSLVersion'} = $RT::LdapSSLVersion || $RT::LdapInfoSSLVersion;
$config{'InfoDisableFilter'} =
$RT::LdapDisableFilter || $RT::LdapInfoDisableFilter;
# Filters need parens if they don't have 'em
foreach my $filter (grep {/Filter$/} keys(%config)) {
$config{$filter} = "($config{$filter})"
unless $config{$filter} =~ /^\(.*\)$/;
}
return wantarray ? %config : \%config;
}
sub LdapConfigAuthAndInfoAreSame {
my $self = shift;
my %ldap_config = $self->LdapConfigInfo();
# Quick lazy check: same number of keys for Auth and Info?
return 0
unless scalar(grep {/^Info/} keys(%ldap_config)) ==
scalar(grep {/^Auth/} keys(%ldap_config));
# Longer check
foreach my $key (grep {/^Auth/} keys(%ldap_config)) {
my ($key_base) = $key =~ /^Auth(.*)/;
return 0
unless $ldap_config{"Auth${key_base}"} eq
$ldap_config{"Info${key_base}"};
}
return 1;
}
sub IsLDAPPassword {
my $self = shift;
my $value = shift;
# Don't ask for external authentication unless enabled in RT_SiteConfig
unless ($RT::LdapExternalAuth) {
$RT::Logger->warning((caller(0))[3],
'$RT::LdapExternalAuth is not set');
return;
}
$RT::Logger->debug("Trying LDAP authentication\n");
# Figure out what's what
my %ldap_config = $self->LdapConfigInfo;
my $ldap_base = $ldap_config{'AuthBase'};
my $ldap_filter = $ldap_config{'AuthFilter'};
my $ldap_group = $ldap_config{'AuthGroup'};
my $ldap_group_attr = $ldap_config{'AuthGroupAttr'};
# Now let's get connected
my $ldap = $self->_GetBoundLdapObj('Auth', version=>3);
return unless ($ldap);
my $filter_string = '(&(' . $RT::LdapAttrMap->{'Name'} . '=' .
$self->Name . ')' . $ldap_filter . ')';
my $filter = Net::LDAP::Filter->new($filter_string);
my $ldap_msg = $ldap->search(base => $ldap_base,
filter => $filter,
attrs => ['dn']);
unless ($ldap_msg->code == LDAP_SUCCESS ||
$ldap_msg->code == LDAP_PARTIAL_RESULTS) {
$RT::Logger->debug((caller(0))[3], "search for", $filter->as_string,
"failed:", ldap_error_name($ldap_msg->code), $ldap_msg->code);
return;
}
unless ($ldap_msg->count == 1) {
$RT::Logger->info((caller(0))[3], "AUTH FAILED:", $self->Name);
return;
}
my $ldap_dn = $ldap_msg->first_entry->dn;
$RT::Logger->debug((caller(0))[3], "Found LDAP DN:", $ldap_dn);
$ldap_msg = $ldap->bind($ldap_dn, password => $value);
unless ($ldap_msg->code == LDAP_SUCCESS) {
$RT::Logger->info((caller(0))[3], "AUTH FAILED", $self->Name,
"(can't bind:", ldap_error_name($ldap_msg->code),
$ldap_msg->code, ")");
return;
}
# Is there an LDAP Group to check?
if ($ldap_group) {
$filter = Net::LDAP::Filter->new("(${ldap_group_attr}=${ldap_dn})");
$ldap_msg = $ldap->search(base => $ldap_group,
filter => $filter,
attrs => ['dn'],
scope => 'base');
unless ($ldap_msg->code == LDAP_SUCCESS ||
$ldap_msg->code == LDAP_PARTIAL_RESULTS) {
$RT::Logger->critical((caller(0))[3],
"Search for", $filter->as_string, "failed:",
ldap_error_name($ldap_msg->code), $ldap_msg->code);
return;
}
unless ($ldap_msg->count == 1) {
$RT::Logger->info((caller(0))[3], "AUTH FAILED:", $self->Name);
return;
}
}
# If we've survived to this point, we're good.
$RT::Logger->info((caller(0))[3], "AUTH OK:", $self->Name, "($ldap_dn)");
return 1;
}
sub IsInternalPassword {
my $self = shift;
my $value = shift;
unless ($self->HasPassword) {
$RT::Logger->info((caller(0))[3],
"AUTH FAILED (no passwd):", $self->Name);
return undef;
}
# generate an md5 password
if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
$RT::Logger->info((caller(0))[3],
"AUTH OKAY:", $self->Name);
return 1;
}
# if it's a historical password we say ok.
if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))
or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
{
# ...but upgrade the legacy password inplace.
$self->SUPER::SetPassword( $self->_GeneratePassword($value) );
$RT::Logger->info((caller(0))[3],
"AUTH OKAY:", $self->Name);
return 1;
}
$RT::Logger->info((caller(0))[3], "AUTH FAILED:", $self->Name);
return undef;
}
# {{{ sub IsPassword
sub IsPassword {
my $self = shift;
my $value = shift;
#TODO there isn't any apparent way to legitimately ACL this
# RT does not allow null passwords
if ( !defined($value) || $value eq '' ) {
return undef;
}
if ( $self->PrincipalObj->Disabled ) {
$RT::Logger->info("Disabled user " . $self->Name .
" tried to log in" );
return undef;
}
my @auth_methods = $RT::AuthMethods ? @{$RT::AuthMethods} : ('Internal');
my $success;
foreach my $method (@auth_methods) {
$method = "Is${method}Password";
# Eval this since they might specify an auth method without
# an "Is<auth>Password" method implemented
eval {
$success = $self->$method($value);
};
$RT::Logger->debug((caller(0))[3], "auth method $method",
($success ? 'SUCCEEDED' : 'FAILED'));
last if $success;
}
# We either got it or we didn't
return $success;
}
# }}}
=head2 CanonicalizeEmailAddress ADDRESS
returns the LDAP attr mapped to EmailAddress in $RT::LdapAttrMap.
If no result is found, returns the ADDRESS passed in.
=cut
sub CanonicalizeEmailAddress {
my $self = shift;
my $email = shift;
my $found = undef;
my %params = ('EmailAddress' => $email);
$self = RT::User->new($RT::SystemUser) unless $self;
# Don't ask for external info unless enabled in RT_SiteConfig
unless ($RT::LdapExternalInfo) {
$RT::Logger->warning((caller(0))[3],
'$RT::LdapExternalInfo is not set');
return $email;
}
$RT::Logger->debug((caller(0))[3], ": called with \"$email\" by", caller);
if ($email) {
foreach my $prefix (@{$RT::LdapEmailAttrMatchPrefix}) {
if (!$found) {
foreach my $attr (@{$RT::LdapEmailAttrMatchList}) {
($found, %params) =
$self->LookupExternalUserInfo($attr, "$prefix$email");
if ($found) {
$RT::Logger->debug("FOUND OK");
}
last if $found;
}
}
}
}
my $new_email = $found ? $params{'EmailAddress'} : $email;
$RT::Logger->info((caller(0))[3], "$email => $new_email");
return $new_email;
}
# {{{ sub CanonicalizeUserInfo
=head2 CanonicalizeUserInfo HASHREF
Get all LDAP attrs listed in $RT::LdapAttrMap and put them into
the hash referred to by HASHREF.
returns true (1) if LDAP lookup was successful, false (undef)
in all other cases.
=cut
sub CanonicalizeUserInfo {
my $self = shift;
my $args = shift;
my $found = 0;
my %params;
# Don't ask for external info unless enabled in RT_SiteConfig
unless ($RT::LdapExternalInfo) {
$RT::Logger->warning((caller(0))[3],
'$RT::LdapExternalInfo is not set');
# We return true so that they'll go forward with what info they have
return 1;
}
$RT::Logger->debug((caller(0))[3], " called by", caller, "with:",
join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
sort(keys(%$args))));
# $args is a hash ref; to get at its values, use $args->{<key>}
#
# $args has keys:
# RealName - User human name (e.g. Cole, Phillip)
# Name - Username or login (e.g. ukpgc)
# EmailAddress - Email address (e.g. phillip.cole@company.com)
# Comments - Comments created during creation
# How may I know thee? Let me count the ways ...
foreach my $rt_attr (@{$RT::LdapRTAttrMatchList}) {
next unless $args->{$rt_attr};
($found, %params) =
$self->LookupExternalUserInfo($RT::LdapAttrMap->{$rt_attr},
$args->{$rt_attr});
last if $found;
}
if ($found) {
# It's important that we always have a canonical email address
if ($params{'EmailAddress'}) {
my $email =
$self->CanonicalizeEmailAddress($params{'EmailAddress'});
$params{'EmailAddress'} = $email if $email;
}
%$args = (%$args, %params);
}
$RT::Logger->info((caller(0))[3], "returning",
join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
sort(keys(%$args))));
### HACK: The config var below is to overcome the (IMO) bug in
### RT::User::Create() which expects this function to always
### return true or rejects the user for creation. This should be
### a different config var (CreateUncanonicalizedUsers) and
### should be honored in RT::User::Create()
return $found || $RT::LdapAutoCreateNonLdapUsers;
}
# }}}
sub _GetBoundLdapObj {
my $self = shift;
my ($service, @ldap_args) = @_;
# Figure out what's what
my %ldap_config = $self->LdapConfigInfo();
my $ldap_server = $ldap_config{"${service}Server"};
my $ldap_base = $ldap_config{"${service}Base"};
my $ldap_user = $ldap_config{"${service}User"};
my $ldap_pass = $ldap_config{"${service}Pass"};
my $ldap_filter = $ldap_config{"${service}Filter"};
my $ldap_tls = $ldap_config{"${service}TLS"};
my $ldap_ssl_ver = $ldap_config{"${service}SSLVersion"};
my $ldap = new Net::LDAP($ldap_server, @ldap_args);
unless ($ldap) {
$RT::Logger->critical((caller(0))[3],
": Cannot connect to $ldap_server");
return undef;
}
if ($ldap_tls) {
$Net::SSLeay::ssl_version = $ldap_ssl_ver;
# Thanks to David Narayan for the fault tolerance bits
eval { $ldap->start_tls; };
if ($@) {
$RT::Logger->critical((caller(0))[3], "Can't start TLS: $@");
return;
}
}
my $msg = undef;
if ($ldap_user) {
$msg = $ldap->bind($ldap_user, password => $ldap_pass);
} else {
$msg = $ldap->bind;
}
unless ($msg->code == LDAP_SUCCESS) {
$RT::Logger->critical((caller(0))[3], "Can't bind:",
ldap_error_name($msg->code), $msg->code);
return undef;
} else {
return $ldap;
}
}
# {{{ sub LookupExternalUserInfo
=head2 LookupExternalUserInfo KEY VALUE [BASE_DN]
LookupExternalUserInfo takes a key/value pair with optional LDAP baseDN,
looks it up in LDAP, and returns a params hash containing all LDAP attrs
listed in $RT::LdapAttrMap, suitable for creating an RT::User object.
Returns a tuple, ($found, %params)
=cut
sub LookupExternalUserInfo {
my $self = shift;
my ($key, $value, $baseDN) = @_;
my $found = 0;
my %params = (Name => undef,
EmailAddress => undef,
RealName => undef);
# Don't ask for external info unless enabled in RT_SiteConfig
unless ($RT::LdapExternalInfo) {
$RT::Logger->warning((caller(0))[3],
'$RT::LdapExternalInfo is not set');
return ($found, %params);
}
# Figure out what's what
my %ldap_config = $self->LdapConfigInfo();
my $ldap_base = $ldap_config{'InfoBase'};
my $ldap_filter = $ldap_config{'InfoFilter'};
$baseDN = $baseDN || $ldap_base;
### This should use Net::LDAP::Filter, too
my $filter = ($key && $value) ? "@{[ $key ]}=$value" : "";
$RT::Logger->debug((caller(0))[3], "called with baseDN \"$baseDN\"",
"and filter \"$filter\" by", caller);
unless ($baseDN) {
$RT::Logger->critical((caller(0))[3] . " No baseDN given");
return ($found, %params);
}
my $ldap = $self->_GetBoundLdapObj('Info');
return ($found, %params) unless ($ldap);
# Get the list of unique attrs we need
my %ldap_attrs = map {$_ => 1} values(%{$RT::LdapAttrMap});
my @attrs = keys(%ldap_attrs);
my $ldap_msg = $ldap->search(base => $baseDN,
filter => $filter,
attrs => \@attrs);
if ($ldap_msg->code != LDAP_SUCCESS and
$ldap_msg->code != LDAP_PARTIAL_RESULTS) {
$RT::Logger->critical((caller(0))[3],
": Search for $filter failed: ",
ldap_error_name($ldap_msg->code), $ldap_msg->code);
# Why on earth do we return the same RealName, just quoted?!
$params{'RealName'} = "\"$params{'RealName'}\"";
} else {
# If there's only one match, we're good; more than one and
# we don't know which is the right one so we skip it.
if ($ldap_msg->count == 1) {
my $entry = $ldap_msg->first_entry();
foreach my $key (keys(%{$RT::LdapAttrMap})) {
if ($RT::LdapAttrMap->{$key} eq 'dn') {
$params{$key} = $entry->dn();
} else {
$params{$key} =
($entry->get_value($RT::LdapAttrMap->{$key}))[0];
}
}
$found = 1;
}
}
$ldap_msg = $ldap->unbind();
if ($ldap_msg->code != LDAP_SUCCESS) {
$RT::Logger->critical((caller(0))[3],
": Could not unbind: ",
ldap_error_name($ldap_msg->code), $ldap_msg->code);
}
undef $ldap;
undef $ldap_msg;
$RT::Logger->info((caller(0))[3],
": $baseDN $filter => ",
join(", ", map {sprintf("%s: %s", $_, $params{$_})}
sort(keys(%params))));
return ($found, %params);
}
# }}}
sub UpdateFromLdap {
my $self = shift;
my $updated = 0;
my $msg = "User NOT updated";
my %ldap_config = $self->LdapConfigInfo;
my @services;
push(@services, 'Auth') if $ldap_config{'AuthDisableFilter'};
push(@services, 'Info') if $ldap_config{'InfoDisableFilter'};
# If Auth and Info use exactly the same params, only check one
@services = ('Auth')
if (@services && $self->LdapConfigAuthAndInfoAreSame);
foreach my $service (@services) {
my $ldap = $self->_GetBoundLdapObj($service);
next unless $ldap;
my $ldap_base = $ldap_config{"${service}Base"};
my $ldap_filter = $ldap_config{"${service}Filter"};
my $ldap_disable = $ldap_config{"${service}DisableFilter"};
# Construct the complex filter
my $filter = '(&' . $ldap_filter . $ldap_disable .
'(uid=' . $self->Name . '))';
my $disabled_users = $ldap->search(base => $ldap_base,
filter => $filter,
attrs => ['uid']);
if ($disabled_users->count) {
my $UserObj = RT::User->new($RT::SystemUser);
$UserObj->Load($self->Name);
my ($val, $message) = $UserObj->SetDisabled(1);
$RT::Logger->info("DISABLED user " . $self->Name .
" per LDAP ($val, $message)\n");
$msg = "User disabled";
} else {
# Update their info from LDAP
my %args = (Name => $self->Name);
$self->CanonicalizeUserInfo(\%args);
foreach my $key (sort(keys(%args))) {
next unless $args{$key};
my $method = "Set$key";
$self->$method($args{$key});
}
$updated = 1;
$RT::Logger->debug("UPDATED user " . $self->Name . " from LDAP\n");
$msg = 'User updated';
}
}
return ($updated, $msg);
}
1;