# HG changeset patch # User Mahlon E. Smith # Date 1363366938 25200 # Node ID fe27dfe5179e665a5c511950eae816e3b5c7eed5 # Parent bf9d6fa1b1d49c74be61846f7e6992f9f27158d1 More robust path for connection retries. Show optional, unused attributes as comments in the editor. diff -r bf9d6fa1b1d4 -r fe27dfe5179e 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 = ; 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;