LdapUserLocalOverlay
Revision as of 11:58, 29 November 2010 by 66.73.230.190 (talk) (Undo revision 5652 by 195.16.40.50 (talk))
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;