Menu
▾
▴
[perl-ldap-checkins] CVS: ldap/contrib tklkup,1.30,1.31
|
From: Clif H. <ch...@us...> - 2002-12-30 05:30:49
|
Update of /cvsroot/perl-ldap/ldap/contrib
In directory sc8-pr-cvs1:/tmp/cvs-serv897/ldap/contrib
Modified Files:
tklkup
Log Message:
Modified the error checking on ldap modify commands.
Corrected all the ldap bind commands.
Added CheckError subrountine.
Added a few comments at the end of subrountines.
Index: tklkup
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- tklkup 6 Nov 2002 04:27:37 -0000 1.30
+++ tklkup 30 Dec 2002 05:30:45 -0000 1.31
@@ -22,6 +22,13 @@
#
# Revisions:
# $Log$
+# Revision 1.31 2002/12/30 05:30:45 charden
+#
+# Modified the error checking on ldap modify commands.
+# Corrected all the ldap bind commands.
+# Added CheckError subrountine.
+# Added a few comments at the end of subrountines.
+#
# Revision 1.30 2002/11/06 04:27:37 charden
#
# Corrected a few pod errors that podchecker found.
@@ -1703,21 +1710,16 @@
$mesg = $ldap->bind( password => "$Global{'bindpw'}",
dn => "$Global{'binddn'}",
version => $Global{'setVersion'},
- ) or $error = 1;
+ );
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
-}
-
-if ( $error == 1 )
-{
- $schema_list->insert("end", "Bind error: $@\n");
return;
}
-
+
#
# Get the schema, tries to read rootdse, if unable assumes cn=schema.
# This is NOT always the case.
@@ -2991,6 +2993,7 @@
my $ldap;
my $mesg;
my @DNs;
+my $do_it;
if ( !$Global{'ldapActionDN'} )
{
@@ -3019,45 +3022,58 @@
if ( $error == 1 )
{
- $list->insert("end", "Connect error: $@\n");
- return;
$errstr = "Delete connect error on ldap server $Global{'LDAP_SERVER'}\n";
ERROR($errstr);
+ return;
}
$mesg = $ldap->bind( password => $Global{'bindpw'},
dn => $Global{'binddn'},
version => $Global{'setVersion'},
- ) or $error = 1;
-
+ );
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
-}
-
-if ( $error == 1 )
-{
- $errstr = "Delete Bind error on ldap server $Global{'LDAP_SERVER'}\n";
- ERROR($errstr);
+ return;
}
-$mesg = $ldap->delete($DNs[1]) or $error = 1;
+$do_it = 1;
+$Global{loopCount} = 0;
-if ( $error == 1 )
-{
- $errstr = "Delete error: $object\nOn ldap server $Global{'LDAP_SERVER'}\n";
- ERROR($errstr);
- return;
-}
+while ($do_it == 1 )
+{
+ $mesg = $ldap->delete($DNs[1]);
-if ( $mesg->code )
-{
+ if ( $mesg->code )
+ {
+ #
+ # There was an error, check for dsa busy
+ # error.
+ #
+ #
$errstr = $mesg->code;
- ERROR($errstr);
-}
+ $errstr = ldap_error_text($errstr);
+ #
+ # Check for server busy.
+ #
+ if ( !(CheckError($errstr) ) )
+ {
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+ }
+ }
+ else
+ {
+ #
+ # There was no error
+ #
+ $do_it = 0;
+ }
+}
$ldap->unbind;
} # End of ldapActionDelete subroutine
@@ -3072,6 +3088,7 @@
my $ldap;
my $mesg;
$error = 0;
+my $do_it;
if ( $Global{'Rename'} == -1 )
{
@@ -3094,39 +3111,58 @@
$mesg = $ldap->bind( password => $Global{'bindpw'},
dn => $Global{'binddn'},
version => $Global{'setVersion'},
- ) or $error = 1;
+ );
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
}
-if ( $error == 1 )
+
+$do_it = 1;
+$Global{loopCount} = 0;
+
+while ($do_it == 1 )
{
- $errstr = "Rename Bind error on ldap server $Global{'LDAP_SERVER'}\n";
- ERROR($errstr);
-}
$mesg = $ldap->moddn($Global{'RenameDN'},
newrdn => $Global{'newrdn'},
deleteoldrdn => $Global{'deleteoldrdn'},
- newsuperior => $Global{'newsuperior'} ) or $error = 1;
+ newsuperior => $Global{'newsuperior'} );
-if ( $error == 1 )
-{
- $errstr = "Rename error: $Global{'RenameDN'}\nOn ldap server $Global{'LDAP_SERVER'}\n";
- ERROR($errstr);
- return;
-}
-
if ( $mesg->code )
{
+ #
+ # There was an error, check for dsa busy
+ # error.
+ #
+ #
$errstr = $mesg->code;
- ERROR($errstr);
+ $errstr = ldap_error_text($errstr);
+ #
+ # Check for server busy.
+ #
+ if ( !(CheckError($errstr) ) )
+ {
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+ }
+ }
+ else
+ {
+ #
+ # There was no error
+ #
+ $do_it = 0;
+ }
+
}
+$ldap->unbind;
+
}
#
@@ -3498,6 +3534,7 @@
my $errstr;
my $mesg;
my $error = 0; # initialize error flag.
+my $do_it;
my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
timeout => 1,
@@ -3514,18 +3551,12 @@
$mesg = $ldap->bind( password => $Global{'bindpw'},
dn => $Global{'binddn'},
version => $Global{'setVersion'},
- ) or $error = 1;
+ );
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
-}
-
-if ( $error == 1 )
-{
- $errstr = "Bind error: $@\n";
- ERROR($errstr);
return;
}
@@ -3535,22 +3566,41 @@
if ( defined($Global{'add'}) )
{
-$mesg = $ldap->modify( $Global{'entryDN'}, add => $Global{'add'})
- or $error = 1;
-
+$do_it = 1;
+$Global{loopCount} = 0;
-if ( $error == 1 )
+while ($do_it == 1 )
{
- $errstr = "Add modify error: $@\n";
- ERROR($errstr);
- return;
-}
+
+$mesg = $ldap->modify( $Global{'entryDN'}, add => $Global{'add'});
if ( $mesg->code )
{
+ #
+ # There was an error, check for dsa busy
+ # error.
+ #
+ #
$errstr = $mesg->code;
- ERROR($errstr);
- return;
+ $errstr = ldap_error_text($errstr);
+ #
+ # Check for server busy.
+ #
+ if ( !(CheckError($errstr) ) )
+ {
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+ }
+ }
+ else
+ {
+ #
+ # There was no error
+ #
+ $do_it = 0;
+ }
+
}
delete( $Global{'add'} );
@@ -3562,23 +3612,44 @@
#
if ( defined($Global{'delete'}) )
{
-$mesg = $ldap->modify( $Global{'entryDN'}, delete => $Global{'delete'})
- or $error = 1;
-
+
+$do_it = 1;
+$Global{loopCount} = 0;
-if ( $error == 1 )
+while ($do_it == 1 )
{
- $errstr = "Delete modify error: $@\n";
- ERROR($errstr);
- return;
-}
+
+$mesg = $ldap->modify( $Global{'entryDN'}, delete => $Global{'delete'});
if ( $mesg->code )
{
+ #
+ # There was an error, check for dsa busy
+ # error.
+ #
+ #
$errstr = $mesg->code;
- ERROR($errstr);
- return;
+ $errstr = ldap_error_text($errstr);
+ #
+ # Check for server busy.
+ #
+ if ( !(CheckError($errstr) ) )
+ {
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+ }
+ }
+ else
+ {
+ #
+ # There was no error
+ #
+ $do_it = 0;
+ }
+
}
+
delete( $Global{'delete'} );
}
@@ -3589,23 +3660,44 @@
#
if ( defined($Global{'replace'}) )
{
-$mesg = $ldap->modify( $Global{'entryDN'}, replace => $Global{'replace'})
- or $error = 1;
-
+
+$do_it = 1;
+$Global{loopCount} = 0;
-if ( $error == 1 )
+while ($do_it == 1 )
{
- $errstr = "Replace modify error: $@\n";
- ERROR($errstr);
- return;
-}
+
+$mesg = $ldap->modify( $Global{'entryDN'}, replace => $Global{'replace'});
if ( $mesg->code )
{
+ #
+ # There was an error, check for dsa busy
+ # error.
+ #
+ #
$errstr = $mesg->code;
- ERROR($errstr);
- return;
+ $errstr = ldap_error_text($errstr);
+
+ #
+ # Check for server busy.
+ #
+ if ( !(CheckError($errstr) ) )
+ {
+ $errstr = $mesg->code;
+ ERROR($errstr);
+ return;
+ }
+ }
+ else
+ {
+ #
+ # There was no error
+ #
+ $do_it = 0;
+ }
}
+
delete( $Global{'replace'} );
}
@@ -3721,7 +3813,7 @@
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
} # End of cancel subroutine
-} # End of cancel subroutine
+} # End of subroutine displayDnList
#
# Search the directory for data
@@ -3834,21 +3926,16 @@
$mesg = $ldap->bind( password => $Global{'bindpw'},
dn => $Global{'binddn'},
version => $Global{'setVersion'},
- ) or $error = 1;
+ );
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
-}
-
-if ( $error == 1 )
-{
- $list->insert("end", "Bind error: $@\n");
return;
}
-
+
$Global{'searchResults'} = {}; # initialize results hash.
$mesg = $ldap->search(
@@ -4075,7 +4162,7 @@
# Check for an error on bind
#
-if ( $mesg->code )
+if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
@@ -4268,7 +4355,7 @@
$ldap->unbind;
-}
+} # End of subrountine rootDse
#
# Determine new mainWindow position.
@@ -4281,12 +4368,50 @@
$Global{'horz'} = $pos[1];
$Global{'vert'} = $pos[2];
-}
+} # End of subrountine globalPos
sub root_cancel
{
$Global{'rootWindow'}->destroy if Tk::Exists($Global{'rootWindow'});
+} # End of subrountine root_cancel
+
+#
+# LDAP Error check, some return codes are not really errors.
+# You can retry the ldap action after waiting a while.
+#
+
+sub CheckError {
+
+my ( $error ) = @_;
+
+#
+# Check for DSA busy or internal error
+#
+
+if ( $Global{loopCount} > 61 ) {
+ return 0; # return an error condition.
}
+
+++$Global{loopCount}; # Increment the loop counter.
+
+if ( $error =~ /too busy/ ||
+ $error =~ /Server encountered an internal error/ )
+ {
+ #
+ # DSA Busy.
+ #
+ sleep 1;
+ return 1; # No error, try again
+ }
+else {
+ #
+ # DSA did not return "DSA busy" message
+ #
+ return 0; # error
+
+ }
+
+} # End of subrountine CheckError
#----------------------------------------#
# Usage() - display simple usage message #
@@ -4419,6 +4544,8 @@
same search base, there should be little or no delay
when switching to the new server.
+=back
+
Now a word about directory branch, or search base, detection.
There are many things that can prevent this function from working
properly. Several version 2 LDAP servers that this was tested
@@ -4439,8 +4566,6 @@
If you decide to use auto search base detection you will just have
to try it and hope it works.
-
-=back
-------------------------------------------------------------------
|
