Fix status reporting for successful connects but bad binds. Fixes bug…

… #11216

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.

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;
 }
 

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] .= '<td valign="top" class="tableData">'.$status.'</td>';

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';
+}

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 {