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;