diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt
index 7ee41a343..2c03a7006 100644
--- a/docs/changelog/7.x.x.txt
+++ b/docs/changelog/7.x.x.txt
@@ -12,6 +12,7 @@
- fixed #11220: Map asset badly broken
- fixed #11222: testEnvironment.pl Missing Dependencies
- fixed #11226: New stylesheet (wg-base.css), new style templates (from the TWG)
+ - fixed #11216: LDAP Connections status incorrect
7.8.4
- Fixed a compatibility problem between WRE and new Spectre code.
diff --git a/lib/WebGUI/LDAPLink.pm b/lib/WebGUI/LDAPLink.pm
index daa358ff1..49a97f2a9 100644
--- a/lib/WebGUI/LDAPLink.pm
+++ b/lib/WebGUI/LDAPLink.pm
@@ -141,6 +141,19 @@ sub get {
#-------------------------------------------------------------------
+=head2 getErrorCode ( )
+
+Returns the numerical error code generated by the bind() method.
+
+=cut
+
+sub getErrorCode {
+ my $self = shift;
+ return $self->{_error};
+}
+
+#-------------------------------------------------------------------
+
=head2 getErrorMessage ( [ldapErrorCode] )
Returns the error string representing the error code generated by Net::LDAP. If no code is passed in, the most recent error stored by the class is returned
@@ -153,7 +166,7 @@ A valid ldap error code.
sub getErrorMessage {
my $self = shift;
- my $errorCode = shift || $self->{_error};
+ my $errorCode = shift || $self->getErrorMessage;
return "" unless $errorCode;
my $i18nCode = "LDAPLink_".$errorCode;
my $i18n = WebGUI::International->new($self->session,"AuthLDAP");
@@ -242,12 +255,11 @@ The ldapLinkId of the ldapLink you're creating an object reference for.
=cut
sub new {
- my ($ldapLinkId, $ldapLink);
- my $class = shift;
- my $session = shift;
- $ldapLinkId = shift;
+ my $class = shift;
+ my $session = shift;
+ my $ldapLinkId = shift;
return undef unless $ldapLinkId;
- $ldapLink = $session->db->quickHashRef("select * from ldapLink where ldapLinkId=?",[$ldapLinkId]);
+ my $ldapLink = $session->db->quickHashRef("select * from ldapLink where ldapLinkId=?",[$ldapLinkId]);
bless {_session=>$session, _ldapLinkId=>$ldapLinkId, _ldapLink=>$ldapLink }, $class;
}
diff --git a/lib/WebGUI/Operation/LDAPLink.pm b/lib/WebGUI/Operation/LDAPLink.pm
index cac6aad64..5d7e8690a 100644
--- a/lib/WebGUI/Operation/LDAPLink.pm
+++ b/lib/WebGUI/Operation/LDAPLink.pm
@@ -380,10 +380,11 @@ sub www_listLDAPLinks {
my $ldapLink = WebGUI::LDAPLink->new($session,$data->{ldapLinkId});
my $status = $i18n->get("LDAPLink_1078");
- if ($ldapLink->bind) {
+ if ($ldapLink->bind && $ldapLink->getErrorCode == 0) {
$status = $i18n->get("LDAPLink_1079");
} else {
$session->errorHandler->warn($ldapLink->getErrorMessage());
+ $status .= ": ".$ldapLink->getErrorMessage();
}
$ldapLink->unbind;
$row[$i] .= '
'.$status.' | ';
diff --git a/t/LDAPLink.t b/t/LDAPLink.t
new file mode 100644
index 000000000..f068a35eb
--- /dev/null
+++ b/t/LDAPLink.t
@@ -0,0 +1,82 @@
+# vim:syntax=perl
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#------------------------------------------------------------------
+# http://www.plainblack.com info@plainblack.com
+#------------------------------------------------------------------
+
+# Test Auth::LDAP to make sure it works with both ldap and ldaps
+#
+#
+
+use FindBin;
+use strict;
+use lib "$FindBin::Bin/lib";
+use Test::More;
+use Test::Deep;
+use Data::Dumper;
+use WebGUI::Test; # Must use this before any other WebGUI modules
+use WebGUI::Session;
+use WebGUI::LDAPLink;
+
+#----------------------------------------------------------------------------
+# Init
+my $session = WebGUI::Test->session;
+
+#----------------------------------------------------------------------------
+# Tests
+
+plan tests => 8; # Increment this number for each test you create
+
+
+###########################################################################
+#
+# new
+#
+###########################################################################
+
+{
+ my $ldap = WebGUI::LDAPLink->new($session, "new");
+ addToCleanup($ldap);
+ isa_ok($ldap, 'WebGUI::LDAPLink');
+ is $ldap->{_ldapLinkId}, "new", '... created with correct linkId';
+}
+
+###########################################################################
+#
+# successful bind
+#
+###########################################################################
+
+{
+ my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
+ $session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});
+ my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId});
+ addToCleanup($ldap);
+ cmp_deeply $ldap->get(), superhashof($ldapProps), 'all db properties retrieved';
+ my $connection = $ldap->bind();
+ isa_ok $connection, 'Net::LDAP', 'returned by bind';
+ is $ldap->{'_error'}, undef, 'no errors from binding'
+}
+
+###########################################################################
+#
+# failed bind
+#
+###########################################################################
+
+{
+ my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
+ $ldapProps->{identifier} = 'hadley';
+ $session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});
+ my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId});
+ addToCleanup($ldap);
+ my $connection = $ldap->bind();
+ isa_ok $connection, 'Net::LDAP', 'returned by bind';
+ is $ldap->{_error}, 104, 'auth error due to bad identifier';
+ is $ldap->getErrorCode, 104, 'getErrorCode returns the stored error code';
+}
diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm
index 05b4e5154..afe889baa 100644
--- a/t/lib/WebGUI/Test.pm
+++ b/t/lib/WebGUI/Test.pm
@@ -113,6 +113,7 @@ sub import {
'Transaction Items' => 'transactionItem',
'Ship Drivers' => 'shipper',
'Database Links' => 'databaseLink',
+ 'LDAP Links' => 'ldapLink',
);
my %initCounts;
for ( my $i = 0; $i < @checkCount; $i += 2) {
@@ -497,6 +498,27 @@ sub webguiBirthday {
#----------------------------------------------------------------------------
+=head2 getSmokeLDAPProps ( )
+
+Returns a hashref of properties for connecting to smoke's LDAP server.
+
+=cut
+
+sub getSmokeLDAPProps {
+ my $ldapProps = {
+ ldapLinkName => "Test LDAP Link",
+ ldapUrl => "ldaps://smoke.plainblack.com/ou=Convicts,o=shawshank", # Always test ldaps
+ connectDn => "cn=Samuel Norton,ou=Warden,o=shawshank",
+ identifier => "gooey",
+ ldapUserRDN => "dn",
+ ldapIdentity => "cn",
+ ldapLinkId => sprintf( '%022s', "testlink" ),
+ };
+ return $ldapProps;
+}
+
+#----------------------------------------------------------------------------
+
=head2 prepareMailServer ( )
Prepare a Net::SMTP::Server to use for testing mail.
@@ -772,6 +794,7 @@ were passed in. Currently able to destroy:
WebGUI::Shop::ShipDriver
WebGUI::Shop::Transaction
WebGUI::DatabaseLink
+ WebGUI::LDAPLink
Example call:
@@ -865,6 +888,10 @@ Example call:
$session->var->end;
$session->close;
},
+ 'WebGUI::LDAPLink' => sub {
+ my $link = shift;
+ $link->session->db->write("delete from ldapLink where ldapLinkId=?", [$link->{ldapLinkId}]);
+ },
);
sub cleanupGuard {