More robust path for connection retries. Show optional, unused
authorMahlon E. Smith <mahlon@laika.com>
Fri, 15 Mar 2013 10:02:18 -0700
changeset 48 fe27dfe5179e
parent 47 bf9d6fa1b1d4
child 49 57df728cdb77
More robust path for connection retries. Show optional, unused attributes as comments in the editor.
shelldap
--- a/shelldap	Sun Jan 13 20:29:12 2013 -0800
+++ b/shelldap	Fri Mar 15 10:02:18 2013 -0700
@@ -382,7 +382,17 @@
 use Term::ReadKey;
 use Term::Shell;
 use Digest::MD5;
-use Net::LDAP qw/ LDAP_SUCCESS LDAP_SERVER_DOWN /;
+use Net::LDAP qw/
+	LDAP_SUCCESS
+	LDAP_SERVER_DOWN
+	LDAP_OPERATIONS_ERROR
+	LDAP_TIMELIMIT_EXCEEDED
+	LDAP_BUSY
+	LDAP_UNAVAILABLE
+	LDAP_OTHER
+	LDAP_TIMEOUT
+	LDAP_NO_MEMORY
+	LDAP_CONNECT_ERROR /;
 use Net::LDAP::Util qw/ canonical_dn ldap_explode_dn /;
 use Net::LDAP::LDIF;
 use Data::Dumper;
@@ -672,24 +682,8 @@
 	$opts->{'filter'} ||= '(objectClass=*)';
 	$opts->{'scope'}  ||= 'base';
 
-	my $s = $self->ldap->search(
-		base	  => $opts->{'base'},
-		filter	  => $opts->{'filter'},
-		scope	  => $opts->{'scope'},
-		timelimit => $conf->{'timeout'},
-		typesonly => ! $opts->{'vals'},
-		attrs	  => $opts->{'attrs'} || ['*']
-	);
-
-	# since search is used just about everywhere, this seems like
-	# a pretty good place to check for connection errors and try
-	# to re-establish a connection.
-	#
-	if ( $s->code() != 0 ) {
-		$self->debug( "Error ". $s->code() . ", retrying.\n" );
-		$self->{'ldap'} = undef;
-
-		$s = $self->ldap->search(
+	my $search = sub { 
+		return $self->ldap->search(
 			base	  => $opts->{'base'},
 			filter	  => $opts->{'filter'},
 			scope	  => $opts->{'scope'},
@@ -697,8 +691,9 @@
 			typesonly => ! $opts->{'vals'},
 			attrs	  => $opts->{'attrs'} || ['*']
 		);
-	}
+	};
 
+	my $s = $self->with_retry( $search );
 	my $rv = {
 		code	  => $s->code(),
 		message   => $s->error(),
@@ -843,6 +838,36 @@
 }
 
 
+# Call code in subref $action, if there's any connection related errors,
+# try it one additional time before giving up.  This should take care of
+# most server disconnects due to timeout and other generic connection
+# errors, and will attempt to re-establish a connection.
+#
+sub with_retry
+{
+	my $self = shift;
+	my $action = shift;
+
+	my $rv = $action->();
+	if ( $rv->code() == LDAP_OPERATIONS_ERROR   ||
+		 $rv->code() == LDAP_TIMELIMIT_EXCEEDED ||
+		 $rv->code() == LDAP_BUSY               ||
+		 $rv->code() == LDAP_UNAVAILABLE        ||
+		 $rv->code() == LDAP_OTHER              ||
+		 $rv->code() == LDAP_SERVER_DOWN        ||
+		 $rv->code() == LDAP_TIMEOUT            ||
+		 $rv->code() == LDAP_NO_MEMORY          ||
+		 $rv->code() == LDAP_CONNECT_ERROR ) {
+
+		$self->debug( "Error ". $rv->code() . ", retrying.\n" );
+		$self->{'ldap'} = undef;
+		$rv = $action->();
+	}
+
+	return $rv;
+}
+
+
 # little. yellow. different. better.
 #
 sub debug 
@@ -1197,7 +1222,8 @@
 		return;
 	}
 	$e->changetype('add');
-	my $rv = $e->update( $self->ldap() );
+	my $create = sub { return $e->update($self->ldap()) };
+	my $rv = $self->with_retry( $create );
 	print $rv->error(), "\n";
 
 	$self->update_entries( clearcache => 1 ) unless $rv->code();
@@ -1272,6 +1298,20 @@
 	my @orig_ldif = <LDIF>;
 	close LDIF;
 
+	# append optional, unused attributes as comments
+	# for fast reference.
+	#
+	open LDIF, ">> $self->{'ldif_fname'}";
+	my %current_attrs = map { $_ => 1 } $e->attributes();
+	foreach my $oc ( $e->get_value('objectClass') ) {
+		my @may = $self->{'schema'}->may( $oc );
+		foreach my $opt_attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) {
+			next if $current_attrs{ $opt_attr->{'name'} };
+			print LDIF "# " . $opt_attr->{'name'} . ":\n";
+		}
+	}
+	close LDIF;
+
 	# checksum it, then open it in an editor
 	my $hash_a = $self->chksum( $self->{'ldif_fname'} );
 	system( "$self->{'editor'} $self->{'ldif_fname'}" ) &&
@@ -1322,8 +1362,8 @@
 		# total deletions
 		if ( $diff_bit == 1 ) {
 			foreach ( $diff->Items(1) ) {
+				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$self->debug("DELETE: $_");
-				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$e->delete( $attr => [ $val ] );
 			}
 		}
@@ -1331,8 +1371,8 @@
 		# new insertions
 		if ( $diff_bit == 2 ) {
 			foreach ( $diff->Items(2) ) {
+				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$self->debug("INSERT: $_");
-				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$e->add( $attr => $val );
 			}
 		}
@@ -1340,8 +1380,8 @@
 		# replacements
 		if ( $diff_bit == 3 ) {
 			foreach ( $diff->Items(2) ) {
+				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$self->debug("MODIFY: $_");
-				my ( $attr, $val ) = $parse->( $_ ) or next;
 
 				my $cur_vals = $e->get_value( $attr, asref => 1 ) || [];
 				my $cur_valcount = scalar @$cur_vals;
@@ -1373,7 +1413,8 @@
 	}
 
 	unlink $self->{'ldif_fname'};
-	my $rv = $e->update( $self->ldap );
+	my $update = sub { return $e->update( $self->ldap ); };
+	my $rv = $self->with_retry( $update );
 	print $rv->error(), "\n";
 
 	return;
@@ -1562,7 +1603,7 @@
 			else {
 
 				# pull objectClasses, hash for lookup speed
-				my @oc   = $e->get_value( 'objectClass' );
+				my @oc = $e->get_value( 'objectClass' );
 				my %ochash;
 				map { $ochash{$_} = 1 } @oc;
 
@@ -1605,11 +1646,15 @@
 	my %rdn = %{ shift(@{ ldap_explode_dn($dir, casefold => 'lower') }) };
 
 	# add
-	my $r = $self->ldap()->add( $dir, attr => [
-		objectClass => [ 'top', 'organizationalUnit' ], %rdn
-	]);
+	my $mkdir = sub {
+		return $self->ldap()->add( $dir, attr => [
+			objectClass => [ 'top', 'organizationalUnit' ], %rdn
+		]);
+	};
 
-	print $r->error(), "\n";
+	my $rv = $self->with_retry( $mkdir );
+
+	print $rv->error(), "\n";
 	$self->update_entries( clearcache => 1 );
 	return;
 }
@@ -1641,12 +1686,15 @@
 	( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\w=]+),(.*)$/;
 	$old_dn = $1 if $s_dn =~ /^[\w=]+,(.*)$/;
 
-	my $rv = $self->ldap()->moddn(
-		$s_dn,
-		newrdn	     => $d_dn,
-		deleteoldrdn => 1,
-		newsuperior  => $new_dn
-	);
+	my $moddn = sub {
+		return $self->ldap()->moddn(
+			$s_dn,
+			newrdn	     => $d_dn,
+			deleteoldrdn => 1,
+			newsuperior  => $new_dn
+		);
+	};
+	my $rv = $self->with_retry( $moddn );
 	print $rv->error(), "\n";
 
 	# clear caches
@@ -1705,7 +1753,8 @@
 
 	if ( $rv->code() == LDAP_SUCCESS ) {
 		print "Password updated successfully.\n";
-	} else {
+	}
+	else {
 		print "Password error: " . $rv->error() . "\n";
 	}
 
@@ -1751,7 +1800,7 @@
 use warnings;
 
 $0 = 'shelldap';
-my $VERSION = '0.7';
+my $VERSION = '0.8';
 
 use Getopt::Long;
 use YAML::Syck;