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;