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

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 {