[Rt-commit] rt branch, master, updated. rt-4.2.12-502-g0ff6196
Shawn Moore
shawn at bestpractical.com
Mon Nov 2 17:05:30 EST 2015
The branch, master has been updated
via 0ff61967703af938f50930b4b69fd08a3b511b36 (commit)
via 007c785071e208dc5aaa66b91aa14645e996c10d (commit)
from b8f848dea1e11073864cd9a221f5339598f6e299 (commit)
Summary of changes:
.gitignore | 1 +
configure.ac | 15 +
lib/RT/Authen/ExternalAuth.pm | 637 ++++++++
lib/RT/Authen/ExternalAuth/DBI.pm | 681 +++++++++
lib/RT/Authen/ExternalAuth/DBI/Cookie.pm | 159 ++
lib/RT/Authen/ExternalAuth/LDAP.pm | 693 +++++++++
lib/RT/Config.pm | 114 ++
lib/RT/Interface/Web.pm | 8 +
lib/RT/LDAPImport.pm | 1550 ++++++++++++++++++++
lib/RT/User.pm | 126 +-
sbin/{rt-session-viewer.in => rt-ldapimport.in} | 96 +-
sbin/rt-test-dependencies.in | 8 +
.../Elements/PickObjectCFs => Elements/DoAuth} | 46 +-
share/html/Prefs/AboutMe.html | 2 +
t/externalauth/ldap.t | 104 ++
t/externalauth/ldap_escaping.t | 107 ++
t/externalauth/ldap_group.t | 157 ++
t/externalauth/ldap_privileged.t | 88 ++
t/externalauth/obfuscate-password.t | 32 +
t/externalauth/sessions.t | 124 ++
t/externalauth/sqlite.t | 115 ++
t/ldapimport/group-callbacks.t | 105 ++
t/ldapimport/group-import.t | 156 ++
t/ldapimport/group-member-import.t | 145 ++
t/ldapimport/group-rename.t | 138 ++
t/ldapimport/user-import-cfs.t | 109 ++
t/ldapimport/user-import-privileged.t | 71 +
t/ldapimport/user-import.t | 88 ++
28 files changed, 5616 insertions(+), 59 deletions(-)
create mode 100644 lib/RT/Authen/ExternalAuth.pm
create mode 100644 lib/RT/Authen/ExternalAuth/DBI.pm
create mode 100644 lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
create mode 100644 lib/RT/Authen/ExternalAuth/LDAP.pm
create mode 100644 lib/RT/LDAPImport.pm
copy sbin/{rt-session-viewer.in => rt-ldapimport.in} (62%)
copy share/html/{Search/Elements/PickObjectCFs => Elements/DoAuth} (70%)
create mode 100644 t/externalauth/ldap.t
create mode 100644 t/externalauth/ldap_escaping.t
create mode 100644 t/externalauth/ldap_group.t
create mode 100644 t/externalauth/ldap_privileged.t
create mode 100644 t/externalauth/obfuscate-password.t
create mode 100644 t/externalauth/sessions.t
create mode 100644 t/externalauth/sqlite.t
create mode 100644 t/ldapimport/group-callbacks.t
create mode 100644 t/ldapimport/group-import.t
create mode 100644 t/ldapimport/group-member-import.t
create mode 100644 t/ldapimport/group-rename.t
create mode 100644 t/ldapimport/user-import-cfs.t
create mode 100644 t/ldapimport/user-import-privileged.t
create mode 100644 t/ldapimport/user-import.t
- Log -----------------------------------------------------------------
commit 007c785071e208dc5aaa66b91aa14645e996c10d
Author: Todd Wade <todd at bestpractical.com>
Date: Wed Oct 14 13:35:25 2015 -0400
core RT::Authen::ExternalAuth and RT::Extension::LDAPImport
diff --git a/.gitignore b/.gitignore
index 54bde7e..fd95920 100644
--- a/.gitignore
+++ b/.gitignore
@@ -42,6 +42,7 @@
/sbin/rt-validate-aliases
/sbin/rt-serializer
/sbin/rt-importer
+/sbin/rt-ldapimport
/sbin/standalone_httpd
/var/mason_data/
/autom4te.cache/
diff --git a/configure.ac b/configure.ac
index 064274e..01a47bd 100755
--- a/configure.ac
+++ b/configure.ac
@@ -324,6 +324,20 @@ fi
AC_SUBST(RT_SMIME_DEPS)
AC_SUBST(RT_SMIME)
+dnl Dependencies for external auth
+AC_ARG_WITH(externalauth,[],RT_EXTERNALAUTH=$withval,RT_EXTERNALAUTH="0")
+AC_ARG_ENABLE(externalauth,
+ AC_HELP_STRING([--enable-externalauth],
+ [Add dependencies needed for external auth]),
+ RT_EXTERNALAUTH=$enableval,
+ RT_EXTERNALAUTH=$RT_EXTERNALAUTH)
+if test "$RT_EXTERNALAUTH" = yes; then
+ RT_EXTERNALAUTH="1"
+else
+ RT_EXTERNALAUTH="0"
+fi
+AC_SUBST(RT_EXTERNALAUTH)
+
dnl ExternalStorage
AC_ARG_WITH(attachment-store,
AC_HELP_STRING([--with-attachment-store=TYPE],
@@ -438,6 +452,7 @@ AC_CONFIG_FILES([
etc/upgrade/upgrade-articles
etc/upgrade/vulnerable-passwords
etc/upgrade/upgrade-sla
+ sbin/rt-ldapimport
sbin/rt-attributes-viewer
sbin/rt-preferences-viewer
sbin/rt-session-viewer
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
new file mode 100644
index 0000000..84a0a45
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -0,0 +1,637 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Authen::ExternalAuth;
+
+=head1 NAME
+
+RT::Authen::ExternalAuth - RT Authentication using External Sources
+
+=head1 DESCRIPTION
+
+This module provides the ability to authenticate RT users against one or
+more external data sources at once. It will also allow information about
+that user to be loaded from the same, or any other available, source as
+well as allowing multple redundant servers for each method.
+
+The functionality currently supports authentication and information from
+LDAP via the Net::LDAP module, and from any data source that an
+installed DBI driver is available for.
+
+It is also possible to use cookies set by an alternate application for
+Single Sign-On (SSO) with that application. For example, you may
+integrate RT with your own website login system so that once users log
+in to your website, they will be automagically logged in to RT when they
+access it.
+
+=head1 CONFIGURATION
+
+L<RT::Authen::ExternalAuth> provides a lot of flexibility with many
+configuration options. The following describes these configuration options,
+and provides a complete example.
+
+=over 4
+
+=item C<$ExternalAuthPriority>
+
+The order in which the services defined in L</$ExternalSettings> should
+be used to authenticate users. Once the user has been authenticated by
+one service, the rest are skipped.
+
+You should remove services you don't use. For example, if you're only
+using C<My_LDAP>, remove C<My_MySQL> and C<My_SSO_Cookie>.
+
+ Set($ExternalAuthPriority, [ 'My_LDAP',
+ 'My_MySQL',
+ 'My_SSO_Cookie'
+ ]
+ );
+
+=item C<$ExternalInfoPriority>
+
+When multiple auth services are available, this value defines the order
+in which the services defined in L</$ExternalSettings> should be used to
+get information about users. This includes C<RealName>, telephone
+numbers etc, but also whether or not the user should be considered
+disabled.
+
+Once a user record is found, no more services are checked.
+
+You CANNOT use a SSO cookie to retrieve information.
+
+You should remove services you don't use, but you must define
+at least one service.
+
+ Set($ExternalInfoPriority, [ 'My_LDAP',
+ 'My_MySQL',
+ ]
+ );
+
+=item C<$AutoCreateNonExternalUsers>
+
+If this is set to 1, then users should be autocreated by RT
+as internal users if they fail to authenticate from an
+external service. This is useful if you have users outside
+your organization who might interface with RT, perhaps by sending
+email to a support email address.
+
+=item C<$ExternalSettings>
+
+These are the full settings for each external service as a hash of
+hashes. Note that you may have as many external services as you wish.
+They will be checked in the order specified in L</$ExternalAuthPriority>
+and L</$ExternalInfoPriority> directives above.
+
+The outer structure is a key with the authentication option (name of
+external source). The value is a hash reference with configuration keys
+and values, for example:
+
+ Set($ExternalSettings, {
+ My_LDAP => {
+ type => 'ldap',
+ ... other options ...
+ },
+ My_MySQL => {
+ type => 'db',
+ ... other options ...
+ },
+ ... other sources ...
+ } );
+
+As shown above, each description should have 'type' defined.
+The following types are supported:
+
+=over 4
+
+=item ldap
+
+Authenticate against and sync information with LDAP servers. See
+L<RT::Authen::ExternalAuth::LDAP> for details.
+
+=item db
+
+Authenticate against and sync information with external RDBMS, supported
+by Perl's L<DBI> interface. See L<RT::Authen::ExternalAuth::DBI> for
+details.
+
+=item cookie
+
+Authenticate by cookie. See L<RT::Authen::ExternalAuth::DBI::Cookie> for
+details.
+
+=back
+
+See the modules noted above for configuration options specific to each
+type. The following apply to all types.
+
+=over 4
+
+=item attr_match_list
+
+The list of RT attributes that uniquely identify a user. These values
+are used, in order, to find users in the selected authentication
+source. Each value specified here must have a mapping in the
+L</attr_map> section below. You can remove values you don't expect to
+match, but we recommend using C<Name> and C<EmailAddress> at a
+minimum. For example:
+
+ 'attr_match_list' => [
+ 'Name',
+ 'EmailAddress',
+ ],
+
+You should not use items that can map to multiple users (such as a
+C<RealName> or building name).
+
+=item attr_map
+
+Mapping of RT attributes on to attributes in the external source.
+Valid keys are attributes of an L<RT::User>. The values are attributes from
+your authentication source. For example, an LDAP mapping might look like:
+
+ 'attr_map' => {
+ 'Name' => 'sAMAccountName',
+ 'EmailAddress' => 'mail',
+ 'Organization' => 'physicalDeliveryOfficeName',
+ 'RealName' => 'cn',
+ ...
+ },
+
+=back
+
+=back
+
+=head2 Example
+
+ # Use the below LDAP source for both authentication, as well as user
+ # information
+ Set( $ExternalAuthPriority, ["My_LDAP"] );
+ Set( $ExternalInfoPriority, ["My_LDAP"] );
+
+ # Make users created from LDAP Privileged
+ Set( $UserAutocreateDefaultsOnLogin, { Privileged => 1 } );
+
+ # Users should still be autocreated by RT as internal users if they
+ # fail to exist in an external service; this is so requestors (who
+ # are not in LDAP) can still be created when they email in.
+ Set($AutoCreateNonExternalUsers, 1);
+
+ # Minimal LDAP configuration; see RT::Authen::ExternalAuth::LDAP for
+ # further details and examples
+ Set($ExternalSettings, {
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => 'ldap.example.com',
+ # By not passing 'user' and 'pass' we are using an anonymous
+ # bind, which some servers to not allow
+ 'base' => 'ou=Staff,dc=example,dc=com',
+ 'filter' => '(objectClass=inetOrgPerson)',
+ # Users are allowed to log in via email address or account
+ # name
+ 'attr_match_list' => [
+ 'Name',
+ 'EmailAddress',
+ ],
+ # Import the following properties of the user from LDAP upon
+ # login
+ 'attr_map' => {
+ 'Name' => 'sAMAccountName',
+ 'EmailAddress' => 'mail',
+ 'RealName' => 'cn',
+ 'WorkPhone' => 'telephoneNumber',
+ 'Address1' => 'streetAddress',
+ 'City' => 'l',
+ 'State' => 'st',
+ 'Zip' => 'postalCode',
+ 'Country' => 'co',
+ },
+ },
+ } );
+
+=cut
+
+use RT::Authen::ExternalAuth::LDAP;
+use RT::Authen::ExternalAuth::DBI;
+
+use warnings;
+use strict;
+
+sub DoAuth {
+ my ($session,$given_user,$given_pass) = @_;
+
+ # Get the prioritised list of external authentication services
+ my @auth_services = @{ RT->Config->Get('ExternalAuthPriority') };
+ my $settings = RT->Config->Get('ExternalSettings');
+
+ return (0, "ExternalAuthPriority not defined, please check your configuration file.")
+ unless @auth_services;
+
+ # This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
+ my $success = 0;
+
+ # Should have checked if user is already logged in before calling this function,
+ # but just in case, we'll check too.
+ return (0, "User already logged in!") if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id);
+
+ # For each of those services..
+ foreach my $service (@auth_services) {
+
+ # Get the full configuration for that service as a hashref
+ my $config = $settings->{$service};
+ $RT::Logger->debug( "Attempting to use external auth service:",
+ $service);
+
+ # $username will be the final username we decide to check
+ # This will not necessarily be $given_user
+ my $username = undef;
+
+ #############################################################
+ ####################### SSO Check ###########################
+ #############################################################
+ if ($config->{'type'} eq 'cookie') {
+ # Currently, Cookie authentication is our only SSO method
+ $username = RT::Authen::ExternalAuth::DBI::GetCookieAuth($config);
+ }
+ #############################################################
+
+ # If $username is defined, we have a good SSO $username and can
+ # safely bypass the password checking later on; primarily because
+ # it's VERY unlikely we even have a password to check if an SSO succeeded.
+ my $pass_bypass = 0;
+ if(defined($username)) {
+ $RT::Logger->debug("Pass not going to be checked, attempting SSO");
+ $pass_bypass = 1;
+ } else {
+
+ # SSO failed and no $user was passed for a login attempt
+ # We only don't return here because the next iteration could be an SSO attempt
+ unless(defined($given_user)) {
+ $RT::Logger->debug("SSO Failed and no user to test with. Nexting");
+ next;
+ }
+
+ # We don't have an SSO login, so we will be using the credentials given
+ # on RT's login page to do our authentication.
+ $username = $given_user;
+
+ # Don't continue unless the service works.
+ # next unless RT::Authen::ExternalAuth::TestConnection($config);
+
+ # Don't continue unless the $username exists in the external service
+
+ $RT::Logger->debug("Calling UserExists with \$username ($username) and \$service ($service)");
+ next unless RT::Authen::ExternalAuth::UserExists($username, $service);
+ }
+
+ ####################################################################
+ ########## Load / Auto-Create ######################################
+ ####################################################################
+ # We are now sure that we're talking about a valid RT user.
+ # If the user already exists, load up their info. If they don't
+ # then we need to create the user in RT.
+
+ # Does user already exist internally to RT?
+ $session->{'CurrentUser'} = RT::CurrentUser->new();
+ $session->{'CurrentUser'}->Load($username);
+
+ # Unless we have loaded a valid user with a UserID create one.
+ unless ($session->{'CurrentUser'}->Id) {
+ my $UserObj = RT::User->new($RT::SystemUser);
+ my $create = RT->Config->Get('UserAutocreateDefaultsOnLogin')
+ || RT->Config->Get('AutoCreate');
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($create) ? $create : {}},
+ Name => $username,
+ Gecos => $username,
+ );
+ unless ($val) {
+ $RT::Logger->error( "Couldn't create user $username: $msg" );
+ next;
+ }
+ $RT::Logger->info( "Autocreated external user",
+ $UserObj->Name,
+ "(",
+ $UserObj->Id,
+ ")");
+
+ $RT::Logger->debug("Loading new user (",
+ $username,
+ ") into current session");
+ $session->{'CurrentUser'}->Load($username);
+ }
+
+ ####################################################################
+ ########## Authentication ##########################################
+ ####################################################################
+ # If we successfully used an SSO service, then authentication
+ # succeeded. If we didn't then, success is determined by a password
+ # test.
+ $success = 0;
+ if($pass_bypass) {
+ $RT::Logger->debug("Password check bypassed due to SSO method being in use");
+ $success = 1;
+ } else {
+ $RT::Logger->debug("Password validation required for service - Executing...");
+ $success = RT::Authen::ExternalAuth::GetAuth($service,$username,$given_pass);
+ }
+
+ $RT::Logger->debug("Password Validation Check Result: ",$success);
+
+ # If the password check succeeded then this is our authoritative service
+ # and we proceed to user information update and login.
+ last if $success;
+ }
+
+ # If we got here and don't have a user loaded we must have failed to
+ # get a full, valid user from an authoritative external source.
+ unless ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
+ $session->{'CurrentUser'} = RT::CurrentUser->new;
+ return (0, "No User");
+ }
+
+ unless($success) {
+ $session->{'CurrentUser'} = RT::CurrentUser->new;
+ return (0, "Password Invalid");
+ }
+
+ # Otherwise we succeeded.
+ $RT::Logger->debug("Authentication successful. Now updating user information and attempting login.");
+
+ ####################################################################################################
+ ############################### The following is auth-method agnostic ##############################
+ ####################################################################################################
+
+ # If we STILL have a completely valid RT user to play with...
+ # and therefore password has been validated...
+ if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
+
+ # Even if we have JUST created the user in RT, we are going to
+ # reload their information from an external source. This allows us
+ # to be sure that the user the cookie gave us really does exist in
+ # the database, but more importantly, UpdateFromExternal will check
+ # whether the user is disabled or not which we have not been able to
+ # do during auto-create
+
+ # These are not currently used, but may be used in the future.
+ my $info_updated = 0;
+ my $info_updated_msg = "User info not updated";
+
+ if ( @{ RT->Config->Get('ExternalInfoPriority') } ) {
+ # Note that UpdateUserInfo does not care how we authenticated the user
+ # It will look up user info from whatever is specified in $RT::ExternalInfoPriority
+ ($info_updated,$info_updated_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session->{'CurrentUser'}->Name);
+ }
+
+ # Now that we definitely have up-to-date user information,
+ # if the user is disabled, kick them out. Now!
+ if ($session->{'CurrentUser'}->UserObj->Disabled) {
+ $session->{'CurrentUser'} = RT::CurrentUser->new;
+ return (0, "User account disabled, login denied");
+ }
+ }
+
+ # If we **STILL** have a full user and the session hasn't already been deleted
+ # This If/Else is logically unnecessary, but it doesn't hurt to leave it here
+ # just in case. Especially to be a double-check to future modifications.
+ if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
+
+ $RT::Logger->info( "Successful login for",
+ $session->{'CurrentUser'}->Name,
+ "from",
+ ($ENV{'REMOTE_ADDR'} || 'UNKNOWN') );
+ # Do not delete the session. User stays logged in and
+ # autohandler will not check the password again
+
+ my $cu = $session->{CurrentUser};
+ RT::Interface::Web::InstantiateNewSession();
+ $session->{CurrentUser} = $cu;
+ } else {
+ # Make SURE the session is purged to an empty user.
+ $session->{'CurrentUser'} = RT::CurrentUser->new;
+ return (0, "Failed to authenticate externally");
+ # This will cause autohandler to request IsPassword
+ # which will in turn call IsExternalPassword
+ }
+
+ return (1, "Successful login");
+}
+
+sub UpdateUserInfo {
+ my $username = shift;
+
+ # Prepare for the worst...
+ my $found = 0;
+ my $updated = 0;
+ my $msg = "User NOT updated";
+
+ my $user_disabled = RT::Authen::ExternalAuth::UserDisabled($username);
+
+ my $UserObj = RT::User->new(RT->SystemUser);
+ $UserObj->Load($username);
+
+ # If user is disabled, set the RT::Principal to disabled and return out of the function.
+ # I think it's a waste of time and energy to update a user's information if they are disabled
+ # and it could be a security risk if they've updated their external information with some
+ # carefully concocted code to try to break RT - worst case scenario, but they have been
+ # denied access after all, don't take any chances.
+
+ # If someone gives me a good enough reason to do it,
+ # then I'll update all the info for disabled users
+
+ if ($user_disabled) {
+ unless ( $UserObj->Disabled ) {
+ # Make sure principal is disabled in RT
+ my ($val, $message) = $UserObj->SetDisabled(1);
+ # Log what has happened
+ $RT::Logger->info("User marked as DISABLED (",
+ $username,
+ ") per External Service",
+ "($val, $message)\n");
+ $msg = "User Disabled";
+ }
+
+ return ($updated, $msg);
+ }
+
+ # Make sure principal is not disabled in RT
+ if ( $UserObj->Disabled ) {
+ my ($val, $message) = $UserObj->SetDisabled(0);
+ unless ( $val ) {
+ $RT::Logger->error("Failed to enable user ($username) per External Service: ".($message||''));
+ return ($updated, "Failed to enable");
+ }
+
+ $RT::Logger->info("User ($username) was disabled, marked as ENABLED ",
+ "per External Service",
+ "($val, $message)\n");
+ }
+
+ # Update their info from external service using the username as the lookup key
+ # CanonicalizeUserInfo will work out for itself which service to use
+ # Passing it a service instead could break other RT code
+ my %args = (Name => $username);
+ $UserObj->CanonicalizeUserInfo(\%args);
+
+ # For each piece of information returned by CanonicalizeUserInfo,
+ # run the Set method for that piece of info to change it for the user
+ my @results = $UserObj->Update(
+ ARGSRef => \%args,
+ AttributesRef => [keys %args],
+ );
+ $RT::Logger->debug("UPDATED user $username: $_")
+ for @results;
+
+ # Confirm update success
+ $updated = 1;
+ $RT::Logger->debug( "UPDATED user (",
+ $username,
+ ") from External Service\n");
+ $msg = 'User updated';
+
+ return ($updated, $msg);
+}
+
+sub GetAuth {
+
+ # Request a username/password check from the specified service
+ # This is only valid for non-SSO services.
+
+ my ($service,$username,$password) = @_;
+
+ my $success = 0;
+
+ # Get the full configuration for that service as a hashref
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP non-SSO services
+ if ($config->{'type'} eq 'db') {
+ $success = RT::Authen::ExternalAuth::DBI::GetAuth($service,$username,$password);
+ $RT::Logger->debug("DBI password validation result:",$success);
+ } elsif ($config->{'type'} eq 'ldap') {
+ $success = RT::Authen::ExternalAuth::LDAP::GetAuth($service,$username,$password);
+ $RT::Logger->debug("LDAP password validation result:",$success);
+ }
+
+ return $success;
+}
+
+sub UserExists {
+
+ # Request a username/password check from the specified service
+ # This is only valid for non-SSO services.
+
+ my ($username,$service) = @_;
+
+ my $success = 0;
+
+ # Get the full configuration for that service as a hashref
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP non-SSO services
+ if ($config->{'type'} eq 'db') {
+ $success = RT::Authen::ExternalAuth::DBI::UserExists($username,$service);
+ } elsif ($config->{'type'} eq 'ldap') {
+ $success = RT::Authen::ExternalAuth::LDAP::UserExists($username,$service);
+ }
+
+ return $success;
+}
+
+sub UserDisabled {
+
+ my $username = shift;
+ my $user_disabled = 0;
+
+ my @info_services = @{ RT->Config->Get('ExternalInfoPriority') };
+
+ # For each named service in the list
+ # Check to see if the user is found in the external service
+ # If not found, jump to next service
+ # If found, check to see if user is considered disabled by the service
+ # Then update the user's info in RT and return
+ foreach my $service (@info_services) {
+
+ # Get the external config for this service as a hashref
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # If it's a DBI config:
+ if ($config->{'type'} eq 'db') {
+
+ unless(RT::Authen::ExternalAuth::DBI::UserExists($username,$service)) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
+ $service,
+ ") - Cannot update information - Skipping...");
+ next;
+ }
+ $user_disabled = RT::Authen::ExternalAuth::DBI::UserDisabled($username,$service);
+
+ } elsif ($config->{'type'} eq 'ldap') {
+
+ unless(RT::Authen::ExternalAuth::LDAP::UserExists($username,$service)) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
+ $service,
+ ") - Cannot update information - Skipping...");
+ next;
+ }
+ $user_disabled = RT::Authen::ExternalAuth::LDAP::UserDisabled($username,$service);
+
+ }
+
+ }
+ return $user_disabled;
+}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
new file mode 100644
index 0000000..f0945f6
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -0,0 +1,681 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Authen::ExternalAuth::DBI;
+
+use DBI;
+use RT::Authen::ExternalAuth::DBI::Cookie;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+RT::Authen::ExternalAuth::DBI - External database source for RT authentication
+
+=head1 DESCRIPTION
+
+Provides the database implementation for L<RT::Authen::ExternalAuth>.
+
+=head1 SYNOPSIS
+
+ Set($ExternalSettings, {
+ 'My_MySQL' => {
+ 'type' => 'db',
+
+ 'dbi_driver' => 'DBI_DRIVER',
+
+ 'server' => 'server.domain.tld',
+ 'port' => 'DB_PORT',
+ 'user' => 'DB_USER',
+ 'pass' => 'DB_PASS',
+
+ 'database' => 'DB_NAME',
+ 'table' => 'USERS_TABLE',
+ 'u_field' => 'username',
+ 'p_field' => 'password',
+
+ # Example of custom hashed password check
+ #'p_check' => sub {
+ # my ($hash_from_db, $password) = @_;
+ # return $hash_from_db eq function($password);
+ #},
+
+ 'p_enc_pkg' => 'Crypt::MySQL',
+ 'p_enc_sub' => 'password',
+ 'p_salt' => 'SALT',
+
+ 'd_field' => 'disabled',
+ 'd_values' => ['0'],
+
+ 'attr_match_list' => [
+ 'Gecos',
+ 'Name',
+ ],
+ 'attr_map' => {
+ 'Name' => 'username',
+ 'EmailAddress' => 'email',
+ 'ExternalAuthId' => 'username',
+ 'Gecos' => 'userID',
+ },
+ },
+ } );
+
+=head1 CONFIGURATION
+
+DBI-specific options are described here. Shared options
+are described in L<RT::Authen::ExternalAuth>.
+
+The example in the L</SYNOPSIS> lists all available options
+and they are described below. See the L<DBI> module for details
+on debugging connection issues.
+
+=over 4
+
+=item dbi_driver
+
+The name of the Perl DBI driver to use (e.g. mysql, Pg, SQLite).
+
+=item server
+
+The server hosting the database.
+
+=item port
+
+The port to use to connect on (e.g. 3306).
+
+=item user
+
+The database user for the connection.
+
+=item pass
+
+The password for the database user.
+
+=item database
+
+The database name.
+
+=item table
+
+The database table containing the user information to check against.
+
+=item u_field
+
+The field in the table that holds usernames
+
+=item p_field
+
+The field in the table that holds passwords
+
+=item p_check
+
+Optional. An anonymous subroutine definition used to check the (presumably
+hashed) passed from the database with the password entered by the user logging
+in. The subroutine should return true on success and false on failure. The
+configuration options C<p_enc_pkg> and C<p_enc_sub> will be ignored when
+C<p_check> is defined.
+
+An example, where C<FooBar()> is some external hashing function:
+
+ p_check => sub {
+ my ($hash_from_db, $password) = @_;
+ return $hash_from_db eq FooBar($password);
+ },
+
+Importantly, the C<p_check> subroutine allows for arbitrarily complex password
+checking unlike C<p_enc_pkg> and C<p_enc_sub>.
+
+=item p_enc_pkg, p_enc_sub
+
+The Perl package and subroutine used to encrypt passwords from the
+database. For example, if the passwords are stored using the MySQL
+v3.23 "PASSWORD" function, then you will need the L<Crypt::MySQL>
+C<password> function, but for the MySQL4+ password you will need
+L<Crypt::MySQL>'s C<password41>. Alternatively, you could use
+L<Digest::MD5> C<md5_hex> or any other encryption subroutine you can
+load in your Perl installation.
+
+=item p_salt
+
+If p_enc_sub takes a salt as a second parameter then set it here.
+
+=item d_field, d_values
+
+The field and values in the table that determines if a user should
+be disabled. For example, if the field is 'user_status' and the values
+are ['0','1','2','disabled'] then the user will be disabled if their
+user_status is set to '0','1','2' or the string 'disabled'.
+Otherwise, they will be considered enabled.
+
+=back
+
+=cut
+
+sub GetAuth {
+
+ my ($service, $username, $password) = @_;
+
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+ $RT::Logger->debug( "Trying external auth service:",$service);
+
+ my $db_table = $config->{'table'};
+ my $db_u_field = $config->{'u_field'};
+ my $db_p_field = $config->{'p_field'};
+ my $db_p_check = $config->{'p_check'};
+ my $db_p_enc_pkg = $config->{'p_enc_pkg'};
+ my $db_p_enc_sub = $config->{'p_enc_sub'};
+ my $db_p_salt = $config->{'p_salt'};
+
+ # Set SQL query and bind parameters
+ my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
+ my @params = ($username);
+
+ # Uncomment this to trace basic DBI information and drop it in a log for debugging
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI handle object (DBH), do SQL query, kill DBH
+ my $dbh = _GetBoundDBIObj($config);
+ return 0 unless $dbh;
+
+ my $results_hashref = $dbh->selectall_hashref($query,$db_u_field,{}, at params);
+ $dbh->disconnect();
+
+ my $num_users_returned = scalar keys %$results_hashref;
+ if($num_users_returned != 1) { # FAIL
+ # FAIL because more than one user returned. Users MUST be unique!
+ if ((scalar keys %$results_hashref) > 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "More than one user with that username!");
+ }
+
+ # FAIL because no users returned. Users MUST exist!
+ if ((scalar keys %$results_hashref) < 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "User not found in database!");
+ }
+
+ # Drop out to next external authentication service
+ return 0;
+ }
+
+ # Get the user's password from the database query result
+ my $pass_from_db = $results_hashref->{$username}->{$db_p_field};
+
+ if ( $db_p_check ) {
+ unless ( ref $db_p_check eq 'CODE' ) {
+ $RT::Logger->error( "p_check for $service is not a code" );
+ return 0;
+ }
+ my $check = 0;
+ local $@;
+ eval {
+ $check = $db_p_check->( $pass_from_db, $password );
+ 1;
+ } or do {
+ $RT::Logger->error( "p_check for $service failed: $@" );
+ return 0;
+ };
+ unless ( $check ) {
+ $RT::Logger->info(
+ "$service AUTH FAILED for $username: Password Incorrect (via p_check)"
+ );
+ } else {
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $username);
+ }
+ return $check;
+ }
+
+ # This is the encryption package & subroutine passed in by the config file
+ $RT::Logger->debug( "Encryption Package:",
+ $db_p_enc_pkg);
+ $RT::Logger->debug( "Encryption Subroutine:",
+ $db_p_enc_sub);
+
+ # Use config info to auto-load the perl package needed for password encryption
+ # Jump to next external authentication service on failure
+ $db_p_enc_pkg->require or do {
+ $RT::Logger->error("AUTH FAILED, Couldn't Load Password Encryption Package. Error: $@");
+ return 0;
+ };
+
+ my $encrypt = $db_p_enc_pkg->can($db_p_enc_sub);
+ if (defined($encrypt)) {
+ # If the package given can perform the subroutine given, then use it to compare the
+ # password given with the password pulled from the database.
+ # Jump to the next external authentication service if they don't match
+ if(defined($db_p_salt)) {
+ $RT::Logger->debug("Using salt:",$db_p_salt);
+ if(${encrypt}->($password,$db_p_salt) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "Password Incorrect");
+ return 0;
+ }
+ } else {
+ if(${encrypt}->($password) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "Password Incorrect");
+ return 0;
+ }
+ }
+ } else {
+ # If the encryption package can't perform the request subroutine,
+ # dump an error and jump to the next external authentication service.
+ $RT::Logger->error($service,
+ "AUTH FAILED",
+ "The encryption package you gave me (",
+ $db_p_enc_pkg,
+ ") does not support the encryption method you specified (",
+ $db_p_enc_sub,
+ ")");
+ return 0;
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $username);
+
+ return 1;
+}
+
+sub CanonicalizeUserInfo {
+
+ my ($service, $key, $value) = @_;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ # Load the config
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # Figure out what's what
+ my $table = $config->{'table'};
+
+ unless ($table) {
+ $RT::Logger->critical( (caller(0))[3],
+ "No table given");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ unless ($key && $value){
+ $RT::Logger->critical( (caller(0))[3],
+ " Nothing to look-up given");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ # "where" refers to WHERE section of SQL query
+ my ($where_key,$where_value) = ("@{[ $key ]}",$value);
+
+ # Get the list of unique attrs we need
+ my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
+ my @attrs = keys(%db_attrs);
+ my $fields = join(',', at attrs);
+ my $query = "SELECT $fields FROM $table WHERE $where_key=?";
+ my @bind_params = ($where_value);
+
+ # Uncomment this to trace basic DBI throughput in a log
+ # DBI->trace(1,'/tmp/dbi.log');
+ my $dbh = _GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
+ $dbh->disconnect();
+
+ if ((scalar keys %$results_hashref) != 1) {
+ # If returned users <> 1, we have no single unique user, so prepare to die
+ my $death_msg;
+
+ if ((scalar keys %$results_hashref) == 0) {
+ # If no user...
+ $death_msg = "No User Found in External Database!";
+ } else {
+ # If more than one user...
+ $death_msg = "More than one user found in External Database with that unique identifier!";
+ }
+
+ # Log the death
+ $RT::Logger->info( (caller(0))[3],
+ "INFO CHECK FAILED",
+ "Key: $key",
+ "Value: $value",
+ $death_msg);
+
+ # $found remains as 0
+
+ # Drop out to next external information service
+ return ($found, %params);
+ }
+
+ # We haven't dropped out, so DB search must have succeeded with
+ # exactly 1 result. Get the result and set $found to 1
+ my $result = $results_hashref->{$value};
+
+ # Use the result to populate %params for every key we're given in the config
+ foreach my $key (keys(%{$config->{'attr_map'}})) {
+ $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
+ }
+
+ $found = 1;
+
+ return ($found, %params);
+}
+
+sub UserExists {
+
+ my ($username,$service) = @_;
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+ my $table = $config->{'table'};
+ my $u_field = $config->{'u_field'};
+ my $query = "SELECT $u_field FROM $table WHERE $u_field=?";
+ my @bind_params = ($username);
+
+ # Uncomment this to do a basic trace on DBI information and log it
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI Object, do the query, disconnect
+ my $dbh = _GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
+ $dbh->disconnect();
+
+ my $num_of_results = scalar keys %$results_hashref;
+
+ if ($num_of_results > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username!");
+ return 0;
+ } elsif ($num_of_results < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found");
+ return 0;
+ }
+
+ # Number of results is exactly one, so we found the user we were looking for
+ return 1;
+}
+
+sub UserDisabled {
+
+ my ($username,$service) = @_;
+
+ # FIRST, check that the user exists in the DBI service
+ unless(UserExists($username,$service)) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking");
+ return 0;
+ }
+
+ # Get the necessary config info
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+ my $table = $config->{'table'};
+ my $u_field = $config->{'u_field'};
+ my $disable_field = $config->{'d_field'};
+ my $disable_values_list = $config->{'d_values'};
+
+ unless ($disable_field) {
+ # If we don't know how to check for disabled users, consider them all enabled.
+ $RT::Logger->debug("No d_field specified for this DBI service (",
+ $service,
+ "), so considering all users enabled");
+ return 0;
+ }
+
+ my $query = "SELECT $u_field,$disable_field FROM $table WHERE $u_field=?";
+ my @bind_params = ($username);
+
+ # Uncomment this to do a basic trace on DBI information and log it
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI Object, do the query, disconnect
+ my $dbh = _GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
+ $dbh->disconnect();
+
+ my $num_of_results = scalar keys %$results_hashref;
+
+ if ($num_of_results > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username! - Assuming not disabled");
+ # Drop out to next service for an info check
+ return 0;
+ } elsif ($num_of_results < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found - Assuming not disabled");
+ # Drop out to next service for an info check
+ return 0;
+ } else {
+ # otherwise all should be well
+
+ # $user_db_disable_value = The value for "disabled" returned from the DB
+ my $user_db_disable_value = $results_hashref->{$username}->{$disable_field};
+
+ # For each of the values in the (list of values that we consider to mean the user is disabled)..
+ foreach my $disable_value (@{$disable_values_list}){
+ $RT::Logger->debug( "DB Disable Check:",
+ "User's Val is $user_db_disable_value,",
+ "Checking against: $disable_value");
+
+ # If the value from the DB matches a value from the list, the user is disabled.
+ if ($user_db_disable_value eq $disable_value) {
+ return 1;
+ }
+ }
+
+ # If we've not returned yet, the user can't be disabled
+ return 0;
+ }
+ $RT::Logger->crit("It is seriously not possible to run this code.. what the hell did you do?!");
+ return 0;
+}
+
+sub GetCookieAuth {
+
+ $RT::Logger->debug( (caller(0))[3],
+ "Checking Browser Cookies for an Authenticated User");
+
+ # Get our cookie and database info...
+ my $config = shift;
+
+ my $username = undef;
+ my $cookie_name = $config->{'name'};
+
+ my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($cookie_name);
+
+ unless($cookie_value){
+ return $username;
+ }
+
+ # The table mapping usernames to the Username Match Key
+ my $u_table = $config->{'u_table'};
+ # The username field in that table
+ my $u_field = $config->{'u_field'};
+ # The field that contains the Username Match Key
+ my $u_match_key = $config->{'u_match_key'};
+
+ # The table mapping cookie values to the Cookie Match Key
+ my $c_table = $config->{'c_table'};
+ # The cookie field in that table - The same as the cookie name if unspecified
+ my $c_field = $config->{'c_field'};
+ # The field that connects the Cookie Match Key
+ my $c_match_key = $config->{'c_match_key'};
+
+ # These are random characters to assign as table aliases in SQL
+ # It saves a lot of garbled code later on
+ my $u_table_alias = "u";
+ my $c_table_alias = "c";
+
+ # $tables will be passed straight into the SQL query
+ # I don't see this as a security issue as only the admin may modify the config file anyway
+ my $tables;
+
+ # If the tables are the same, then the aliases should be the same
+ # and the match key becomes irrelevant. Ensure this all works out
+ # fine by setting both sides the same. In either case, set an
+ # appropriate value for $tables.
+ if ($u_table eq $c_table) {
+ $u_table_alias = $c_table_alias;
+ $u_match_key = $c_match_key;
+ $tables = "$c_table $c_table_alias";
+ } else {
+ $tables = "$c_table $c_table_alias, $u_table $u_table_alias";
+ }
+
+ my $select_fields = "$u_table_alias.$u_field";
+ my $where_statement = "$c_table_alias.$c_field = ? AND $c_table_alias.$c_match_key = $u_table_alias.$u_match_key";
+
+ my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
+ my @params = ($cookie_value);
+
+ # Use this if you need to debug the DBI SQL process
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ my $dbh = _GetBoundDBIObj(RT->Config->Get('ExternalSettings')->{$config->{'db_service_name'}});
+ my $query_result_arrayref = $dbh->selectall_arrayref($query,{}, at params);
+ $dbh->disconnect();
+
+ # The log messages say it all here...
+ my $num_rows = scalar @$query_result_arrayref;
+ if ($num_rows < 1) {
+ $RT::Logger->info( "AUTH FAILED",
+ $cookie_name,
+ "Cookie value not found in database.",
+ "User passed an authentication token they were not given by us!",
+ "Is this nefarious activity?");
+ } elsif ($num_rows > 1) {
+ $RT::Logger->error( "AUTH FAILED",
+ $cookie_name,
+ "Cookie's value is duplicated in the database! This should not happen!!");
+ } else {
+ $username = $query_result_arrayref->[0][0];
+ }
+
+ if ($username) {
+ $RT::Logger->debug( "User (",
+ $username,
+ ") was authenticated by a browser cookie");
+ } else {
+ $RT::Logger->debug( "No user was authenticated by browser cookie");
+ }
+
+ return $username;
+
+}
+
+
+# {{{ sub _GetBoundDBIObj
+
+sub _GetBoundDBIObj {
+
+ # Config as hashref.
+ my $config = shift;
+
+ # Extract the relevant information from the config.
+ my $db_server = $config->{'server'};
+ my $db_user = $config->{'user'};
+ my $db_pass = $config->{'pass'};
+ my $db_database = $config->{'database'};
+ my $db_port = $config->{'port'};
+ my $dbi_driver = $config->{'dbi_driver'};
+
+ # Use config to create a DSN line for the DBI connection
+ my $dsn;
+ if ( $dbi_driver eq 'SQLite' ) {
+ $dsn = "dbi:$dbi_driver:$db_database";
+ }
+ else {
+ $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
+ }
+
+ # Now let's get connected
+ my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
+ or die $DBI::errstr;
+
+ # If we didn't die, return the DBI object handle
+ # and hope it's treated sensibly and correctly
+ # destroyed by the calling code
+ return $dbh;
+}
+
+# }}}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
new file mode 100644
index 0000000..e0974f3
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -0,0 +1,159 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Authen::ExternalAuth::DBI::Cookie;
+
+use CGI::Cookie;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+RT::Authen::ExternalAuth::DBI::Cookie - Database-backed, cookie SSO source for RT authentication
+
+=head1 DESCRIPTION
+
+Provides the Cookie implementation for L<RT::Authen::ExternalAuth>.
+
+=head1 SYNOPSIS
+
+ Set($ExternalSettings, {
+ # An example SSO cookie service
+ 'My_SSO_Cookie' => {
+ 'type' => 'cookie',
+ 'name' => 'loginCookieValue',
+ 'u_table' => 'users',
+ 'u_field' => 'username',
+ 'u_match_key' => 'userID',
+ 'c_table' => 'login_cookie',
+ 'c_field' => 'loginCookieValue',
+ 'c_match_key' => 'loginCookieUserID',
+ 'db_service_name' => 'My_MySQL'
+ },
+ 'My_MySQL' => {
+ ...
+ },
+ } );
+
+=head1 CONFIGURATION
+
+Cookie-specific options are described here. Shared options
+are described in L<RT::Authen::ExternalAuth::DBI>.
+
+The example in the L</SYNOPSIS> lists all available options
+and they are described below.
+
+=over 4
+
+=item name
+
+The name of the cookie to be used.
+
+=item u_table
+
+The users table.
+
+=item u_field
+
+The username field in the users table.
+
+=item u_match_key
+
+The field in the users table that uniquely identifies a user
+and also exists in the cookies table. See c_match_key below.
+
+=item c_table
+
+The cookies table.
+
+=item c_field
+
+The field that stores cookie values.
+
+=item c_match_key
+
+The field in the cookies table that uniquely identifies a user
+and also exists in the users table. See u_match_key above.
+
+=item db_service_name
+
+The DB service in this configuration to use to lookup the cookie
+information. See L<RT::Authen::ExternalAuth::DBI>.
+
+=back
+
+=cut
+
+# {{{ sub GetCookieVal
+sub GetCookieVal {
+
+ # The name of the cookie
+ my $cookie_name = shift;
+ my $cookie_value;
+
+ # Pull in all cookies from browser within our cookie domain
+ my %cookies = CGI::Cookie->fetch();
+
+ # If the cookie is set, get the value, if it's not set, get out now!
+ if (defined $cookies{$cookie_name}) {
+ $cookie_value = $cookies{$cookie_name}->value;
+ $RT::Logger->debug( "Cookie Found",
+ ":: $cookie_name");
+ } else {
+ $RT::Logger->debug( "Cookie Not Found");
+ }
+
+ return $cookie_value;
+}
+
+# }}}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
new file mode 100644
index 0000000..444b621
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -0,0 +1,693 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::Authen::ExternalAuth::LDAP;
+
+use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
+use Net::LDAP::Util qw(ldap_error_name escape_filter_value);
+use Net::LDAP::Filter;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+RT::Authen::ExternalAuth::LDAP - LDAP source for RT authentication
+
+=head1 DESCRIPTION
+
+Provides the LDAP implementation for L<RT::Authen::ExternalAuth>.
+
+=head1 SYNOPSIS
+
+ Set($ExternalSettings, {
+ # AN EXAMPLE LDAP SERVICE
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+
+ 'server' => 'server.domain.tld',
+ 'user' => 'rt_ldap_username',
+ 'pass' => 'rt_ldap_password',
+
+ 'base' => 'ou=Organisational Unit,dc=domain,dc=TLD',
+ 'filter' => '(FILTER_STRING)',
+ 'd_filter' => '(FILTER_STRING)',
+
+ 'group' => 'GROUP_NAME',
+ 'group_attr' => 'GROUP_ATTR',
+
+ 'tls' => { verify => "require", capath => "/path/to/ca.pem" },
+
+ 'net_ldap_args' => [ version => 3 ],
+
+ 'attr_match_list' => [
+ 'Name',
+ 'EmailAddress',
+ ],
+ 'attr_map' => {
+ 'Name' => 'sAMAccountName',
+ 'EmailAddress' => 'mail',
+ 'Organization' => 'physicalDeliveryOfficeName',
+ 'RealName' => 'cn',
+ 'ExternalAuthId' => 'sAMAccountName',
+ 'Gecos' => 'sAMAccountName',
+ 'WorkPhone' => 'telephoneNumber',
+ 'Address1' => 'streetAddress',
+ 'City' => 'l',
+ 'State' => 'st',
+ 'Zip' => 'postalCode',
+ 'Country' => 'co'
+ },
+ },
+ } );
+
+=head1 CONFIGURATION
+
+LDAP-specific options are described here. Shared options
+are described in L<RT::Authen::ExternalAuth>.
+
+The example in the L</SYNOPSIS> lists all available options
+and they are described below. Note that many of these values
+are specific to LDAP, so you should consult your LDAP
+documentation for details.
+
+=over 4
+
+=item server
+
+The server hosting the LDAP or AD service.
+
+=item user, pass
+
+The username and password RT should use to connect to the LDAP
+server.
+
+If you can bind to your LDAP server anonymously you may be able to omit these
+options. Many servers do not allow anonymous binds, or restrict what information
+they can see or how much information they can retrieve. If your server does not
+allow anonymous binds then you must have a service account created for this
+component to function.
+
+=item base
+
+The LDAP search base.
+
+=item filter
+
+The filter to use to match RT users. You B<must> specify it
+and it B<must> be a valid LDAP filter encased in parentheses.
+
+For example:
+
+ filter => '(objectClass=*)',
+
+=item d_filter
+
+The filter that will only match disabled users. Optional.
+B<Must> be a valid LDAP filter encased in parentheses.
+
+For example with Active Directory the following can be used:
+
+ d_filter => '(userAccountControl:1.2.840.113556.1.4.803:=2)'
+
+=item group
+
+Does authentication depend on group membership? What group name?
+
+=item group_attr
+
+What is the attribute for the group object that determines membership?
+
+=item group_scope
+
+What is the scope of the group search? C<base>, C<one> or C<sub>.
+Optional; defaults to C<base>, which is good enough for most cases.
+C<sub> is appropriate when you have nested groups.
+
+=item group_attr_value
+
+What is the attribute of the user entry that should be matched against
+group_attr above? Optional; defaults to C<dn>.
+
+=item tls
+
+Should we try to use TLS to encrypt connections? Either a scalar, for
+simple enabling, or a hash of values to pass to L<Net::LDAP/start_tls>.
+By default, L<Net::LDAP> does B<no> certificate validation! To validate
+certificates, pass:
+
+ tls => { verify => 'require',
+ cafile => "/etc/ssl/certs/ca.pem", # Path CA file
+ },
+
+=item net_ldap_args
+
+What other args should be passed to Net::LDAP->new($host, at args)?
+
+=back
+
+=cut
+
+sub GetAuth {
+
+ my ($service, $username, $password) = @_;
+
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+ $RT::Logger->debug( "Trying external auth service:",$service);
+
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $group = $config->{'group'};
+ my $group_attr = $config->{'group_attr'};
+ my $group_attr_val = $config->{'group_attr_value'} || 'dn';
+ my $group_scope = $config->{'group_scope'} || 'base';
+ my $attr_map = $config->{'attr_map'};
+ my @attrs = ('dn');
+
+ # Make sure we fetch the user attribute we'll need for the group check
+ push @attrs, $group_attr_val
+ unless lc $group_attr_val eq 'dn';
+
+ # Empty parentheses as filters cause Net::LDAP to barf.
+ # We take care of this by using Net::LDAP::Filter, but
+ # there's no harm in fixing this right now.
+ undef $filter if defined $filter and $filter eq "()";
+
+ # Now let's get connected
+ my $ldap = _GetBoundLdapObj($config);
+ return 0 unless ($ldap);
+
+ $filter = Net::LDAP::Filter->new( '(&(' .
+ $attr_map->{'Name'} .
+ '=' .
+ escape_filter_value($username) .
+ ')' .
+ $filter .
+ ')'
+ );
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS || $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->debug( "search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ # Didn't even get a partial result - jump straight to the next external auth service
+ return 0;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $username,
+ "User not found or more than one user found");
+ # We got no user, or too many users.. jump straight to the next external auth service
+ return 0;
+ }
+
+ my $ldap_entry = $ldap_msg->first_entry;
+ my $ldap_dn = $ldap_entry->dn;
+
+ $RT::Logger->debug( "Found LDAP DN:",
+ $ldap_dn);
+
+ # THIS bind determines success or failure on the password.
+ $ldap_msg = $ldap->bind($ldap_dn, password => $password);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "(can't bind:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code,
+ ")");
+ # Could not bind to the LDAP server as the user we found with the password
+ # we were given, therefore the password must be wrong so we fail and
+ # jump straight to the next external auth service
+ return 0;
+ }
+
+ # The user is authenticated ok, but is there an LDAP Group to check?
+ if ($group) {
+ my $group_val = lc $group_attr_val eq 'dn'
+ ? $ldap_dn
+ : $ldap_entry->get_value($group_attr_val);
+
+ # Fallback to the DN if the user record doesn't have a value
+ unless (defined $group_val) {
+ $group_val = $ldap_dn;
+ $RT::Logger->debug("Attribute '$group_attr_val' has no value; falling back to '$group_val'");
+ }
+
+ # We only need the dn for the actual group since all we care about is existence
+ @attrs = qw(dn);
+ $filter = Net::LDAP::Filter->new("(${group_attr}=" . escape_filter_value($group_val) . ")");
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $group,
+ "== Scope:",
+ $group_scope,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ $ldap_msg = $ldap->search( base => $group,
+ filter => $filter,
+ attrs => \@attrs,
+ scope => $group_scope);
+
+ # And the user isn't a member:
+ unless ($ldap_msg->code == LDAP_SUCCESS ||
+ $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->critical( "Search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+
+ # Fail auth - jump to next external auth service
+ return 0;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->debug(
+ "LDAP group membership check returned",
+ $ldap_msg->count, "results"
+ );
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $username);
+
+ # Fail auth - jump to next external auth service
+ return 0;
+ }
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $username);
+ return 1;
+
+}
+
+
+sub CanonicalizeUserInfo {
+
+ my ($service, $key, $value) = @_;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ # Load the config
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # Figure out what's what
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+
+ # Get the list of unique attrs we need
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # This is a bit confusing and probably broken. Something to revisit..
+ my $filter_addition = ($key && $value) ? "(". $key . "=". escape_filter_value($value) .")" : "";
+ if(defined($filter) && ($filter ne "()")) {
+ $filter = Net::LDAP::Filter->new( "(&" .
+ $filter .
+ $filter_addition .
+ ")"
+ );
+ } else {
+ $RT::Logger->debug( "LDAP Filter invalid or not present.");
+ }
+
+ unless (defined($base)) {
+ $RT::Logger->critical( (caller(0))[3],
+ "LDAP baseDN not defined");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ # Get a Net::LDAP object based on the config we provide
+ my $ldap = _GetBoundLdapObj($config);
+
+ # Jump to the next external information service if we can't get one,
+ # errors should be logged by _GetBoundLdapObj so we don't have to.
+ return ($found, %params) unless ($ldap);
+
+ # Do a search for them in LDAP
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search(base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ # If we didn't get at LEAST a partial result, just die now.
+ if ($ldap_msg->code != LDAP_SUCCESS and
+ $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);
+ # $found remains as 0
+
+ # Drop out to the next external information service
+ $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;
+ return ($found, %params);
+
+ } 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(%{$config->{'attr_map'}})) {
+ # XXX TODO: This legacy code wants to be removed since modern
+ # configs will always fall through to the else and the logic is
+ # weird even if you do have the old config.
+ if ($RT::LdapAttrMap and $RT::LdapAttrMap->{$key} eq 'dn') {
+ $params{$key} = $entry->dn();
+ } else {
+ $params{$key} =
+ ($entry->get_value($config->{'attr_map'}->{$key}))[0];
+ }
+ }
+ $found = 1;
+ } else {
+ # Drop out to the next external information service
+ $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;
+ return ($found, %params);
+ }
+ }
+ $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;
+
+ return ($found, %params);
+}
+
+sub UserExists {
+ my ($username,$service) = @_;
+ $RT::Logger->debug("UserExists params:\nusername: $username , service: $service");
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+
+ # While LDAP filters must be surrounded by parentheses, an empty set
+ # of parentheses is an invalid filter and will cause failure
+ # This shouldn't matter since we are now using Net::LDAP::Filter below,
+ # but there's no harm in doing this to be sure
+ undef $filter if defined $filter and $filter eq "()";
+
+ if (defined($config->{'attr_map'}->{'Name'})) {
+ # Construct the complex filter
+ $filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ escape_filter_value($username) .
+ '))'
+ );
+ }
+
+ my $ldap = _GetBoundLdapObj($config);
+ return unless $ldap;
+
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # Check that the user exists in the LDAP service
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ ($filter ? $filter->as_string : ''),
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $user_found = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ if($user_found->count < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "User Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found");
+ return 0;
+ } elsif ($user_found->count > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "User Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username!");
+ return 0;
+ }
+ undef $user_found;
+
+ # If we havent returned now, there must be a valid user.
+ return 1;
+}
+
+sub UserDisabled {
+
+ my ($username,$service) = @_;
+
+ # FIRST, check that the user exists in the LDAP service
+ unless(UserExists($username,$service)) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking");
+ return 0;
+ }
+
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $d_filter = $config->{'d_filter'};
+ my $search_filter;
+
+ # While LDAP filters must be surrounded by parentheses, an empty set
+ # of parentheses is an invalid filter and will cause failure
+ # This shouldn't matter since we are now using Net::LDAP::Filter below,
+ # but there's no harm in doing this to be sure
+ undef $filter if defined $filter and $filter eq "()";
+ undef $d_filter if defined $d_filter and $d_filter eq "()";
+
+ unless ($d_filter) {
+ # If we don't know how to check for disabled users, consider them all enabled.
+ $RT::Logger->debug("No d_filter specified for this LDAP service (",
+ $service,
+ "), so considering all users enabled");
+ return 0;
+ }
+
+ if (defined($config->{'attr_map'}->{'Name'})) {
+ # Construct the complex filter
+ $search_filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ $d_filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ escape_filter_value($username) .
+ '))'
+ );
+ } else {
+ $RT::Logger->debug("You haven't specified an LDAP attribute to match the RT \"Name\" attribute for this service (",
+ $service,
+ "), so it's impossible look up the disabled status of this user (",
+ $username,
+ ") so I'm just going to assume the user is not disabled");
+ return 0;
+
+ }
+
+ my $ldap = _GetBoundLdapObj($config);
+ next unless $ldap;
+
+ # We only need the UID for confirmation now,
+ # the other information would waste time and bandwidth
+ my @attrs = ('uid');
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ ($search_filter ? $search_filter->as_string : ''),
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $disabled_users = $ldap->search(base => $base,
+ filter => $search_filter,
+ attrs => \@attrs);
+ # If ANY results are returned,
+ # we are going to assume the user should be disabled
+ if ($disabled_users->count) {
+ undef $disabled_users;
+ return 1;
+ } else {
+ undef $disabled_users;
+ return 0;
+ }
+}
+# {{{ sub _GetBoundLdapObj
+
+sub _GetBoundLdapObj {
+
+ # Config as hashref
+ my $config = shift;
+
+ # Figure out what's what
+ my $ldap_server = $config->{'server'};
+ my $ldap_user = $config->{'user'};
+ my $ldap_pass = $config->{'pass'};
+ my $ldap_tls = $config->{'tls'};
+ $ldap_tls = $ldap_tls ? {} : undef unless ref $ldap_tls;
+ my $ldap_args = $config->{'net_ldap_args'};
+
+ 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) {
+ # Thanks to David Narayan for the fault tolerance bits
+ eval { $ldap->start_tls( %{$ldap_tls} ); };
+ if ($@) {
+ $RT::Logger->critical( (caller(0))[3],
+ "Can't start TLS: ",
+ $@);
+ return;
+ }
+
+ }
+
+ my $msg = undef;
+
+ if (($ldap_user) and ($ldap_pass)) {
+ $msg = $ldap->bind($ldap_user, password => $ldap_pass);
+ } elsif (($ldap_user) and ( ! $ldap_pass)) {
+ $msg = $ldap->bind($ldap_user);
+ } 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;
+ }
+}
+
+# }}}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/Config.pm b/lib/RT/Config.pm
index bd321ee..8db3a09 100644
--- a/lib/RT/Config.pm
+++ b/lib/RT/Config.pm
@@ -1039,6 +1039,121 @@ our %META;
Message => "The DatabaseRequireSSL configuration option did not enable SSL connections to the database, and has been removed; please remove it from your RT_SiteConfig.pm. Use DatabaseExtraDSN to accomplish the same purpose.",
},
},
+
+ ExternalAuth => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $ExternalAuthEnabled = $self->Get('ExternalAuth');
+ if ( $ExternalAuthEnabled ) {
+ require RT::Authen::ExternalAuth;
+ }
+ }
+ },
+
+ ExternalSettings => {
+ Obfuscate => sub {
+ # Ensure passwords are obfuscated on the System Configuration page
+ my ($config, $sources, $user) = @_;
+
+ my $msg = 'Password not printed';
+ $msg = $user->loc($msg) if $user and $user->Id;
+
+ for my $source (values %$sources) {
+ $source->{pass} = $msg;
+ }
+ return $sources;
+ },
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $settings = shift || {};
+
+ my $remove = sub {
+ my ($service) = @_;
+ delete $settings->{$service};
+
+ $self->Set( 'ExternalAuthPriority',
+ [ grep { $_ ne $service } @{ $self->Get('ExternalAuthPriority') || [] } ] );
+
+ $self->Set( 'ExternalInfoPriority',
+ [ grep { $_ ne $service } @{ $self->Get('ExternalInfoPriority') || [] } ] );
+ };
+
+ for my $service (keys %$settings) {
+ my %conf = %{ $settings->{$service} };
+
+ if ($conf{type} !~ /^(ldap|db|cookie)$/) {
+ $RT::Logger->error(
+ "Service '$service' in ExternalInfoPriority is not ldap, db, or cookie; removing."
+ );
+ $remove->($service);
+ next;
+ }
+
+ next unless $conf{type} eq 'db';
+
+ # Ensure people don't misconfigure DBI auth to point to RT's
+ # Users table; only check server/hostname/table, as
+ # user/pass might be different (root, for instance)
+ no warnings 'uninitialized';
+ next unless lc $conf{server} eq lc RT->Config->Get('DatabaseHost') and
+ lc $conf{database} eq lc RT->Config->Get('DatabaseName') and
+ lc $conf{table} eq 'users';
+
+ $RT::Logger->error(
+ "RT::Authen::ExternalAuth should _not_ be configured with a database auth service ".
+ "that points back to RT's internal Users table. Removing the service '$service'! ".
+ "Please remove it from your config file."
+ );
+
+ $remove->($service);
+ }
+ $self->Set( 'ExternalSettings', $settings );
+ },
+ },
+
+ ExternalAuthPriority => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my @values = @{ shift || [] };
+ if (not @values) {
+ $self->Set( 'ExternalAuthPriority', \@values );
+ return;
+ }
+
+ my %settings = %{ $self->Get('ExternalSettings') };
+ for my $key (grep {not $settings{$_}} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalAuthPriority, as it is not defined in ExternalSettings");
+ }
+ @values = grep {$settings{$_}} @values;
+ $self->Set( 'ExternalAuthPriority', \@values );
+ },
+ },
+
+ ExternalInfoPriority => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my @values = @{ shift || [] };
+ if (not @values) {
+ $RT::Logger->debug("ExternalInfoPriority not defined. User information (including user enabled/disabled) cannot be externally-sourced");
+ $self->Set( 'ExternalInfoPriority', \@values );
+ return;
+ }
+
+ my %settings = %{ $self->Get('ExternalSettings') };
+ for my $key (grep {not $settings{$_}} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalInfoPriority, as it is not defined in ExternalSettings");
+ }
+ @values = grep {$settings{$_}} @values;
+
+ for my $key (grep {$settings{$_}{type} eq "cookie"} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalInfoPriority, as cookie authentication cannot be used as an information source");
+ }
+ @values = grep {$settings{$_}{type} ne "cookie"} @values;
+
+ $self->Set( 'ExternalInfoPriority', \@values );
+ },
+ },
+
);
my %OPTIONS = ();
my @LOADED_CONFIGS = ();
diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index 7d73a4d..7ab6619 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -307,6 +307,10 @@ sub HandleRequest {
$HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
}
+ # attempt external auth
+ $HTML::Mason::Commands::m->comp( '/Elements/DoAuth', %$ARGS )
+ if RT->Config->Get('ExternalAuth');
+
# Process session-related callbacks before any auth attempts
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' );
@@ -318,6 +322,10 @@ sub HandleRequest {
_ForceLogout() unless _UserLoggedIn();
+ # attempt external auth
+ $HTML::Mason::Commands::m->comp( '/Elements/DoAuth', %$ARGS )
+ if RT->Config->Get('ExternalAuth');
+
# Process per-page authentication callbacks
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );
diff --git a/lib/RT/LDAPImport.pm b/lib/RT/LDAPImport.pm
new file mode 100644
index 0000000..c5ba214
--- /dev/null
+++ b/lib/RT/LDAPImport.pm
@@ -0,0 +1,1550 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package RT::LDAPImport;
+
+use warnings;
+use strict;
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(_ldap _group _users));
+use Carp;
+use Net::LDAP;
+use Net::LDAP::Util qw(escape_filter_value);
+use Net::LDAP::Control::Paged;
+use Net::LDAP::Constant qw(LDAP_CONTROL_PAGED);
+use Data::Dumper;
+
+=head1 NAME
+
+RT::LDAPImport - Import Users from an LDAP store
+
+=head1 SYNOPSIS
+
+In C<RT_SiteConfig.pm>:
+
+ Set($LDAPHost,'my.ldap.host');
+ Set($LDAPUser,'me');
+ Set($LDAPPassword,'mypass');
+ Set($LDAPFilter, '(&(cn = users))');
+ Set($LDAPMapping, {Name => 'uid', # required
+ EmailAddress => 'mail',
+ RealName => 'cn',
+ WorkPhone => 'telephoneNumber',
+ Organization => 'departmentName'});
+
+ # If you want to sync Groups from LDAP into RT
+
+ Set($LDAPGroupBase, 'ou=Groups,o=Our Place');
+ Set($LDAPGroupFilter, '(&(cn = Groups))');
+ Set($LDAPGroupMapping, {Name => 'cn',
+ Member_Attr => 'member',
+ Member_Attr_Value => 'dn' });
+
+Running the import:
+
+ # Run a test import
+ /opt/rt4/sbin/rt-ldapimport \
+ --debug > ldapimport.debug 2>&1
+
+ # Run for real, possibly put in cron
+ /opt/rt4/sbin/rt-ldapimport \
+ --import
+
+=head1 CONFIGURATION
+
+All of the configuration for the importer goes in
+your F<RT_SiteConfig.pm> file. Some of these values pass through
+to L<Net::LDAP> so you can check there for valid values and more
+advanced options.
+
+=over
+
+=item C<< Set($LDAPHost,'our.ldap.host'); >>
+
+Hostname or ldap(s):// uri:
+
+=item C<< Set($LDAPUser, 'uid=foo,ou=users,dc=example,dc=com'); >>
+
+Your LDAP username or DN. If unset, we'll attempt an anonymous bind.
+
+=item C<< Set($LDAPPassword, 'ldap pass'); >>
+
+Your LDAP password.
+
+=item C<< Set($LDAPBase, 'ou=People,o=Our Place'); >>
+
+Base object to search from.
+
+=item C<< Set($LDAPFilter, '(&(cn = users))'); >>
+
+The LDAP search filter to apply (in this case, find all the users).
+
+=item C<< Set($LDAPMapping... >>
+
+ Set($LDAPMapping, {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn',
+ WorkPhone => 'telephoneNumber',
+ Organization => 'departmentName'});
+
+This provides the mapping of attributes in RT to attribute(s) in LDAP.
+Only Name is required for RT.
+
+The values in the mapping (i.e. the LDAP fields, the right hand side)
+can be one of the following:
+
+=over 4
+
+=item an attribute
+
+LDAP attribute to use. Only first value is used if attribute is
+multivalue. For example:
+
+ EmailAddress => 'mail',
+
+=item an array reference
+
+The LDAP attributes can also be an arrayref of LDAP fields,
+for example:
+
+ WorkPhone => [qw/CompanyPhone Extension/]
+
+which will be concatenated together with a space. First values
+of each attribute are used in case they have multiple values.
+
+=item a subroutine reference
+
+The LDAP attribute can also be a subroutine reference that does
+mapping, for example:
+
+ YYY => sub {
+ my %args = @_;
+ my @values = grep defined && length, $args{ldap_entry}->get_value('XXX');
+ return @values;
+ },
+
+The subroutine should return value or list of values. The following
+arguments are passed into the function in a hash:
+
+=over 4
+
+=item self
+
+Instance of this class.
+
+=item ldap_entry
+
+L<Net::LDAP::Entry> instance that is currently mapped.
+
+=item import
+
+Boolean value indicating whether it's import or a dry run. If it's
+dry run (import is false) then function shouldn't change anything.
+
+=item mapping
+
+Hash reference with the currently processed mapping, eg. C<$LDAPMapping>.
+
+=item rt_field and ldap_field
+
+The currently processed key and value from the mapping.
+
+=item result
+
+Hash reference with results of completed mappings for this ldap entry.
+This should be used to inject that are not in the mapping, not to inspect.
+Mapping is processed in literal order of the keys.
+
+=back
+
+=back
+
+The keys in the mapping (i.e. the RT fields, the left hand side) may be a user
+custom field name prefixed with C<UserCF.>, for example C<< 'UserCF.Employee
+Number' => 'employeeId' >>. Note that this only B<adds> values at the moment,
+which on single value CFs will remove any old value first. Multiple value CFs
+may behave not quite how you expect. If the attribute no longer exists on a
+user in LDAP, it will be cleared on the RT side as well.
+
+You may also prefix any RT custom field name with C<CF.> inside your mapping to
+add available values to a Select custom field. This effectively takes user
+attributes in LDAP and adds the values as selectable options in a CF. It does
+B<not> set a CF value on any RT object (User, Ticket, Queue, etc). You might
+use this to populate a ticket Location CF with all the locations of your users
+so that tickets can be associated with the locations in use.
+
+=item C<< Set($LDAPCreatePrivileged, 1); >>
+
+By default users are created as Unprivileged, but you can change this by
+setting C<$LDAPCreatePrivileged> to 1.
+
+=item C<< Set($LDAPGroupName,'My Imported Users'); >>
+
+The RT Group new and updated users belong to. By default, all users
+added or updated by the importer will belong to the 'Imported from LDAP'
+group.
+
+=item C<< Set($LDAPSkipAutogeneratedGroup, 1); >>
+
+Set this to true to prevent users from being automatically
+added to the group configured by C<$LDAPGroupName>.
+
+=item C<< Set($LDAPUpdateUsers, 1); >>
+
+By default, existing users are skipped. If you
+turn on LDAPUpdateUsers, we will clobber existing
+data with data from LDAP.
+
+=item C<< Set($LDAPUpdateOnly, 1); >>
+
+By default, we create users who don't exist in RT but do
+match your LDAP filter and obey C<$LDAPUpdateUsers> for existing
+users. This setting updates existing users, overriding
+C<$LDAPUpdateUsers>, but won't create new
+users who are found in LDAP but not in RT.
+
+=item C<< Set($LDAPGroupBase, 'ou=Groups,o=Our Place'); >>
+
+Where to search for groups to import.
+
+=item C<< Set($LDAPGroupFilter, '(&(cn = Groups))'); >>
+
+The search filter to apply.
+
+=item C<< Set($LDAPGroupMapping... >>
+
+ Set($LDAPGroupMapping, {Name => 'cn',
+ Member_Attr => 'member',
+ Member_Attr_Value => 'dn' });
+
+A mapping of RT attributes to LDAP attributes to identify group members.
+Name will become the name of the group in RT, in this case pulling
+from the cn attribute on the LDAP group record returned. Everything
+besides C<Member_Attr_Value> is processed according to rules described
+in documentation for C<$LDAPMapping> option, so value can be array
+or code reference besides scalar.
+
+C<Member_Attr> is the field in the LDAP group record the importer should
+look at for group members. These values (there may be multiple members)
+will then be compared to the RT user name, which came from the LDAP
+user record. See F<t/ldapimport/group-callbacks.t> for a complex example of
+using a code reference as value of this option.
+
+C<Member_Attr_Value>, which defaults to 'dn', specifies where on the LDAP
+user record the importer should look to compare the member value.
+A match between the member field on the group record and this
+identifier (dn or other LDAP field) on a user record means the
+user will be added to that group in RT.
+
+C<id> is the field in LDAP group record that uniquely identifies
+the group. This is optional and shouldn't be equal to mapping for
+Name field. Group names in RT must be distinct and you don't need
+another unique identifier in common situation. However, when you
+rename a group in LDAP, without this option set properly you end
+up with two groups in RT.
+
+You can provide a C<Description> key which will be added as the group
+description in RT. The default description is 'Imported from LDAP'.
+
+=item C<< Set($LDAPImportGroupMembers, 1); >>
+
+When disabled, the default, LDAP group import expects that all LDAP members
+already exist as RT users. Often the user import stage, which happens before
+groups, is used to create and/or update group members by using an
+C<$LDAPFilter> which includes a C<memberOf> attribute.
+
+When enabled, by setting to C<1>, LDAP group members are explicitly imported
+before membership is synced with RT. This enables groups-only configurations
+to also import group members without specifying a potentially long and complex
+C<$LDAPFilter> using C<memberOf>. It's particularly handy when C<memberOf>
+isn't available on user entries.
+
+Note that C<$LDAPFilter> still applies when this option is enabled, so some
+group members may be filtered out from the import.
+
+=item C<< Set($LDAPSizeLimit, 1000); >>
+
+You can set this value if your LDAP server has result size limits.
+
+=back
+
+=head1 Mapping Groups Between RT and LDAP
+
+If you are using the importer, you likely want to manage access via
+LDAP by putting people in groups like 'DBAs' and 'IT Support', but
+also have groups for other non-RT related things. In this case, you
+won't want to create all of your LDAP groups in RT. To limit the groups
+that get mirrored, construct your C<$LDAPGroupFilter> as an OR (|) with
+all of the RT groups you want to mirror from LDAP. For example:
+
+ Set($LDAPGroupBase, 'OU=Groups,OU=Company,DC=COM');
+ Set($LDAPGroupFilter, '(|(CN=DBAs)(CN=IT Support))');
+
+The importer will then import only the groups that match. In this case,
+import means:
+
+=over
+
+=item * Verifying the group is in AD;
+
+=item * Creating the group in RT if it doesn't exist;
+
+=item * Populating the group with the members identified in AD;
+
+=back
+
+The import script will also issue a warning if a user isn't found in RT,
+but this should only happen when testing. When running with --import on,
+users are created before groups are processed, so all users (group
+members) should exist unless there are inconsistencies in your LDAP configuration.
+
+=head1 Running the Import
+
+Executing C<rt-ldapimport> will run a test that connects to your LDAP server
+and prints out a list of the users found. To see more about these users,
+and to see more general debug information, include the C<--debug> flag.
+
+That debug information is also sent to the RT log with the debug level.
+Errors are logged to the screen and to the RT log.
+
+Executing C<rt-ldapimport> with the C<--import> flag will cause it to import
+users into your RT database. It is recommended that you make a database
+backup before doing this. If your filters aren't set properly this could
+create a lot of users or groups in your RT instance.
+
+=head1 LDAP Filters
+
+The L<ldapsearch|http://www.openldap.org/software/man.cgi?query=ldapsearch&manpath=OpenLDAP+2.0-Release>
+utility in openldap can be very helpful while refining your filters.
+
+=head1 METHODS
+
+=head2 connect_ldap
+
+Relies on the config variables C<$LDAPHost>, C<$LDAPUser> and C<$LDAPPassword>
+being set in your RT Config files.
+
+ Set($LDAPHost,'my.ldap.host')
+ Set($LDAPUSER,'me');
+ Set($LDAPPassword,'mypass');
+
+LDAPUser and LDAPPassword can be blank,
+which will cause an anonymous bind.
+
+LDAPHost can be a hostname or an ldap:// ldaps:// uri.
+
+=cut
+
+sub connect_ldap {
+ my $self = shift;
+
+ my $ldap = Net::LDAP->new($RT::LDAPHost);
+ $RT::Logger->debug("connecting to $RT::LDAPHost");
+ unless ($ldap) {
+ $RT::Logger->error("Can't connect to $RT::LDAPHost");
+ return;
+ }
+
+ my $msg;
+ if ($RT::LDAPUser) {
+ $RT::Logger->debug("binding as $RT::LDAPUser");
+ $msg = $ldap->bind($RT::LDAPUser, password => $RT::LDAPPassword);
+ } else {
+ $RT::Logger->debug("binding anonymously");
+ $msg = $ldap->bind;
+ }
+
+ if ($msg->code) {
+ $RT::Logger->error("LDAP bind failed " . $msg->error);
+ return;
+ }
+
+ $self->_ldap($ldap);
+ return $ldap;
+
+}
+
+=head2 run_user_search
+
+Set up the appropriate arguments for a listing of users.
+
+=cut
+
+sub run_user_search {
+ my $self = shift;
+ $self->_run_search(
+ base => $RT::LDAPBase,
+ filter => $RT::LDAPFilter
+ );
+
+}
+
+=head2 _run_search
+
+Executes a search using the provided base and filter.
+
+Will connect to LDAP server using C<connect_ldap>.
+
+Returns an array of L<Net::LDAP::Entry> objects, possibly consolidated from
+multiple LDAP pages.
+
+=cut
+
+sub _run_search {
+ my $self = shift;
+ my $ldap = $self->_ldap||$self->connect_ldap;
+ my %args = @_;
+
+ unless ($ldap) {
+ $RT::Logger->error("fetching an LDAP connection failed");
+ return;
+ }
+
+ my %search = (
+ base => $args{base},
+ filter => $args{filter},
+ scope => ($args{scope} || 'sub'),
+ );
+ my (@results, $page, $cookie);
+
+ if ($RT::LDAPSizeLimit) {
+ $page = Net::LDAP::Control::Paged->new( size => $RT::LDAPSizeLimit, critical => 1 );
+ $search{control} = $page;
+ }
+
+ LOOP: {
+ # Start where we left off
+ $page->cookie($cookie) if $page and $cookie;
+
+ $RT::Logger->debug("searching with: " . join(' ', map { "$_ => '$search{$_}'" } sort keys %search));
+
+ my $result = $ldap->search( %search );
+
+ if ($result->code) {
+ $RT::Logger->error("LDAP search failed " . $result->error);
+ last;
+ }
+
+ push @results, $result->entries;
+
+ # Short circuit early if we're done
+ last if not $result->count
+ or $result->count < ($RT::LDAPSizeLimit || 0);
+
+ if ($page) {
+ if (my $control = $result->control( LDAP_CONTROL_PAGED )) {
+ $cookie = $control->cookie;
+ } else {
+ $RT::Logger->error("LDAP search didn't return a paging control");
+ last;
+ }
+ }
+ redo if $cookie;
+ }
+
+ # Let the server know we're abandoning the search if we errored out
+ if ($cookie) {
+ $RT::Logger->debug("Informing the LDAP server we're done with the result set");
+ $page->cookie($cookie);
+ $page->size(0);
+ $ldap->search( %search );
+ }
+
+ $RT::Logger->debug("search found ".scalar @results." objects");
+ return @results;
+}
+
+=head2 import_users import => 1|0
+
+Takes the results of the search from run_search
+and maps attributes from LDAP into C<RT::User> attributes
+using C<$LDAPMapping>.
+Creates RT users if they don't already exist.
+
+With no arguments, only prints debugging information.
+Pass C<--import> to actually change data.
+
+C<$LDAPMapping>> should be set in your C<RT_SiteConfig.pm>
+file and look like this.
+
+ Set($LDAPMapping, { RTUserField => LDAPField, RTUserField => LDAPField });
+
+RTUserField is the name of a field on an C<RT::User> object
+LDAPField can be a simple scalar and that attribute
+will be looked up in LDAP.
+
+It can also be an arrayref, in which case each of the
+elements will be evaluated in turn. Scalars will be
+looked up in LDAP and concatenated together with a single
+space.
+
+If the value is a sub reference, it will be executed.
+The sub should return a scalar, which will be examined.
+If it is a scalar, the value will be looked up in LDAP.
+If it is an arrayref, the values will be concatenated
+together with a single space.
+
+By default users are created as Unprivileged, but you can change this by
+setting C<$LDAPCreatePrivileged> to 1.
+
+=cut
+
+sub import_users {
+ my $self = shift;
+ my %args = @_;
+
+ $self->_users({});
+
+ my @results = $self->run_user_search;
+ return $self->_import_users( %args, users => \@results );
+}
+
+sub _import_users {
+ my $self = shift;
+ my %args = @_;
+ my $users = $args{users};
+
+ unless ( @$users ) {
+ $RT::Logger->debug("No users found, no import");
+ $self->disconnect_ldap;
+ return;
+ }
+
+ my $mapping = $RT::LDAPMapping;
+ return unless $self->_check_ldap_mapping( mapping => $mapping );
+
+ my $done = 0; my $count = scalar @$users;
+ while (my $entry = shift @$users) {
+ my $user = $self->_build_user_object( ldap_entry => $entry );
+ $self->_import_user( user => $user, ldap_entry => $entry, import => $args{import} );
+ $done++;
+ $RT::Logger->debug("Imported $done/$count users");
+ }
+ return 1;
+}
+
+=head2 _import_user
+
+We have found a user to attempt to import; returns the L<RT::User>
+object if it was found (or created), C<undef> if not.
+
+=cut
+
+sub _import_user {
+ my $self = shift;
+ my %args = @_;
+
+ unless ( $args{user}{Name} ) {
+ $RT::Logger->warn("No Name or Emailaddress for user, skipping ".Dumper($args{user}));
+ return;
+ }
+ if ( $args{user}{Name} =~ /^[0-9]+$/) {
+ $RT::Logger->debug("Skipping user '$args{user}{Name}', as it is numeric");
+ return;
+ }
+
+ $RT::Logger->debug("Processing user $args{user}{Name}");
+ $self->_cache_user( %args );
+
+ $args{user} = $self->create_rt_user( %args );
+ return unless $args{user};
+
+ $self->add_user_to_group( %args );
+ $self->add_custom_field_value( %args );
+ $self->update_object_custom_field_values( %args, object => $args{user} );
+
+ return $args{user};
+}
+
+=head2 _cache_user ldap_entry => Net::LDAP::Entry, [user => { ... }]
+
+Adds the user to a global cache which is used when importing groups later.
+
+Optionally takes a second argument which is a user data object returned by
+_build_user_object. If not given, _cache_user will call _build_user_object
+itself.
+
+Returns the user Name.
+
+=cut
+
+sub _cache_user {
+ my $self = shift;
+ my %args = (@_);
+ my $user = $args{user} || $self->_build_user_object( ldap_entry => $args{ldap_entry} );
+
+ $self->_users({}) if not defined $self->_users;
+
+ my $group_map = $RT::LDAPGroupMapping || {};
+ my $member_attr_val = $group_map->{Member_Attr_Value} || 'dn';
+ my $membership_key = lc $member_attr_val eq 'dn'
+ ? $args{ldap_entry}->dn
+ : $args{ldap_entry}->get_value($member_attr_val);
+
+ # Fallback to the DN if the user record doesn't have a value
+ unless (defined $membership_key) {
+ $membership_key = $args{ldap_entry}->dn;
+ $RT::Logger->warn("User attribute '$member_attr_val' has no value for '$membership_key'; falling back to DN");
+ }
+
+ return $self->_users->{lc $membership_key} = $user->{Name};
+}
+
+sub _show_user_info {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+ my $rt_user = $args{rt_user};
+
+ $RT::Logger->debug( "\tRT Field\tRT Value -> LDAP Value" );
+ foreach my $key (sort keys %$user) {
+ my $old_value;
+ if ($rt_user) {
+ eval { $old_value = $rt_user->$key() };
+ if ($user->{$key} && defined $old_value && $old_value eq $user->{$key}) {
+ $old_value = 'unchanged';
+ }
+ }
+ $old_value ||= 'unset';
+ $RT::Logger->debug( "\t$key\t$old_value => $user->{$key}" );
+ }
+ #$RT::Logger->debug(Dumper($user));
+}
+
+=head2 _check_ldap_mapping
+
+Returns true is there is an C<LDAPMapping> configured,
+returns false, logs an error and disconnects from
+ldap if there is no mapping.
+
+=cut
+
+sub _check_ldap_mapping {
+ my $self = shift;
+ my %args = @_;
+ my $mapping = $args{mapping};
+
+ my @rtfields = keys %{$mapping};
+ unless ( @rtfields ) {
+ $RT::Logger->error("No mapping found, can't import");
+ $self->disconnect_ldap;
+ return;
+ }
+
+ return 1;
+}
+
+=head2 _build_user_object
+
+Utility method which wraps C<_build_object> to provide sane
+defaults for building users. It also tries to ensure a Name
+exists in the returned object.
+
+=cut
+
+sub _build_user_object {
+ my $self = shift;
+ my $user = $self->_build_object(
+ skip => qr/(?i)^(?:User)?CF\./,
+ mapping => $RT::LDAPMapping,
+ @_
+ );
+ $user->{Name} ||= $user->{EmailAddress};
+ return $user;
+}
+
+=head2 _build_object
+
+Internal method - a wrapper around L</_parse_ldap_mapping>
+that flattens results turning every value into a scalar.
+
+The following:
+
+ [
+ [$first_value1, ... ],
+ [$first_value2],
+ $scalar_value,
+ ]
+
+Turns into:
+
+ "$first_value1 $first_value2 $scalar_value"
+
+Arguments are just passed into L</_parse_ldap_mapping>.
+
+=cut
+
+sub _build_object {
+ my $self = shift;
+ my %args = @_;
+
+ my $res = $self->_parse_ldap_mapping( %args );
+ foreach my $value ( values %$res ) {
+ @$value = map { ref $_ eq 'ARRAY'? $_->[0] : $_ } @$value;
+ $value = join ' ', grep defined && length, @$value;
+ }
+ return $res;
+}
+
+=head3 _parse_ldap_mapping
+
+Internal helper method that maps an LDAP entry to a hash
+according to passed arguments. Takes named arguments:
+
+=over 4
+
+=item ldap_entry
+
+L<Net::LDAP::Entry> instance that should be mapped.
+
+=item only
+
+Optional regular expression. If passed then only matching
+entries in the mapping will be processed.
+
+=item skip
+
+Optional regular expression. If passed then matching
+entries in the mapping will be skipped.
+
+=item mapping
+
+Hash that defines how to map. Key defines position
+in the result. Value can be one of the following:
+
+If we're passed a scalar or an array reference then
+value is:
+
+ [
+ [value1_of_attr1, value2_of_attr1],
+ [value1_of_attr2, value2_of_attr2],
+ ]
+
+If we're passed a subroutine reference as value or
+as an element of array, it executes the code
+and returned list is pushed into results array:
+
+ [
+ @result_of_function,
+ ]
+
+All arguments are passed into the subroutine as well
+as a few more. See more in description of C<$LDAPMapping>
+option.
+
+=back
+
+Returns hash reference with results, each value is
+an array with elements either scalars or arrays as
+described above.
+
+=cut
+
+sub _parse_ldap_mapping {
+ my $self = shift;
+ my %args = @_;
+
+ my $mapping = $args{mapping};
+
+ my %res;
+ foreach my $rtfield ( sort keys %$mapping ) {
+ next if $args{'skip'} && $rtfield =~ $args{'skip'};
+ next if $args{'only'} && $rtfield !~ $args{'only'};
+
+ my $ldap_field = $mapping->{$rtfield};
+ my @list = grep defined && length, ref $ldap_field eq 'ARRAY'? @$ldap_field : ($ldap_field);
+ unless (@list) {
+ $RT::Logger->error("Invalid LDAP mapping for $rtfield, no defined fields");
+ next;
+ }
+
+ my @values;
+ foreach my $e (@list) {
+ if (ref $e eq 'CODE') {
+ push @values, $e->(
+ %args,
+ self => $self,
+ rt_field => $rtfield,
+ ldap_field => $ldap_field,
+ result => \%res,
+ );
+ } elsif (ref $e) {
+ $RT::Logger->error("Invalid type of LDAP mapping for $rtfield, value is $e");
+ next;
+ } else {
+ # XXX: get_value asref returns undef if there is no such field on
+ # the entry, should we warn?
+ push @values, grep defined, $args{'ldap_entry'}->get_value( $e, asref => 1 );
+ }
+ }
+ $res{ $rtfield } = \@values;
+ }
+
+ return \%res;
+}
+
+=head2 create_rt_user
+
+Takes a hashref of args to pass to C<RT::User::Create>
+Will try loading the user and will only create a new
+user if it can't find an existing user with the C<Name>
+or C<EmailAddress> arg passed in.
+
+If the C<$LDAPUpdateUsers> variable is true, data in RT
+will be clobbered with data in LDAP. Otherwise we
+will skip to the next user.
+
+If C<$LDAPUpdateOnly> is true, we will not create new users
+but we will update existing ones.
+
+=cut
+
+sub create_rt_user {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ my $user_obj = $self->_load_rt_user(%args);
+
+ if ($user_obj->Id) {
+ my $message = "User $user->{Name} already exists as ".$user_obj->Id;
+ if ($RT::LDAPUpdateUsers || $RT::LDAPUpdateOnly) {
+ $RT::Logger->debug("$message, updating their data");
+ if ($args{import}) {
+ my @results = $user_obj->Update( ARGSRef => $user, AttributesRef => [keys %$user] );
+ $RT::Logger->debug(join("\n", at results)||'no change');
+ } else {
+ $RT::Logger->debug("Found existing user $user->{Name} to update");
+ $self->_show_user_info( %args, rt_user => $user_obj );
+ }
+ } else {
+ $RT::Logger->debug("$message, skipping");
+ }
+ } else {
+ if ( $RT::LDAPUpdateOnly ) {
+ $RT::Logger->debug("User $user->{Name} doesn't exist in RT, skipping");
+ return;
+ } else {
+ if ($args{import}) {
+ my ($val, $msg) = $user_obj->Create( %$user, Privileged => $RT::LDAPCreatePrivileged ? 1 : 0 );
+
+ unless ($val) {
+ $RT::Logger->error("couldn't create user_obj for $user->{Name}: $msg");
+ return;
+ }
+ $RT::Logger->debug("Created user for $user->{Name} with id ".$user_obj->Id);
+ } else {
+ $RT::Logger->debug( "Found new user $user->{Name} to create in RT" );
+ $self->_show_user_info( %args );
+ return;
+ }
+ }
+ }
+
+ unless ($user_obj->Id) {
+ $RT::Logger->error("We couldn't find or create $user->{Name}. This should never happen");
+ }
+ return $user_obj;
+
+}
+
+sub _load_rt_user {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ my $user_obj = RT::User->new($RT::SystemUser);
+
+ $user_obj->Load( $user->{Name} );
+ unless ($user_obj->Id) {
+ $user_obj->LoadByEmail( $user->{EmailAddress} );
+ }
+
+ return $user_obj;
+}
+
+=head2 add_user_to_group
+
+Adds new users to the group specified in the C<$LDAPGroupName>
+variable (defaults to 'Imported from LDAP').
+You can avoid this if you set C<$LDAPSkipAutogeneratedGroup>.
+
+=cut
+
+sub add_user_to_group {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ return if $RT::LDAPSkipAutogeneratedGroup;
+
+ my $group = $self->_group||$self->setup_group;
+
+ my $principal = $user->PrincipalObj;
+
+ if ($group->HasMember($principal)) {
+ $RT::Logger->debug($user->Name . " already a member of " . $group->Name);
+ return;
+ }
+
+ if ($args{import}) {
+ my ($status, $msg) = $group->AddMember($principal->Id);
+ if ($status) {
+ $RT::Logger->debug("Added ".$user->Name." to ".$group->Name." [$msg]");
+ } else {
+ $RT::Logger->error("Couldn't add ".$user->Name." to ".$group->Name." [$msg]");
+ }
+ return $status;
+ } else {
+ $RT::Logger->debug("Would add to ".$group->Name);
+ return;
+ }
+}
+
+=head2 setup_group
+
+Pulls the C<$LDAPGroupName> object out of the DB or
+creates it if we need to do so.
+
+=cut
+
+sub setup_group {
+ my $self = shift;
+ my $group_name = $RT::LDAPGroupName||'Imported from LDAP';
+ my $group = RT::Group->new($RT::SystemUser);
+
+ $group->LoadUserDefinedGroup( $group_name );
+ unless ($group->Id) {
+ my ($id,$msg) = $group->CreateUserDefinedGroup( Name => $group_name );
+ unless ($id) {
+ $RT::Logger->error("Can't create group $group_name [$msg]")
+ }
+ }
+
+ $self->_group($group);
+}
+
+=head3 add_custom_field_value
+
+Adds values to a Select (one|many) Custom Field.
+The Custom Field should already exist, otherwise
+this will throw an error and not import any data.
+
+This could probably use some caching.
+
+=cut
+
+sub add_custom_field_value {
+ my $self = shift;
+ my %args = @_;
+ my $user = $args{user};
+
+ my $data = $self->_build_object(
+ %args,
+ only => qr/^CF\.(.+)$/i,
+ mapping => $RT::LDAPMapping,
+ );
+
+ foreach my $rtfield ( keys %$data ) {
+ next unless $rtfield =~ /^CF\.(.+)$/i;
+ my $cf_name = $1;
+
+ my $cfv_name = $data->{ $rtfield }
+ or next;
+
+ my $cf = RT::CustomField->new($RT::SystemUser);
+ my ($status, $msg) = $cf->Load($cf_name);
+ unless ($status) {
+ $RT::Logger->error("Couldn't load CF [$cf_name]: $msg");
+ next;
+ }
+
+ my $cfv = RT::CustomFieldValue->new($RT::SystemUser);
+ $cfv->LoadByCols( CustomField => $cf->id,
+ Name => $cfv_name );
+ if ($cfv->id) {
+ $RT::Logger->debug("Custom Field '$cf_name' already has '$cfv_name' for a value");
+ next;
+ }
+
+ if ($args{import}) {
+ ($status, $msg) = $cf->AddValue( Name => $cfv_name );
+ if ($status) {
+ $RT::Logger->debug("Added '$cfv_name' to Custom Field '$cf_name' [$msg]");
+ } else {
+ $RT::Logger->error("Couldn't add '$cfv_name' to '$cf_name' [$msg]");
+ }
+ } else {
+ $RT::Logger->debug("Would add '$cfv_name' to Custom Field '$cf_name'");
+ }
+ }
+
+ return;
+
+}
+
+=head3 update_object_custom_field_values
+
+Adds CF values to an object (currently only users). The Custom Field should
+already exist, otherwise this will throw an error and not import any data.
+
+Note that this code only B<adds> values at the moment, which on single value
+CFs will remove any old value first. Multiple value CFs may behave not quite
+how you expect.
+
+=cut
+
+sub update_object_custom_field_values {
+ my $self = shift;
+ my %args = @_;
+ my $obj = $args{object};
+
+ my $data = $self->_build_object(
+ %args,
+ only => qr/^UserCF\.(.+)$/i,
+ mapping => $RT::LDAPMapping,
+ );
+
+ foreach my $rtfield ( sort keys %$data ) {
+ # XXX TODO: accept GroupCF when we call this from group_import too
+ next unless $rtfield =~ /^UserCF\.(.+)$/i;
+ my $cf_name = $1;
+ my $value = $data->{$rtfield};
+ $value = '' unless defined $value;
+
+ my $current = $obj->FirstCustomFieldValue($cf_name);
+ $current = '' unless defined $current;
+
+ if (not length $current and not length $value) {
+ $RT::Logger->debug("\tCF.$cf_name\tskipping, no value in RT and LDAP");
+ next;
+ }
+ elsif ($current eq $value) {
+ $RT::Logger->debug("\tCF.$cf_name\tunchanged => $value");
+ next;
+ }
+
+ $current = 'unset' unless length $current;
+ $RT::Logger->debug("\tCF.$cf_name\t$current => $value");
+ next unless $args{import};
+
+ my ($ok, $msg) = $obj->AddCustomFieldValue( Field => $cf_name, Value => $value );
+ $RT::Logger->error($obj->Name . ": Couldn't add value '$value' for '$cf_name': $msg")
+ unless $ok;
+ }
+}
+
+=head2 import_groups import => 1|0
+
+Takes the results of the search from C<run_group_search>
+and maps attributes from LDAP into C<RT::Group> attributes
+using C<$LDAPGroupMapping>.
+
+Creates groups if they don't exist.
+
+Removes users from groups if they have been removed from the group on LDAP.
+
+With no arguments, only prints debugging information.
+Pass C<--import> to actually change data.
+
+=cut
+
+sub import_groups {
+ my $self = shift;
+ my %args = @_;
+
+ my @results = $self->run_group_search;
+ unless ( @results ) {
+ $RT::Logger->debug("No results found, no group import");
+ $self->disconnect_ldap;
+ return;
+ }
+
+ my $mapping = $RT::LDAPGroupMapping;
+ return unless $self->_check_ldap_mapping( mapping => $mapping );
+
+ my $done = 0; my $count = scalar @results;
+ while (my $entry = shift @results) {
+ my $group = $self->_parse_ldap_mapping(
+ %args,
+ ldap_entry => $entry,
+ skip => qr/^Member_Attr_Value$/i,
+ mapping => $mapping,
+ );
+ foreach my $key ( grep !/^Member_Attr/, keys %$group ) {
+ @{ $group->{$key} } = map { ref $_ eq 'ARRAY'? $_->[0] : $_ } @{ $group->{$key} };
+ $group->{$key} = join ' ', grep defined && length, @{ $group->{$key} };
+ }
+ @{ $group->{'Member_Attr'} } = map { ref $_ eq 'ARRAY'? @$_ : $_ } @{ $group->{'Member_Attr'} }
+ if $group->{'Member_Attr'};
+ $group->{Description} ||= 'Imported from LDAP';
+ unless ( $group->{Name} ) {
+ $RT::Logger->warn("No Name for group, skipping ".Dumper $group);
+ next;
+ }
+ if ( $group->{Name} =~ /^[0-9]+$/) {
+ $RT::Logger->debug("Skipping group '$group->{Name}', as it is numeric");
+ next;
+ }
+ $self->_import_group( %args, group => $group, ldap_entry => $entry );
+ $done++;
+ $RT::Logger->debug("Imported $done/$count groups");
+ }
+ return 1;
+}
+
+=head3 run_group_search
+
+Set up the appropriate arguments for a listing of users.
+
+=cut
+
+sub run_group_search {
+ my $self = shift;
+
+ unless ($RT::LDAPGroupBase && $RT::LDAPGroupFilter) {
+ $RT::Logger->warn("Not running a group import, configuration not set");
+ return;
+ }
+ $self->_run_search(
+ base => $RT::LDAPGroupBase,
+ filter => $RT::LDAPGroupFilter
+ );
+
+}
+
+
+=head2 _import_group
+
+The user has run us with C<--import>, so bring data in.
+
+=cut
+
+sub _import_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $ldap_entry = $args{ldap_entry};
+
+ $RT::Logger->debug("Processing group $group->{Name}");
+ my ($group_obj, $created) = $self->create_rt_group( %args, group => $group );
+ return if $args{import} and not $group_obj;
+ $self->add_group_members(
+ %args,
+ name => $group->{Name},
+ info => $group,
+ group => $group_obj,
+ ldap_entry => $ldap_entry,
+ new => $created,
+ );
+ # XXX TODO: support OCFVs for groups too
+ return;
+}
+
+=head2 create_rt_group
+
+Takes a hashref of args to pass to C<RT::Group::Create>
+Will try loading the group and will only create a new
+group if it can't find an existing group with the C<Name>
+or C<EmailAddress> arg passed in.
+
+If C<$LDAPUpdateOnly> is true, we will not create new groups
+but we will update existing ones.
+
+There is currently no way to prevent Group data from being
+clobbered from LDAP.
+
+=cut
+
+sub create_rt_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+
+ my $group_obj = $self->find_rt_group(%args);
+ return unless defined $group_obj;
+
+ $group = { map { $_ => $group->{$_} } qw(id Name Description) };
+
+ my $id = delete $group->{'id'};
+
+ my $created;
+ if ($group_obj->Id) {
+ if ($args{import}) {
+ $RT::Logger->debug("Group $group->{Name} already exists as ".$group_obj->Id.", updating their data");
+ my @results = $group_obj->Update( ARGSRef => $group, AttributesRef => [keys %$group] );
+ $RT::Logger->debug(join("\n", at results)||'no change');
+ } else {
+ $RT::Logger->debug( "Found existing group $group->{Name} to update" );
+ $self->_show_group_info( %args, rt_group => $group_obj );
+ }
+ } else {
+ if ( $RT::LDAPUpdateOnly ) {
+ $RT::Logger->debug("Group $group->{Name} doesn't exist in RT, skipping");
+ return;
+ }
+
+ if ($args{import}) {
+ my ($val, $msg) = $group_obj->CreateUserDefinedGroup( %$group );
+ unless ($val) {
+ $RT::Logger->error("couldn't create group_obj for $group->{Name}: $msg");
+ return;
+ }
+ $created = $val;
+ $RT::Logger->debug("Created group for $group->{Name} with id ".$group_obj->Id);
+
+ if ( $id ) {
+ my ($val, $msg) = $group_obj->SetAttribute( Name => 'LDAPImport-gid-'.$id, Content => 1 );
+ unless ($val) {
+ $RT::Logger->error("couldn't set attribute: $msg");
+ return;
+ }
+ }
+
+ } else {
+ $RT::Logger->debug( "Found new group $group->{Name} to create in RT" );
+ $self->_show_group_info( %args );
+ return;
+ }
+ }
+
+ unless ($group_obj->Id) {
+ $RT::Logger->error("We couldn't find or create $group->{Name}. This should never happen");
+ }
+ return ($group_obj, $created);
+
+}
+
+=head3 find_rt_group
+
+Loads groups by Name and by the specified LDAP id. Attempts to resolve
+renames and other out-of-sync failures between RT and LDAP.
+
+=cut
+
+sub find_rt_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+
+ my $group_obj = RT::Group->new($RT::SystemUser);
+ $group_obj->LoadUserDefinedGroup( $group->{Name} );
+ return $group_obj unless $group->{'id'};
+
+ unless ( $group_obj->id ) {
+ $RT::Logger->debug("No group in RT named $group->{Name}. Looking by $group->{id} LDAP id.");
+ $group_obj = $self->find_rt_group_by_ldap_id( $group->{'id'} );
+ unless ( $group_obj ) {
+ $RT::Logger->debug("No group in RT with LDAP id $group->{id}. Creating a new one.");
+ return RT::Group->new($RT::SystemUser);
+ }
+
+ $RT::Logger->debug("No group in RT named $group->{Name}, but found group by LDAP id $group->{id}. Renaming the group.");
+ # $group->Update will take care of the name
+ return $group_obj;
+ }
+
+ my $attr_name = 'LDAPImport-gid-'. $group->{'id'};
+ my $rt_gid = $group_obj->FirstAttribute( $attr_name );
+ return $group_obj if $rt_gid;
+
+ my $other_group = $self->find_rt_group_by_ldap_id( $group->{'id'} );
+ if ( $other_group ) {
+ $RT::Logger->debug("Group with LDAP id $group->{id} exists, as well as group named $group->{Name}. Renaming both.");
+ }
+ elsif ( grep $_->Name =~ /^LDAPImport-gid-/, @{ $group_obj->Attributes->ItemsArrayRef } ) {
+ $RT::Logger->debug("No group in RT with LDAP id $group->{id}, but group $group->{Name} has id. Renaming the group and creating a new one.");
+ }
+ else {
+ $RT::Logger->debug("No group in RT with LDAP id $group->{id}, but group $group->{Name} exists and has no LDAP id. Assigning the id to the group.");
+ if ( $args{import} ) {
+ my ($status, $msg) = $group_obj->SetAttribute( Name => $attr_name, Content => 1 );
+ unless ( $status ) {
+ $RT::Logger->error("Couldn't set attribute: $msg");
+ return undef;
+ }
+ $RT::Logger->debug("Assigned $group->{id} LDAP group id to $group->{Name}");
+ }
+ else {
+ $RT::Logger->debug( "Group $group->{'Name'} gets LDAP id $group->{id}" );
+ }
+
+ return $group_obj;
+ }
+
+ # rename existing group to move it out of our way
+ {
+ my ($old, $new) = ($group_obj->Name, $group_obj->Name .' (LDAPImport '. time . ')');
+ if ( $args{import} ) {
+ my ($status, $msg) = $group_obj->SetName( $new );
+ unless ( $status ) {
+ $RT::Logger->error("Couldn't rename group from $old to $new: $msg");
+ return undef;
+ }
+ $RT::Logger->debug("Renamed group $old to $new");
+ }
+ else {
+ $RT::Logger->debug( "Group $old to be renamed to $new" );
+ }
+ }
+
+ return $other_group || RT::Group->new($RT::SystemUser);
+}
+
+=head3 find_rt_group_by_ldap_id
+
+Loads an RT::Group by the ldap provided id (different from RT's internal group
+id)
+
+=cut
+
+sub find_rt_group_by_ldap_id {
+ my $self = shift;
+ my $id = shift;
+
+ my $groups = RT::Groups->new( RT->SystemUser );
+ $groups->LimitToUserDefinedGroups;
+ my $attr_alias = $groups->Join( FIELD1 => 'id', TABLE2 => 'Attributes', FIELD2 => 'ObjectId' );
+ $groups->Limit( ALIAS => $attr_alias, FIELD => 'ObjectType', VALUE => 'RT::Group' );
+ $groups->Limit( ALIAS => $attr_alias, FIELD => 'Name', VALUE => 'LDAPImport-gid-'. $id );
+ return $groups->First;
+}
+
+
+=head3 add_group_members
+
+Iterate over the list of values in the C<Member_Attr> LDAP entry.
+Look up the appropriate username from LDAP.
+Add those users to the group.
+Remove members of the RT Group who are no longer members
+of the LDAP group.
+
+=cut
+
+sub add_group_members {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $groupname = $args{name};
+ my $ldap_entry = $args{ldap_entry};
+
+ $RT::Logger->debug("Processing group membership for $groupname");
+
+ my $members = $args{'info'}{'Member_Attr'};
+ unless (defined $members) {
+ $RT::Logger->warn("No members found for $groupname in Member_Attr");
+ return;
+ }
+
+ if ($RT::LDAPImportGroupMembers) {
+ $RT::Logger->debug("Importing members of group $groupname");
+ my @entries;
+ my $attr = lc($RT::LDAPGroupMapping->{Member_Attr_Value} || 'dn');
+
+ # Lookup each DN's full entry, or...
+ if ($attr eq 'dn') {
+ @entries = grep defined, map {
+ my @results = $self->_run_search(
+ scope => 'base',
+ base => $_,
+ filter => $RT::LDAPFilter,
+ );
+ $results[0]
+ } @$members;
+ }
+ # ...or find all the entries in a single search by attribute.
+ else {
+ # I wonder if this will run into filter length limits? -trs, 22 Jan 2014
+ my $members = join "", map { "($attr=" . escape_filter_value($_) . ")" } @$members;
+ @entries = $self->_run_search(
+ base => $RT::LDAPBase,
+ filter => "(&$RT::LDAPFilter(|$members))",
+ );
+ }
+ $self->_import_users(
+ import => $args{import},
+ users => \@entries,
+ ) or $RT::Logger->debug("Importing group members failed");
+ }
+
+ my %rt_group_members;
+ if ($args{group} and not $args{new}) {
+ my $user_members = $group->UserMembersObj( Recursively => 0);
+
+ # find members who are Disabled too so we don't try to add them below
+ $user_members->FindAllRows;
+
+ while ( my $member = $user_members->Next ) {
+ $rt_group_members{$member->Name} = $member;
+ }
+ } elsif (not $args{import}) {
+ $RT::Logger->debug("No group in RT, would create with members:");
+ }
+
+ my $users = $self->_users;
+ foreach my $member (@$members) {
+ my $username;
+ if (exists $users->{lc $member}) {
+ next unless $username = $users->{lc $member};
+ } else {
+ my $attr = lc($RT::LDAPGroupMapping->{Member_Attr_Value} || 'dn');
+ my $base = $attr eq 'dn' ? $member : $RT::LDAPBase;
+ my $scope = $attr eq 'dn' ? 'base' : 'sub';
+ my $filter = $attr eq 'dn'
+ ? $RT::LDAPFilter
+ : "(&$RT::LDAPFilter($attr=" . escape_filter_value($member) . "))";
+ my @results = $self->_run_search(
+ base => $base,
+ scope => $scope,
+ filter => $filter,
+ );
+ unless ( @results ) {
+ $users->{lc $member} = undef;
+ $RT::Logger->error("No user found for $member who should be a member of $groupname");
+ next;
+ }
+ my $ldap_user = shift @results;
+ $username = $self->_cache_user( ldap_entry => $ldap_user );
+ }
+ if ( delete $rt_group_members{$username} ) {
+ $RT::Logger->debug("\t$username\tin RT and LDAP");
+ next;
+ }
+ $RT::Logger->debug($group ? "\t$username\tin LDAP, adding to RT" : "\t$username");
+ next unless $args{import};
+
+ my $rt_user = RT::User->new($RT::SystemUser);
+ my ($res,$msg) = $rt_user->Load( $username );
+ unless ($res) {
+ $RT::Logger->warn("Unable to load $username: $msg");
+ next;
+ }
+ ($res,$msg) = $group->AddMember($rt_user->PrincipalObj->Id);
+ unless ($res) {
+ $RT::Logger->warn("Failed to add $username to $groupname: $msg");
+ }
+ }
+
+ for my $username (sort keys %rt_group_members) {
+ $RT::Logger->debug("\t$username\tin RT, not in LDAP, removing");
+ next unless $args{import};
+
+ my ($res,$msg) = $group->DeleteMember($rt_group_members{$username}->PrincipalObj->Id);
+ unless ($res) {
+ $RT::Logger->warn("Failed to remove $username to $groupname: $msg");
+ }
+ }
+}
+
+=head2 _show_group
+
+Show debugging information about the group record we're going to import
+when the groups reruns us with C<--import>.
+
+=cut
+
+sub _show_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+
+ my $rt_group = RT::Group->new($RT::SystemUser);
+ $rt_group->LoadUserDefinedGroup( $group->{Name} );
+
+ if ( $rt_group->Id ) {
+ $RT::Logger->debug( "Found existing group $group->{Name} to update" );
+ $self->_show_group_info( %args, rt_group => $rt_group );
+ } else {
+ $RT::Logger->debug( "Found new group $group->{Name} to create in RT" );
+ $self->_show_group_info( %args );
+ }
+}
+
+sub _show_group_info {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $rt_group = $args{rt_group};
+
+ $RT::Logger->debug( "\tRT Field\tRT Value -> LDAP Value" );
+ foreach my $key (sort keys %$group) {
+ my $old_value;
+ if ($rt_group) {
+ eval { $old_value = $rt_group->$key() };
+ if ($group->{$key} && defined $old_value && $old_value eq $group->{$key}) {
+ $old_value = 'unchanged';
+ }
+ }
+ $old_value ||= 'unset';
+ $RT::Logger->debug( "\t$key\t$old_value => $group->{$key}" );
+ }
+}
+
+
+=head3 disconnect_ldap
+
+Disconnects from the LDAP server.
+
+Takes no arguments, returns nothing.
+
+=cut
+
+sub disconnect_ldap {
+ my $self = shift;
+ my $ldap = $self->_ldap;
+ return unless $ldap;
+
+ $ldap->unbind;
+ $ldap->disconnect;
+ $self->_ldap(undef);
+ return;
+}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/User.pm b/lib/RT/User.pm
index e65478d..7a1a61d 100644
--- a/lib/RT/User.pm
+++ b/lib/RT/User.pm
@@ -694,7 +694,8 @@ sub CanonicalizeEmailAddress {
CanonicalizeUserInfo can convert all User->Create options.
it takes a hashref of all the params sent to User->Create and
-returns that same hash, by default nothing is done.
+returns that same hash, by default nothing is done. If external auth is enabled
+CanonicalizeUserInfoFromExternalAuth is called.
This function is intended to allow users to have their info looked up via
an outside source and modified upon creation.
@@ -704,11 +705,130 @@ an outside source and modified upon creation.
sub CanonicalizeUserInfo {
my $self = shift;
my $args = shift;
- my $success = 1;
- return ($success);
+ if ( my $config = RT->Config->Get('ExternalInfoPriority') ) {
+ if ( ref $config && @$config ) {
+ return $self->CanonicalizeUserInfoFromExternalAuth( $args );
+ }
+ }
+
+ return 1; # fall back to old RT::User::CanonicalizeUserInfo
}
+=head2 CanonicalizeUserInfoFromExternalAuth
+
+Convert an ldap entry in to fields that can be used by RT as specified by the
+C<attr_map> configuration in the C<$ExternalSettings> variable for
+L<RT::Authen::ExternalAuth>.
+
+=cut
+
+sub CanonicalizeUserInfoFromExternalAuth {
+
+ # Careful, this $args hashref was given to RT::User::CanonicalizeUserInfo and
+ # then transparently passed on to this function. The whole purpose is to update
+ # the original hash as whatever passed it to RT::User is expecting to continue its
+ # code with an update args hash.
+
+ my $UserObj = shift;
+ my $args = shift;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ $RT::Logger->debug( (caller(0))[3],
+ "called by",
+ caller,
+ "with:",
+ join(", ", map {sprintf("%s: %s", $_, ($args->{$_} ? $args->{$_} : ''))}
+ sort(keys(%$args))));
+
+ # Get the list of defined external services
+ my @info_services = @{ RT->Config->Get('ExternalInfoPriority') };
+ # For each external service...
+ foreach my $service (@info_services) {
+
+ $RT::Logger->debug( "Attempting to get user info using this external service:",
+ $service);
+
+ # Get the config for the service so that we know what attrs we can canonicalize
+ my $config = RT->Config->Get('ExternalSettings')->{$service};
+
+ # For each attr we've been told to canonicalize in the match list
+ foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
+ # Jump to the next attr in $args if this one isn't in the attr_match_list
+ $RT::Logger->debug( "Attempting to use this canonicalization key:",$rt_attr);
+ unless(defined($args->{$rt_attr})) {
+ $RT::Logger->debug("This attribute (",
+ $rt_attr,
+ ") is null or incorrectly defined in the attr_map for this service (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Else, use it as a canonicalization key and lookup the user info
+ my $key = $config->{'attr_map'}->{$rt_attr};
+ my $value = $args->{$rt_attr};
+
+ # Check to see that the key being asked for is defined in the config's attr_map
+ my $valid = 0;
+ my ($attr_key, $attr_value);
+ my $attr_map = $config->{'attr_map'};
+ while (($attr_key, $attr_value) = each %$attr_map) {
+ $valid = 1 if ($key eq $attr_value);
+ }
+ unless ($valid){
+ $RT::Logger->debug( "This key (",
+ $key,
+ "is not a valid attribute key (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Use an if/elsif structure to do a lookup with any custom code needed
+ # for any given type of external service, or die if no code exists for
+ # the service requested.
+
+ if($config->{'type'} eq 'ldap'){
+ ($found, %params) = RT::Authen::ExternalAuth::LDAP::CanonicalizeUserInfo($service,$key,$value);
+ } elsif ($config->{'type'} eq 'db') {
+ ($found, %params) = RT::Authen::ExternalAuth::DBI::CanonicalizeUserInfo($service,$key,$value);
+ }
+
+ # Don't Check any more attributes
+ last if $found;
+ }
+ # Don't Check any more services
+ last if $found;
+ }
+
+ # If found, Canonicalize Email Address and
+ # update the args hash that we were given the hashref for
+ if ($found) {
+ # It's important that we always have a canonical email address
+ if ($params{'EmailAddress'}) {
+ $params{'EmailAddress'} = $UserObj->CanonicalizeEmailAddress($params{'EmailAddress'});
+ }
+ %$args = (%$args, %params);
+ }
+
+ $RT::Logger->info( (caller(0))[3],
+ "returning",
+ join(", ", map {sprintf("%s: %s", $_, ($args->{$_} ? $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->Config->Get('AutoCreateNonExternalUsers'));
+
+}
=head2 Password and authentication related functions
diff --git a/sbin/rt-ldapimport.in b/sbin/rt-ldapimport.in
new file mode 100644
index 0000000..104ee7b
--- /dev/null
+++ b/sbin/rt-ldapimport.in
@@ -0,0 +1,136 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+$|++;
+
+# fix lib paths, some may be relative
+BEGIN { # BEGIN RT CMD BOILERPLATE
+ require File::Spec;
+ require Cwd;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
+
+BEGIN {
+ use RT;
+ RT::LoadConfig();
+ RT::Init();
+};
+
+eval { require RT::LDAPImport; 1; } or do {
+ print "Unable to run rt-ldapimport without dependencies.\n";
+ print "Rerun configure with the --enable-externalauth option.";
+ exit 0;
+};
+
+
+my %OPT = (
+ users => 1,
+ groups => 1,
+);
+use Getopt::Long;
+GetOptions(
+ \%OPT,
+ 'debug', 'help',
+ 'import', 'users!', 'groups!',
+);
+if ($OPT{help}) {
+ print <<USAGE;
+$0: [--debug] [--import] [--help]
+ --help This usage statement.
+ --debug Enable debugging.
+ --import Do the import.
+ --no-users Skip users.
+ --no-groups Skip groups.
+USAGE
+ exit 0;
+}
+
+my $importer = RT::LDAPImport->new;
+
+if( $OPT{debug} ) {
+ RT->Config->Set( LogToSTDERR => 'debug' );
+} else {
+ RT->Config->Set( LogToSTDERR => undef );
+}
+
+if ($OPT{import}) {
+ if ($OPT{users}) {
+ print "Starting import\n";
+ $importer->import_users(import => 1);
+ }
+ if ($OPT{groups}) {
+ print "Starting group import\n";
+ $importer->import_groups(import => 1);
+ }
+ print "Finished import\n";
+} else {
+ print <<TESTING;
+Running test import, no data will be changed
+Rerun command with --import to perform the import
+Rerun command with --debug for more information
+TESTING
+ $importer->import_users if $OPT{users};
+ if ($OPT{groups}) {
+ print "Testing group import\n";
+ $importer->import_groups();
+ }
+ print "Finished test\n";
+}
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index b16bae3..c3c1b2f 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -77,6 +77,7 @@ GetOptions(
'with-DASHBOARDS',
'with-USERLOGO',
'with-HTML-DOC',
+ 'with-EXTERNALAUTH',
'with-S3', 'with-DROPBOX',
@@ -105,6 +106,7 @@ my %default = (
'with-DASHBOARDS' => 1,
'with-USERLOGO' => 1,
'with-HTML-DOC' => @RT_DEVELOPER@,
+ 'with-EXTERNALAUTH' => @RT_EXTERNALAUTH@,
'with-S3' => (uc(q{@ATTACHMENT_STORE@}) eq 'S3'),
'with-DROPBOX' => (uc(q{@ATTACHMENT_STORE@}) eq 'DROPBOX'),
);
@@ -385,6 +387,12 @@ HTML::Entities
Pod::Simple 3.24
.
+$deps{'EXTERNALAUTH'} = [ text_to_hash( <<'.') ];
+Net::SSLeay
+Net::LDAP
+Net::LDAP::Server::Test
+.
+
$deps{'S3'} = [ text_to_hash( <<'.') ];
Amazon::S3
.
diff --git a/share/html/Elements/DoAuth b/share/html/Elements/DoAuth
new file mode 100644
index 0000000..092f794
--- /dev/null
+++ b/share/html/Elements/DoAuth
@@ -0,0 +1,74 @@
+%# BEGIN BPS TAGGED BLOCK {{{
+%#
+%# COPYRIGHT:
+%#
+%# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+%# <sales at bestpractical.com>
+%#
+%# (Except where explicitly superseded by other copyright notices)
+%#
+%#
+%# LICENSE:
+%#
+%# This work is made available to you under the terms of Version 2 of
+%# the GNU General Public License. A copy of that license should have
+%# been provided with this software, but in any event can be snarfed
+%# from www.gnu.org.
+%#
+%# This work is distributed in the hope that it will be useful, but
+%# WITHOUT ANY WARRANTY; without even the implied warranty of
+%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+%# General Public License for more details.
+%#
+%# You should have received a copy of the GNU General Public License
+%# along with this program; if not, write to the Free Software
+%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+%# 02110-1301 or visit their web page on the internet at
+%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+%#
+%#
+%# CONTRIBUTION SUBMISSION POLICY:
+%#
+%# (The following paragraph is not intended to limit the rights granted
+%# to you to modify and distribute this software under the terms of
+%# the GNU General Public License and is only of importance to you if
+%# you choose to contribute your changes and enhancements to the
+%# community by submitting them to Best Practical Solutions, LLC.)
+%#
+%# By intentionally submitting any modifications, corrections or
+%# derivatives to this work, or any other work intended for use with
+%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+%# you are the copyright holder for those contributions and you grant
+%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+%# royalty-free, perpetual, license to use, copy, create derivative
+%# works based on those contributions, and sublicense and distribute
+%# those contributions and any derivatives thereof.
+%#
+%# END BPS TAGGED BLOCK }}}
+<%init>
+# return as quickly as possible if the user is logged in
+return if $session{CurrentUser} && $session{'CurrentUser'}->id;
+
+# It's important to nab the next page from the session before we
+# potentially blow the session away below.
+my $next = $session{'NextPage'}->{ $ARGS{'next'} || "" };
+ $next = $next->{'url'} if ref $next;
+
+my ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
+$RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
+if ( $val ) {
+ $m->callback( %ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler', RedirectTo => \$next );
+}
+
+# Redirect to the relevant page if the above succeeded
+RT::Interface::Web::Redirect( $next )
+ if $val and $next
+ and $m->request_comp->path eq '/NoAuth/Login.html';
+
+# this component should never generate content
+return;
+</%init>
+<%ARGS>
+$user => undef
+$pass => undef
+</%ARGS>
diff --git a/share/html/User/Prefs.html b/share/html/User/Prefs.html
index 3ae793e..019c77b 100644
--- a/share/html/User/Prefs.html
+++ b/share/html/User/Prefs.html
@@ -117,10 +117,12 @@
<td valign="top" class="boxcontainer">
<&| /Widgets/TitleBox, title => loc('Password'), id => "user-prefs-password" &>
+% if ( $UserObj->__Value('Password') ne '*NO-PASSWORD*' ) {
<& /Elements/EditPassword,
User => $UserObj,
Name => [qw(CurrentPass Pass1 Pass2)],
&>
+% }
<& /Elements/EditCustomFields, Object => $UserObj, Grouping => 'Access control' &>
diff --git a/t/externalauth/ldap.t b/t/externalauth/ldap.t
new file mode 100644
index 0000000..6226b43
--- /dev/null
+++ b/t/externalauth/ldap.t
@@ -0,0 +1,104 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $base = "dc=bestpractical,dc=com";
+my $dn = "uid=$username,$base";
+my $entry = {
+ cn => $username,
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ userPassword => 'password',
+};
+$ldap->add( $base );
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( ExternalAuth => 1 );
+
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
+RT->Config->Set(
+ ExternalSettings => { # AN EXAMPLE DB SERVICE
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => $base,
+ 'filter' => '(objectClass=*)',
+ 'd_filter' => '()',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+
+# print "sleeping... ";
+# sleep( 500 );
+# print "done\n";
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
+
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/SelfService/' , 'selfservice page' );
+
+diag "test redirect after login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
+
+$ldap->unbind();
+
+$m->get_warnings;
+
+done_testing;
diff --git a/t/externalauth/ldap_escaping.t b/t/externalauth/ldap_escaping.t
new file mode 100644
index 0000000..cce4e0c
--- /dev/null
+++ b/t/externalauth/ldap_escaping.t
@@ -0,0 +1,107 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+
+my $users_dn = "ou=users,dc=bestpractical,dc=com";
+my $group_dn = "cn=test group,ou=groups,dc=bestpractical,dc=com";
+
+$ldap->add($users_dn);
+$ldap->add(
+ "cn=Smith\\, John,$users_dn",
+ attr => [
+ cn => 'Smith\\, John',
+ mail => 'jsmith at example.com',
+ uid => 'jsmith',
+ objectClass => 'User',
+ userPassword => 'password',
+ ]
+);
+$ldap->add(
+ "cn=John Doe,$users_dn",
+ attr => [
+ cn => 'John Doe',
+ mail => 'jdoe at example.com',
+ uid => 'j(doe',
+ objectClass => 'User',
+ userPassword => 'password',
+ ]
+);
+$ldap->add(
+ $group_dn,
+ attr => [
+ cn => "test group",
+ memberDN => [ "cn=Smith\\, John,$users_dn", "cn=John Doe,$users_dn" ],
+ objectClass => 'Group',
+ ],
+);
+
+RT->Config->Set( ExternalAuth => 1 );
+
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
+RT->Config->Set(
+ ExternalSettings => {
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => $users_dn,
+ 'filter' => '(objectClass=*)',
+ 'd_filter' => '()',
+ 'group' => $group_dn,
+ 'group_attr' => 'memberDN',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "comma in the DN";
+{
+ ok( $m->login( 'jsmith', 'password' ), 'logged in' );
+
+ my $testuser = RT::User->new($RT::SystemUser);
+ my ($ok,$msg) = $testuser->Load( 'jsmith' );
+ ok($ok,$msg);
+ is($testuser->EmailAddress,'jsmith at example.com');
+}
+
+diag "paren in the username";
+{
+ ok( $m->logout, 'logged out' );
+ # $m->login chokes on ( in 4.0.5
+ $m->get_ok($m->rt_base_url . "?user=j(doe;pass=password");
+ $m->content_like(qr/Logout/i, 'contains logout link');
+ $m->content_contains('<span class="current-user">j(doe</span>', 'contains logged in user name');
+
+ my $testuser = RT::User->new($RT::SystemUser);
+ my ($ok,$msg) = $testuser->Load( 'j(doe' );
+ ok($ok,$msg);
+ is($testuser->EmailAddress,'jdoe at example.com');
+}
+
+$ldap->unbind();
+
+undef $m;
+done_testing;
diff --git a/t/externalauth/ldap_group.t b/t/externalauth/ldap_group.t
new file mode 100644
index 0000000..ede53a2
--- /dev/null
+++ b/t/externalauth/ldap_group.t
@@ -0,0 +1,157 @@
+use strict;
+use warnings;
+
+# This lets us change config during runtime without restarting
+BEGIN {
+ $ENV{RT_TEST_WEB_HANDLER} = 'inline';
+}
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+
+my $users_dn = "ou=users,dc=bestpractical,dc=com";
+my $group_dn = "cn=test group,ou=groups,dc=bestpractical,dc=com";
+
+$ldap->add($users_dn);
+for (1 .. 3) {
+ my $uid = "testuser$_";
+ my $entry = {
+ cn => "Test User $_",
+ mail => "$uid\@example.com",
+ uid => $uid,
+ objectClass => 'User',
+ userPassword => 'password',
+ };
+ $ldap->add( "uid=$uid,$users_dn", attr => [%$entry] );
+}
+
+$ldap->add(
+ $group_dn,
+ attr => [
+ cn => "test group",
+ memberDN => [ "uid=testuser1,$users_dn" ],
+ memberUid => [ "testuser2" ],
+ objectClass => 'Group',
+ ],
+);
+
+$ldap->add(
+ "cn=subgroup,$group_dn",
+ attr => [
+ cn => "subgroup",
+ memberUid => [ "testuser3" ],
+ objectClass => "group",
+ ],
+);
+
+RT->Config->Set( ExternalAuth => 1 );
+
+#RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
+RT->Config->Set(
+ ExternalSettings => {
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => $users_dn,
+ 'filter' => '(objectClass=*)',
+ 'd_filter' => '()',
+ 'group' => $group_dn,
+ 'group_attr' => 'memberDN',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "Using DN to match group membership";
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ $m->warning_like(qr/FAILED LOGIN for fakeuser/);
+
+ ok( !$m->login( 'testuser2', 'password' ), 'not logged in with real user not in group' );
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/FAILED LOGIN for testuser2/);
+
+ ok( $m->login( 'testuser1', 'password' ), 'logged in' );
+}
+
+diag "test user creation";
+{
+ my $testuser = RT::User->new($RT::SystemUser);
+ my ($ok,$msg) = $testuser->Load( 'testuser1' );
+ ok($ok,$msg);
+ is($testuser->EmailAddress,'testuser1 at example.com');
+}
+
+$m->logout;
+
+diag "Using uid to match group membership";
+
+RT->Config->Get('ExternalSettings')->{My_LDAP}{group_attr} = 'memberUid';
+RT->Config->Get('ExternalSettings')->{My_LDAP}{group_attr_value} = 'uid';
+diag "test uri login";
+{
+ ok( !$m->login( 'testuser1', 'password' ), 'not logged in with real user not in group' );
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/FAILED LOGIN for testuser1/);
+
+ ok( $m->login( 'testuser2', 'password' ), 'logged in' );
+}
+
+$m->logout;
+
+diag "Subgroup isn't used with default group_scope of base";
+{
+ local $TODO = 'Net::LDAP::Server::Test bug: https://rt.cpan.org/Ticket/Display.html?id=78612'
+ if $Net::LDAP::Server::Test::VERSION <= 0.13;
+ ok( !$m->login( 'testuser3', 'password' ), 'not logged in from subgroup' );
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/LDAP_NO_SUCH_OBJECT/);
+ $m->next_warning_like(qr/FAILED LOGIN for testuser3/);
+ $m->logout;
+}
+
+diag "Using group_scope of sub not base";
+
+RT->Config->Get('ExternalSettings')->{My_LDAP}{group_scope} = 'sub';
+diag "test uri login";
+{
+ ok( !$m->login( 'testuser1', 'password' ), 'not logged in with real user not in group' );
+ $m->warning_like(qr/FAILED LOGIN for testuser1/);
+
+ ok( $m->login( 'testuser2', 'password' ), 'logged in as testuser2' );
+ $m->logout;
+
+ ok( $m->login( 'testuser3', 'password' ), 'logged in as testuser3 from subgroup' );
+ $m->logout;
+}
+
+$ldap->unbind();
+
+undef $m;
+done_testing;
diff --git a/t/externalauth/ldap_privileged.t b/t/externalauth/ldap_privileged.t
new file mode 100644
index 0000000..91c1c9b
--- /dev/null
+++ b/t/externalauth/ldap_privileged.t
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $base = "dc=bestpractical,dc=com";
+my $dn = "uid=$username,$base";
+my $entry = {
+ cn => $username,
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ userPassword => 'password',
+};
+$ldap->add( $base );
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( ExternalAuth => 1 );
+
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => { Privileged => 1 } );
+RT->Config->Set(
+ ExternalSettings => { # AN EXAMPLE DB SERVICE
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => $base,
+ 'filter' => '(objectClass=*)',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
+
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+like( $m->uri, qr!$baseurl/(index\.html)?!, 'privileged home page' );
+
+$ldap->unbind();
+
+$m->get_warnings;
+
+done_testing;
+
diff --git a/t/externalauth/obfuscate-password.t b/t/externalauth/obfuscate-password.t
new file mode 100644
index 0000000..cbe8286
--- /dev/null
+++ b/t/externalauth/obfuscate-password.t
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+RT->Config->Set(
+ ExternalSettings => {
+ 'My_LDAP' => {
+ type => 'ldap',
+ user => 'ldap_bind',
+ pass => 'sekrit',
+ },
+ 'My_DBI' => {
+ type => 'dbi',
+ user => 'external_db_user',
+ pass => 'nottelling',
+ },
+ }
+);
+
+my ($base, $m) = RT::Test->started_ok();
+ok( $m->login, 'logged in' );
+
+$m->get_ok('/Admin/Tools/Configuration.html', 'config page');
+$m->content_lacks('sekrit', 'external source 1 pass obfuscated');
+$m->content_lacks('nottelling', 'external source 2 pass obfuscated');
+$m->content_contains('ldap_bind', 'sanity check: we do have external config dumped');
+$m->content_contains('external_db_user', 'sanity check: we do have external config dumped');
+
+undef $m;
+
+done_testing;
diff --git a/t/externalauth/sessions.t b/t/externalauth/sessions.t
new file mode 100644
index 0000000..9547c6b
--- /dev/null
+++ b/t/externalauth/sessions.t
@@ -0,0 +1,124 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+setup_auth_source();
+
+RT->Config->Set("WebSessionClass" => "Apache::Session::File");
+
+{
+ my %sessions;
+ sub sessions_seen_is {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ my ($agent, $expected, $msg) = @_;
+ $msg ||= "$expected sessions seen";
+
+ $agent->cookie_jar->scan(sub { $sessions{$_[2]}++ if $_[1] =~ /SID/; });
+ is scalar keys %sessions, $expected, $msg;
+ }
+}
+
+my ($base, $m) = RT::Test->started_ok();
+
+diag "Login as tom";
+{
+ sessions_seen_is($m, 0);
+
+ $m->get_ok("/");
+ $m->submit_form(
+ with_fields => {
+ user => 'tom',
+ pass => 'password',
+ },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+ sessions_seen_is($m, 1);
+
+ $m->get_ok("/NoAuth/Logout.html");
+ sessions_seen_is($m, 2);
+}
+
+diag "Login as alex";
+{
+ $m->get_ok("/");
+ $m->submit_form(
+ with_fields => {
+ user => 'alex',
+ pass => 'password',
+ },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+ sessions_seen_is($m, 3);
+
+ $m->get_ok("/NoAuth/Logout.html");
+ sessions_seen_is($m, 4);
+}
+
+undef $m;
+done_testing;
+
+sub setup_auth_source {
+ require DBI;
+ require File::Temp;
+ require Digest::MD5;
+ require File::Spec;
+
+ eval { require DBD::SQLite; } or do {
+ plan skip_all => 'Unable to test without DBD::SQLite';
+ };
+
+ my $dir = File::Temp::tempdir( CLEANUP => 1 );
+ my $dbname = File::Spec->catfile( $dir, 'rtauthtest' );
+ my $table = 'users';
+ my $dbh = DBI->connect("dbi:SQLite:$dbname");
+ my $password = Digest::MD5::md5_hex('password');
+ my $schema = <<" EOF";
+ CREATE TABLE users (
+ username varchar(200) NOT NULL,
+ password varchar(40) NULL,
+ email varchar(16) NULL
+ );
+ EOF
+ $dbh->do( $schema );
+
+ foreach my $user ( qw(tom alex) ){
+ $dbh->do(<<" SQL");
+ INSERT INTO $table VALUES
+ ( '$user', '$password', '$user\@invalid.tld');
+ SQL
+ }
+
+ RT->Config->Set( ExternalAuth => 1 );
+
+ RT->Config->Set( ExternalAuthPriority => ['My_SQLite'] );
+ RT->Config->Set( ExternalInfoPriority => ['My_SQLite'] );
+ RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+ RT->Config->Set( AutoCreate => undef );
+ RT->Config->Set(
+ ExternalSettings => {
+ 'My_SQLite' => {
+ 'type' => 'db',
+ 'database' => $dbname,
+ 'table' => $table,
+ 'dbi_driver' => 'SQLite',
+ 'u_field' => 'username',
+ 'p_field' => 'password',
+ 'p_enc_pkg' => 'Digest::MD5',
+ 'p_enc_sub' => 'md5_hex',
+ 'attr_match_list' => ['Name'],
+ 'attr_map' => {
+ 'Name' => 'username',
+ 'EmailAddress' => 'email',
+ 'ExternalAuthId' => 'username',
+ }
+ },
+ }
+ );
+}
+
diff --git a/t/externalauth/sqlite.t b/t/externalauth/sqlite.t
new file mode 100644
index 0000000..a98e7bc
--- /dev/null
+++ b/t/externalauth/sqlite.t
@@ -0,0 +1,115 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::Authen::ExternalAuth; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::LDAP and Net::LDAP::Server::Test';
+};
+
+use DBI;
+use File::Temp;
+use Digest::MD5;
+use File::Spec;
+
+eval { require DBD::SQLite; } or do {
+ plan skip_all => 'Unable to test without DBD::SQLite';
+};
+
+my $dir = File::Temp::tempdir( CLEANUP => 1 );
+my $dbname = File::Spec->catfile( $dir, 'rtauthtest' );
+my $table = 'users';
+my $dbh = DBI->connect("dbi:SQLite:$dbname");
+my $password = Digest::MD5::md5_hex('password');
+my $schema = <<"EOF";
+CREATE TABLE users (
+ username varchar(200) NOT NULL,
+ password varchar(40) NULL,
+ email varchar(16) NULL
+);
+EOF
+$dbh->do( $schema );
+$dbh->do(
+"INSERT INTO $table VALUES ( 'testuser', '$password', 'testuser\@invalid.tld')"
+);
+
+RT->Config->Set( ExternalAuth => 1 );
+
+RT->Config->Set( ExternalAuthPriority => ['My_SQLite'] );
+RT->Config->Set( ExternalInfoPriority => ['My_SQLite'] );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
+RT->Config->Set(
+ ExternalSettings => {
+ 'My_SQLite' => {
+ 'type' => 'db',
+ 'database' => $dbname,
+ 'table' => $table,
+ 'dbi_driver' => 'SQLite',
+ 'u_field' => 'username',
+ 'p_field' => 'password',
+ 'p_enc_pkg' => 'Digest::MD5',
+ 'p_enc_sub' => 'md5_hex',
+ 'attr_match_list' => ['Name'],
+ 'attr_map' => {
+ 'Name' => 'username',
+ 'EmailAddress' => 'email',
+ 'ExternalAuthId' => 'username',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( !$m->login( 'testuser', 'wrongpassword' ), 'not logged in with wrong password' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/SelfService/', 'selfservice page' );
+
+diag "test redirect after login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
+
+diag "test with user and pass in URL";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html?user=testuser;pass=password', 'closed tickets page' );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html?user=testuser;pass=password' );
+}
+
+$m->get_warnings;
+
+done_testing;
diff --git a/t/ldapimport/group-callbacks.t b/t/ldapimport/group-callbacks.t
new file mode 100644
index 0000000..8a7a689
--- /dev/null
+++ b/t/ldapimport/group-callbacks.t
@@ -0,0 +1,105 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("dc=bestpractical,dc=com");
+
+my @ldap_user_entries;
+for ( 1 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ dn => $dn,
+ cn => "Test User $_",
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_user_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+my @ldap_group_entries;
+for ( 1 .. 4 ) {
+ my $groupname = "Test Group $_";
+ my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => $groupname,
+ gid => $_,
+ members => [ map { 'mail="'. $_->{'mail'} .'"' } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ objectClass => 'Group',
+ };
+ $ldap->add( $dn, attr => [%$entry] );
+ push @ldap_group_entries, $entry;
+}
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPSkipAutogeneratedGroup',1);
+
+RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
+RT->Config->Set('LDAPGroupMapping', {
+ Name => 'cn',
+ Member_Attr => sub {
+ my %args = @_;
+ my $self = $args{'self'};
+ my $members = $args{ldap_entry}->get_value('members', asref => 1);
+ foreach my $record ( @$members ) {
+ my $user = RT::User->new( RT->SystemUser );
+ $user->LoadByEmail($record =~ /mail="(.*)"/);
+ $self->_users->{ lc $record } = $user->Name;
+ }
+ return @$members;
+ },
+});
+
+ok( $importer->import_users( import => 1 ), 'imported users');
+# no id mapping
+{
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+
+ is_member_of('testuser1', 'Test Group 1');
+}
+
+done_testing;
+
+sub is_member_of {
+ my $uname = shift;
+ my $gname = shift;
+
+ my $group = get_group($gname);
+ return ok(0, "found group $gname") unless $group->id;
+
+ my $user = RT::User->new($RT::SystemUser);
+ $user->Load( $uname );
+ return ok(0, "found user $uname") unless $user->id;
+
+ return ok($group->HasMember($user->id), "$uname is member of $gname");
+}
+
+sub get_group {
+ my $gname = shift;
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( $gname );
+ return $group;
+}
+
diff --git a/t/ldapimport/group-import.t b/t/ldapimport/group-import.t
new file mode 100644
index 0000000..25f8719
--- /dev/null
+++ b/t/ldapimport/group-import.t
@@ -0,0 +1,156 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("dc=bestpractical,dc=com");
+
+my @ldap_user_entries;
+for ( 1 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ dn => $dn,
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_user_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+my @ldap_group_entries;
+for ( 1 .. 4 ) {
+ my $groupname = "Test Group $_";
+ my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => $groupname,
+ members => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ memberUid => [ map { $_->{uid} } @ldap_user_entries[($_+1),($_+3),($_+5)] ],
+ objectClass => 'Group',
+ };
+ $ldap->add( $dn, attr => [%$entry] );
+ push @ldap_group_entries, $entry;
+}
+$ldap->add(
+ "cn=42,ou=groups,dc=bestpractical,dc=com",
+ attr => [
+ cn => "42",
+ members => [ "uid=testuser1,ou=foo,dc=bestpractical,dc=com" ],
+ objectClass => 'Group',
+ ],
+);
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPSkipAutogeneratedGroup',1);
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_user_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+}
+
+RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
+RT->Config->Set('LDAPGroupMapping',
+ {Name => 'cn',
+ Member_Attr => 'members',
+ });
+
+# confirm that we skip the import
+ok( $importer->import_groups() );
+{
+ my $groups = RT::Groups->new($RT::SystemUser);
+ $groups->LimitToUserDefinedGroups;
+ is($groups->Count,0);
+}
+
+import_group_members_ok( members => 'dn' );
+
+RT->Config->Set('LDAPGroupMapping',
+ {Name => 'cn',
+ Member_Attr => 'memberUid',
+ Member_Attr_Value => 'uid',
+ });
+import_group_members_ok( memberUid => 'uid' );
+
+{
+ my $uid = $ldap_user_entries[2]->{uid}; # the first user used for memberUid
+ my $user = RT::User->new($RT::SystemUser);
+ my ($ok, $msg) = $user->Load($uid);
+ ok $ok, "Loaded user #$uid" or diag $msg;
+
+ ($ok, $msg) = $user->SetDisabled(1);
+ ok $ok, "Disabled user #$uid" or diag $msg;
+}
+import_group_members_ok( memberUid => 'uid' );
+
+sub import_group_members_ok {
+ my $attr = shift;
+ my $user_attr = shift;
+
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+
+ for my $entry (@ldap_group_entries) {
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( $entry->{cn} );
+ ok($group->Id, "Found $entry->{cn} as ".$group->Id);
+
+ my $idlist;
+ my $members = $group->MembersObj;
+ while (my $group_member = $members->Next) {
+ my $member = $group_member->MemberObj;
+ next unless $member->IsUser();
+ $idlist->{$member->Object->Id}++;
+ }
+
+ foreach my $member ( @{$entry->{$attr}} ) {
+ my ($user) = grep { $_->{$user_attr} eq $member } @ldap_user_entries;
+ my $rt_user = RT::User->new($RT::SystemUser);
+ my ($res,$msg) = $rt_user->Load($user->{uid});
+ unless ($res) {
+ diag("Couldn't load user $user->{uid}: $msg");
+ next;
+ }
+ ok($group->HasMember($rt_user->PrincipalObj->Id),"Correctly assigned $user->{uid} to $entry->{cn}");
+ delete $idlist->{$rt_user->Id};
+ }
+ is(keys %$idlist,0,"No dangling users");
+ }
+
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( "42" );
+ ok( !$group->Id );
+
+ $group->LoadByCols(
+ Domain => 'UserDefined',
+ Name => "42",
+ );
+ ok( !$group->Id );
+}
+
+done_testing;
diff --git a/t/ldapimport/group-member-import.t b/t/ldapimport/group-member-import.t
new file mode 100644
index 0000000..a0a0266
--- /dev/null
+++ b/t/ldapimport/group-member-import.t
@@ -0,0 +1,145 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("dc=bestpractical,dc=com");
+
+my @ldap_user_entries;
+for ( 1 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ dn => $dn,
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_user_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+my @ldap_group_entries;
+for ( 1 .. 4 ) {
+ my $groupname = "Test Group $_";
+ my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => $groupname,
+ members => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ memberUid => [ map { $_->{uid} } @ldap_user_entries[($_+1),($_+3),($_+5)] ],
+ objectClass => 'Group',
+ };
+ $ldap->add( $dn, attr => [%$entry] );
+ push @ldap_group_entries, $entry;
+}
+$ldap->add(
+ "cn=42,ou=groups,dc=bestpractical,dc=com",
+ attr => [
+ cn => "42",
+ members => [ "uid=testuser1,ou=foo,dc=bestpractical,dc=com" ],
+ objectClass => 'Group',
+ ],
+);
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPSkipAutogeneratedGroup',1);
+
+RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
+RT->Config->Set('LDAPGroupMapping',
+ {Name => 'cn',
+ Member_Attr => 'members',
+ });
+RT->Config->Set('LDAPImportGroupMembers',1);
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# confirm that we skip the import
+ok( $importer->import_groups() );
+{
+ my $groups = RT::Groups->new($RT::SystemUser);
+ $groups->LimitToUserDefinedGroups;
+ is($groups->Count,0);
+}
+
+import_group_members_ok( members => 'dn' );
+
+RT->Config->Set('LDAPGroupMapping',
+ {Name => 'cn',
+ Member_Attr => 'memberUid',
+ Member_Attr_Value => 'uid',
+ });
+import_group_members_ok( memberUid => 'uid' );
+
+sub import_group_members_ok {
+ my $attr = shift;
+ my $user_attr = shift;
+
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+
+ for my $entry (@ldap_user_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+ }
+
+ for my $entry (@ldap_group_entries) {
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( $entry->{cn} );
+ ok($group->Id, "Found $entry->{cn} as ".$group->Id);
+
+ my $idlist;
+ my $members = $group->MembersObj;
+ while (my $group_member = $members->Next) {
+ my $member = $group_member->MemberObj;
+ next unless $member->IsUser();
+ $idlist->{$member->Object->Id}++;
+ }
+
+ foreach my $member ( @{$entry->{$attr}} ) {
+ my ($user) = grep { $_->{$user_attr} eq $member } @ldap_user_entries;
+ my $rt_user = RT::User->new($RT::SystemUser);
+ my ($res,$msg) = $rt_user->Load($user->{uid});
+ unless ($res) {
+ diag("Couldn't load user $user->{uid}: $msg");
+ next;
+ }
+ ok($group->HasMember($rt_user->PrincipalObj->Id),"Correctly assigned $user->{uid} to $entry->{cn}");
+ delete $idlist->{$rt_user->Id};
+ }
+ is(keys %$idlist,0,"No dangling users");
+ }
+
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( "42" );
+ ok( !$group->Id );
+
+ $group->LoadByCols(
+ Domain => 'UserDefined',
+ Name => "42",
+ );
+ ok( !$group->Id );
+}
+
+done_testing;
diff --git a/t/ldapimport/group-rename.t b/t/ldapimport/group-rename.t
new file mode 100644
index 0000000..06207d4
--- /dev/null
+++ b/t/ldapimport/group-rename.t
@@ -0,0 +1,138 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("dc=bestpractical,dc=com");
+
+my @ldap_user_entries;
+for ( 1 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ dn => $dn,
+ cn => "Test User $_",
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_user_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+my @ldap_group_entries;
+for ( 1 .. 4 ) {
+ my $groupname = "Test Group $_";
+ my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => $groupname,
+ gid => $_,
+ members => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ objectClass => 'Group',
+ };
+ $ldap->add( $dn, attr => [%$entry] );
+ push @ldap_group_entries, $entry;
+}
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPSkipAutogeneratedGroup',1);
+
+RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
+RT->Config->Set('LDAPGroupMapping',
+ {
+ Name => 'cn',
+ Member_Attr => 'members',
+ });
+
+ok( $importer->import_users( import => 1 ), 'imported users');
+# no id mapping
+{
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+
+ is_member_of('testuser1', 'Test Group 1');
+ ok !get_group('Test Group 1')->FirstAttribute('LDAPImport-gid-1');
+}
+
+# map id
+{
+ RT->Config->Get('LDAPGroupMapping')->{'id'} = 'gid';
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+
+ is_member_of('testuser1', 'Test Group 1');
+ ok get_group('Test Group 1')->FirstAttribute('LDAPImport-gid-1');
+}
+
+# rename a group
+{
+ $ldap->modify(
+ "cn=Test Group 1,ou=groups,dc=bestpractical,dc=com",
+ replace => { 'cn' => 'Test Group 1 Renamed' },
+ );
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+ ok !get_group('Test Group 1')->id;
+ is_member_of('testuser1', 'Test Group 1 Renamed');
+ ok get_group('Test Group 1 Renamed')->FirstAttribute('LDAPImport-gid-1');
+}
+
+# swap two groups
+{
+ is_member_of('testuser2', 'Test Group 2');
+ is_member_of('testuser3', 'Test Group 3');
+ $ldap->modify(
+ "cn=Test Group 2,ou=groups,dc=bestpractical,dc=com",
+ replace => { 'cn' => 'Test Group 3' },
+ );
+ $ldap->modify(
+ "cn=Test Group 3,ou=groups,dc=bestpractical,dc=com",
+ replace => { 'cn' => 'Test Group 2' },
+ );
+ ok( $importer->import_groups( import => 1 ), "imported groups" );
+ is_member_of('testuser2', 'Test Group 3');
+ is_member_of('testuser3', 'Test Group 2');
+ ok get_group('Test Group 2')->FirstAttribute('LDAPImport-gid-3');
+ ok get_group('Test Group 3')->FirstAttribute('LDAPImport-gid-2');
+}
+
+done_testing;
+
+sub is_member_of {
+ my $uname = shift;
+ my $gname = shift;
+
+ my $group = get_group($gname);
+ return ok(0, "found group $gname") unless $group->id;
+
+ my $user = RT::User->new($RT::SystemUser);
+ $user->Load( $uname );
+ return ok(0, "found user $uname") unless $user->id;
+
+ return ok($group->HasMember($user->id), "$uname is member of $gname");
+}
+
+sub get_group {
+ my $gname = shift;
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( $gname );
+ return $group;
+}
+
+
diff --git a/t/ldapimport/user-import-cfs.t b/t/ldapimport/user-import-cfs.t
new file mode 100644
index 0000000..f33ee05
--- /dev/null
+++ b/t/ldapimport/user-import-cfs.t
@@ -0,0 +1,109 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+{
+ my $cf = RT::CustomField->new(RT->SystemUser);
+ my ($ok, $msg) = $cf->Create(
+ Name => 'Employee Number',
+ LookupType => 'RT::User',
+ Type => 'FreeformSingle',
+ Disabled => 0,
+ );
+ ok $cf->Id, $msg;
+
+ my $ocf = RT::ObjectCustomField->new(RT->SystemUser);
+ ($ok, $msg) = $ocf->Create( CustomField => $cf->Id );
+ ok $ocf->Id, $msg;
+}
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("ou=foo,dc=bestpractical,dc=com");
+
+my @ldap_entries;
+for ( 0 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ employeeId => $_,
+ objectClass => 'User',
+ };
+ push @ldap_entries, { dn => $dn, %$entry };
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn',
+ 'UserCF.Employee Number' => 'employeeId',});
+RT->Config->Set('LDAPBase','ou=foo,dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# check that we don't import
+ok($importer->import_users());
+{
+ my $users = RT::Users->new($RT::SystemUser);
+ for my $username (qw/RT_System root Nobody/) {
+ $users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
+ }
+ is($users->Count,0);
+}
+
+# check that we do import
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+ ok(!$user->Privileged, "User created as Unprivileged");
+ is($user->FirstCustomFieldValue('Employee Number'), $entry->{employeeId}, "cf is good: $entry->{employeeId}");
+}
+
+# import again, check that it was cleared
+{
+ my $delete = $ldap_entries[0];
+ $ldap->modify( $delete->{dn}, delete => ['employeeId'] );
+ delete $delete->{employeeId};
+
+ my $update = $ldap_entries[1];
+ $ldap->modify( $update->{dn}, replace => ['employeeId' => 42] );
+ $update->{employeeId} = 42;
+
+ ok($importer->import_users( import => 1 ));
+
+ for my $entry (@ldap_entries[0,1]) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+ is($user->FirstCustomFieldValue('Employee Number'), $entry->{employeeId}, "cf is updated");
+ }
+}
+
+# can't unbind earlier or the server will die
+$ldap->unbind;
+
+done_testing;
diff --git a/t/ldapimport/user-import-privileged.t b/t/ldapimport/user-import-privileged.t
new file mode 100644
index 0000000..dca751a
--- /dev/null
+++ b/t/ldapimport/user-import-privileged.t
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("ou=foo,dc=bestpractical,dc=com");
+
+my @ldap_entries;
+for ( 1 .. 13 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','ou=foo,dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPCreatePrivileged', 1);
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# check that we don't import
+ok($importer->import_users());
+{
+ my $users = RT::Users->new($RT::SystemUser);
+ for my $username (qw/RT_System root Nobody/) {
+ $users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
+ }
+ is($users->Count,0);
+}
+
+# check that we do import
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+ ok($user->Privileged, "User created as Privileged");
+}
+
+# can't unbind earlier or the server will die
+$ldap->unbind;
+
+done_testing;
diff --git a/t/ldapimport/user-import.t b/t/ldapimport/user-import.t
new file mode 100644
index 0000000..4c19c36
--- /dev/null
+++ b/t/ldapimport/user-import.t
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+
+eval { require RT::LDAPImport; require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without RT::LDAPImport and Net::LDAP::Server::Test';
+};
+
+my $importer = RT::LDAPImport->new;
+isa_ok($importer,'RT::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+$ldap->add("ou=foo,dc=bestpractical,dc=com");
+
+my @ldap_entries;
+for ( 1 .. 13 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+$ldap->add(
+ "uid=42,ou=foo,dc=bestpractical,dc=com",
+ attr => [
+ cn => "Numeric user",
+ mail => "numeric\@invalid.tld",
+ uid => 42,
+ objectclass => 'User',
+ ],
+);
+
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','ou=foo,dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# check that we don't import
+ok($importer->import_users());
+{
+ my $users = RT::Users->new($RT::SystemUser);
+ for my $username (qw/RT_System root Nobody/) {
+ $users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
+ }
+ is($users->Count,0);
+}
+
+# check that we do import
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+ ok(!$user->Privileged, "User created as Unprivileged");
+}
+
+# Check that we skipped numeric usernames
+my $user = RT::User->new($RT::SystemUser);
+$user->LoadByCols( EmailAddress => "numeric\@invalid.tld" );
+ok(!$user->Id);
+$user->LoadByCols( Name => 42 );
+ok(!$user->Id);
+$user->Load( 42 );
+ok(!$user->Id);
+
+# can't unbind earlier or the server will die
+$ldap->unbind;
+
+done_testing;
commit 0ff61967703af938f50930b4b69fd08a3b511b36
Merge: b8f848d 007c785
Author: Shawn M Moore <shawn at bestpractical.com>
Date: Mon Nov 2 17:05:18 2015 -0500
Merge branch '4.4/external-auth'
diff --cc configure.ac
index 6ba1dba,01a47bd..c42bdc8
--- a/configure.ac
+++ b/configure.ac
@@@ -436,9 -450,9 +450,10 @@@ AC_CONFIG_FILES(
etc/upgrade/switch-templates-to
etc/upgrade/time-worked-history
etc/upgrade/upgrade-articles
+ etc/upgrade/upgrade-assets
etc/upgrade/vulnerable-passwords
etc/upgrade/upgrade-sla
+ sbin/rt-ldapimport
sbin/rt-attributes-viewer
sbin/rt-preferences-viewer
sbin/rt-session-viewer
diff --cc lib/RT/Config.pm
index cf492c7,8db3a09..0125347
--- a/lib/RT/Config.pm
+++ b/lib/RT/Config.pm
@@@ -988,7 -1031,129 +988,121 @@@ our %META
LogLevel => "info",
Message => "The LogoImageWidth configuration option did not affect display, and has been removed; please remove it from your RT_SiteConfig.pm",
},
+ },
- DatabaseRequireSSL => {
- Deprecated => {
- Remove => '4.4',
- LogLevel => "info",
- Message => "The DatabaseRequireSSL configuration option did not enable SSL connections to the database, and has been removed; please remove it from your RT_SiteConfig.pm. Use DatabaseExtraDSN to accomplish the same purpose.",
- },
- },
+
+ ExternalAuth => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $ExternalAuthEnabled = $self->Get('ExternalAuth');
+ if ( $ExternalAuthEnabled ) {
+ require RT::Authen::ExternalAuth;
+ }
+ }
+ },
+
+ ExternalSettings => {
+ Obfuscate => sub {
+ # Ensure passwords are obfuscated on the System Configuration page
+ my ($config, $sources, $user) = @_;
+
+ my $msg = 'Password not printed';
+ $msg = $user->loc($msg) if $user and $user->Id;
+
+ for my $source (values %$sources) {
+ $source->{pass} = $msg;
+ }
+ return $sources;
+ },
+ PostLoadCheck => sub {
+ my $self = shift;
+ my $settings = shift || {};
+
+ my $remove = sub {
+ my ($service) = @_;
+ delete $settings->{$service};
+
+ $self->Set( 'ExternalAuthPriority',
+ [ grep { $_ ne $service } @{ $self->Get('ExternalAuthPriority') || [] } ] );
+
+ $self->Set( 'ExternalInfoPriority',
+ [ grep { $_ ne $service } @{ $self->Get('ExternalInfoPriority') || [] } ] );
+ };
+
+ for my $service (keys %$settings) {
+ my %conf = %{ $settings->{$service} };
+
+ if ($conf{type} !~ /^(ldap|db|cookie)$/) {
+ $RT::Logger->error(
+ "Service '$service' in ExternalInfoPriority is not ldap, db, or cookie; removing."
+ );
+ $remove->($service);
+ next;
+ }
+
+ next unless $conf{type} eq 'db';
+
+ # Ensure people don't misconfigure DBI auth to point to RT's
+ # Users table; only check server/hostname/table, as
+ # user/pass might be different (root, for instance)
+ no warnings 'uninitialized';
+ next unless lc $conf{server} eq lc RT->Config->Get('DatabaseHost') and
+ lc $conf{database} eq lc RT->Config->Get('DatabaseName') and
+ lc $conf{table} eq 'users';
+
+ $RT::Logger->error(
+ "RT::Authen::ExternalAuth should _not_ be configured with a database auth service ".
+ "that points back to RT's internal Users table. Removing the service '$service'! ".
+ "Please remove it from your config file."
+ );
+
+ $remove->($service);
+ }
+ $self->Set( 'ExternalSettings', $settings );
+ },
+ },
+
+ ExternalAuthPriority => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my @values = @{ shift || [] };
+ if (not @values) {
+ $self->Set( 'ExternalAuthPriority', \@values );
+ return;
+ }
+
+ my %settings = %{ $self->Get('ExternalSettings') };
+ for my $key (grep {not $settings{$_}} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalAuthPriority, as it is not defined in ExternalSettings");
+ }
+ @values = grep {$settings{$_}} @values;
+ $self->Set( 'ExternalAuthPriority', \@values );
+ },
+ },
+
+ ExternalInfoPriority => {
+ PostLoadCheck => sub {
+ my $self = shift;
+ my @values = @{ shift || [] };
+ if (not @values) {
+ $RT::Logger->debug("ExternalInfoPriority not defined. User information (including user enabled/disabled) cannot be externally-sourced");
+ $self->Set( 'ExternalInfoPriority', \@values );
+ return;
+ }
+
+ my %settings = %{ $self->Get('ExternalSettings') };
+ for my $key (grep {not $settings{$_}} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalInfoPriority, as it is not defined in ExternalSettings");
+ }
+ @values = grep {$settings{$_}} @values;
+
+ for my $key (grep {$settings{$_}{type} eq "cookie"} @values) {
+ $RT::Logger->error("Removing '$key' from ExternalInfoPriority, as cookie authentication cannot be used as an information source");
+ }
+ @values = grep {$settings{$_}{type} ne "cookie"} @values;
+
+ $self->Set( 'ExternalInfoPriority', \@values );
+ },
},
-
);
my %OPTIONS = ();
my @LOADED_CONFIGS = ();
diff --cc share/html/Prefs/AboutMe.html
index d8a14cf,0000000..fadd68b
mode 100644,000000..100644
--- a/share/html/Prefs/AboutMe.html
+++ b/share/html/Prefs/AboutMe.html
@@@ -1,304 -1,0 +1,306 @@@
+%# BEGIN BPS TAGGED BLOCK {{{
+%#
+%# COPYRIGHT:
+%#
+%# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+%# <sales at bestpractical.com>
+%#
+%# (Except where explicitly superseded by other copyright notices)
+%#
+%#
+%# LICENSE:
+%#
+%# This work is made available to you under the terms of Version 2 of
+%# the GNU General Public License. A copy of that license should have
+%# been provided with this software, but in any event can be snarfed
+%# from www.gnu.org.
+%#
+%# This work is distributed in the hope that it will be useful, but
+%# WITHOUT ANY WARRANTY; without even the implied warranty of
+%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+%# General Public License for more details.
+%#
+%# You should have received a copy of the GNU General Public License
+%# along with this program; if not, write to the Free Software
+%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+%# 02110-1301 or visit their web page on the internet at
+%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+%#
+%#
+%# CONTRIBUTION SUBMISSION POLICY:
+%#
+%# (The following paragraph is not intended to limit the rights granted
+%# to you to modify and distribute this software under the terms of
+%# the GNU General Public License and is only of importance to you if
+%# you choose to contribute your changes and enhancements to the
+%# community by submitting them to Best Practical Solutions, LLC.)
+%#
+%# By intentionally submitting any modifications, corrections or
+%# derivatives to this work, or any other work intended for use with
+%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+%# you are the copyright holder for those contributions and you grant
+%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+%# royalty-free, perpetual, license to use, copy, create derivative
+%# works based on those contributions, and sublicense and distribute
+%# those contributions and any derivatives thereof.
+%#
+%# END BPS TAGGED BLOCK }}}
+<& /Elements/Header, Title=>loc("Preferences") &>
+<& /Elements/Tabs &>
+
+<& /Elements/ListActions, actions => \@results &>
+
+<form action="<%RT->Config->Get('WebPath')%>/Prefs/AboutMe.html" method="post">
+<input type="hidden" class="hidden" name="id" value="<%$UserObj->Id%>" />
+
+<table width="100%" border="0">
+<tr>
+
+<td valign="top" class="boxcontainer">
+<&| /Widgets/TitleBox, title => loc('Identity'), id => "user-prefs-identity" &>
+
+<input type="hidden" class="hidden" name="Name" value="<%$UserObj->Name%>" />
+<table cellspacing="0" cellpadding="0">
+ <tr>
+ <td class="label"><&|/l&>Email</&>: </td>
+ <td class="value"><input name="EmailAddress" value="<%$UserObj->EmailAddress%>" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Real Name</&>:</td>
+ <td class="value"><input name="RealName" value="<%$UserObj->RealName%>" /></td> </tr>
+ <tr>
+ <td class="label"><&|/l&>Nickname</&>:</td>
+ <td class="value"><input name="NickName" value="<%$UserObj->NickName || ''%>" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Language</&>:</td>
+ <td class="value"><& /Elements/SelectLang, Name => 'Lang', Default => $UserObj->Lang &></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Timezone</&>:</td>
+ <td class="value"><& /Elements/SelectTimezone, Name => 'Timezone', Default => $UserObj->Timezone &></td>
+ </tr>
+<& /Elements/EditCustomFields, Object => $UserObj, Grouping => 'Identity', InTable => 1 &>
+</table>
+</&>
+<&| /Widgets/TitleBox, title => loc('Phone numbers'), id => "user-prefs-phone" &>
+<table cellspacing="0" cellpadding="0">
+ <tr>
+ <td class="label"><&|/l&>Residence</&>:</td>
+ <td class="value"><input name="HomePhone" value="<%$UserObj->HomePhone || ''%>" size="13" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Work</&>:</td>
+ <td class="value"><input name="WorkPhone" value="<%$UserObj->WorkPhone || ''%>" size="13" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Mobile</&>:</td>
+ <td class="value"><input name="MobilePhone" value="<%$UserObj->MobilePhone || ''%>" size="13" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Pager</&>:</td>
+ <td class="value"><input name="PagerPhone" value="<%$UserObj->PagerPhone || ''%>" size="13" /></td>
+ </tr>
+<& /Elements/EditCustomFields, Object => $UserObj, Grouping => 'Phones', InTable => 1 &>
+</table>
+</&>
+
+%if ($UserObj->Privileged) {
+<&| /Widgets/TitleBox, title => loc('Signature'), id => "user-prefs-signature" &>
+<textarea cols="80" rows="5" name="Signature" class="signature" wrap="hard">
+<%$UserObj->Signature || ''%></textarea>
+</&>
+% }
+
+% $m->callback( %ARGS, UserObj => $UserObj, CallbackName => 'FormLeftColumn' );
+</td>
+<td valign="top" class="boxcontainer">
+
+<&| /Widgets/TitleBox, title => loc('Password'), id => "user-prefs-password" &>
++% if ( $UserObj->__Value('Password') ne '*NO-PASSWORD*' ) {
+<& /Elements/EditPassword,
+ User => $UserObj,
+ Name => [qw(CurrentPass Pass1 Pass2)],
+&>
++% }
+
+<& /Elements/EditCustomFields, Object => $UserObj, Grouping => 'Access control' &>
+
+</&>
+
+<&| /Widgets/TitleBox, title => loc('Location'), id => "user-prefs-location" &>
+<table cellspacing="0" cellpadding="0">
+ <tr>
+ <td class="label"><&|/l&>Organization</&>:</td>
+ <td class="value"><input name="Organization" value="<%$UserObj->Organization || ''%>" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Address1</&>:</td>
+ <td class="value"><input name="Address1" value="<%$UserObj->Address1 || ''%>" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Address2</&>:</td>
+ <td class="value"><input name="Address2" value="<%$UserObj->Address2 || ''%>" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>City</&>:</td>
+ <td><input name="City" value="<%$UserObj->City || ''%>" size="14" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>State</&>:</td>
+ <td class="value"><input name="State" value="<%$UserObj->State || ''%>" size="3" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Zip</&>:</td>
+ <td class="value"><input name="Zip" value="<%$UserObj->Zip || ''%>" size="9" /></td>
+ </tr>
+ <tr>
+ <td class="label"><&|/l&>Country</&>:</td>
+ <td class="value"><input name="Country" value="<%$UserObj->Country || ''%>" /></td>
+ </tr>
+<& /Elements/EditCustomFields, Object => $UserObj, Grouping => 'Location', InTable => 1 &>
+</table>
+</&>
+
+
+
+<& /Elements/EditCustomFieldCustomGroupings, Object => $UserObj &>
+
+
+
+<& /Elements/Submit, Label => loc('Save Preferences') &>
+
+<&| /Widgets/TitleBox, title => loc('Secret authentication token'), id => "user-prefs-feeds" &>
+
+<&|/l&>All iCal feeds embed a secret token which authorizes you. If the URL for one of your iCal feeds was exposed to the outside world, you can get a new secret, <b>breaking all existing iCal feeds</b>, below.</&>
+
+<a href="#" id="ResetAuthTokenPrompt" style="display: none">
+ <&|/l&>I want to reset my secret token.</&>
+</a>
+<& /Elements/Submit,
+ Label => loc('Reset secret authentication token'),
+ Name => "ResetAuthToken",
+ id => "ResetAuthTokenContainer" &>
+<script>
+ jQuery("#ResetAuthTokenContainer").hide();
+ jQuery("#ResetAuthTokenPrompt").show().click(function(ev){
+ jQuery(this).slideUp();
+ jQuery("#ResetAuthTokenContainer").slideDown();
+ ev.preventDefault();
+ });
+</script>
+</&>
+
+% $m->callback( %ARGS, UserObj => $UserObj, CallbackName => 'FormRightColumn' );
+</td>
+</tr>
+
+</table>
+
+% $m->callback( %ARGS, UserObj => $UserObj, CallbackName => 'FormEnd' );
+
+</form>
+
+
+<%INIT>
+
+my $UserObj = RT::User->new( $session{'CurrentUser'} );
+$UserObj->Load($id) if $id;
+$UserObj->Load($Name) if $Name && !$UserObj->id;
+unless ( $UserObj->id ) {
+ Abort(loc("Couldn't load user #[_1] or user '[_2]'", $id, $Name))
+ if $id && $Name;
+ Abort(loc("Couldn't load user #[_1]", $id))
+ if $id;
+ Abort(loc("Couldn't load user '[_1]'", $Name))
+ if $Name;
+ Abort(loc("Couldn't load user"));
+}
+$id = $UserObj->id;
+
+my @results;
+
+if ( $ARGS{'ResetAuthToken'} ) {
+ my ($status, $msg) = $UserObj->GenerateAuthToken;
+ push @results, $msg;
+}
+else {
+ my @fields = qw(
+ Name Comments Signature EmailAddress FreeformContactInfo
+ Organization RealName NickName Lang Gecos HomePhone WorkPhone
+ MobilePhone PagerPhone Address1 Address2 City State Zip Country
+ Timezone
+ );
+
+ $m->callback(
+ CallbackName => 'UpdateLogic',
+ fields => \@fields,
+ results => \@results,
+ UserObj => $UserObj,
+ ARGSRef => \%ARGS,
+ );
+
+ push @results, UpdateRecordObject (
+ AttributesRef => \@fields,
+ Object => $UserObj,
+ ARGSRef => \%ARGS,
+ );
+
+ push @results, ProcessObjectCustomFieldUpdates( ARGSRef => \%ARGS, Object => $UserObj );
+
+ # Deal with special fields: Privileged, Enabled, and Password
+ if ( $SetPrivileged and $Privileged != $UserObj->Privileged ) {
+ my ($code, $msg) = $UserObj->SetPrivileged( $Privileged );
+ push @results, loc('Privileged status: [_1]', loc_fuzzy($msg));
+ }
+
+ my %password_cond = $UserObj->CurrentUserRequireToSetPassword;
+ if (defined $Pass1 && length $Pass1 ) {
+ my ($status, $msg) = $UserObj->SafeSetPassword(
+ Current => $CurrentPass,
+ New => $Pass1,
+ Confirmation => $Pass2,
+ );
+ push @results, loc("Password: [_1]", $msg);
+ }
+}
+
+
+MaybeRedirectForResults(
+ Actions => \@results,
+);
+
+</%INIT>
+
+
+<%ARGS>
+$id => $session{'CurrentUser'}->Id
+$Name => undef
+$Comments => undef
+$Signature => undef
+$EmailAddress => undef
+$FreeformContactInfo => undef
+$Organization => undef
+$RealName => undef
+$NickName => undef
+$Privileged => undef
+$SetPrivileged => undef
+$Enabled => undef
+$SetEnabled => undef
+$Lang => undef
+$Gecos => undef
+$HomePhone => undef
+$WorkPhone => undef
+$MobilePhone => undef
+$PagerPhone => undef
+$Address1 => undef
+$Address2 => undef
+$City => undef
+$State => undef
+$Zip => undef
+$Country => undef
+$CurrentPass => undef
+$Pass1 => undef
+$Pass2 => undef
+$Create=> undef
+</%ARGS>
-----------------------------------------------------------------------
More information about the rt-commit
mailing list