# HG changeset patch # User Mahlon E. Smith # Date 1363366940 25200 # Node ID 21ba5eb5c2fcb7a053a43b3c26f90524df561998 # Parent 57df728cdb770305bce087d2e65a71e4ec0be6df Numerous changes: - Add a command line option (-f) to specify an alternate configuration file. - Whitespace and comment cleanup. - Allow setting the $editor from the config file. - Break out the fetching of valid must/may attributes for an object class into a separate function - Offer to re-enter the editor if there is an error during create or edit, so changes aren't lost. Thanks to Alexander Perlis for the suggestion. - Wrap the passwd command with connection retry. - Change the version number to reflect semantic versioning (http://semver.org), in preparation of the 1.0.0 release. diff -r 57df728cdb77 -r 21ba5eb5c2fc shelldap --- a/shelldap Fri Mar 15 10:02:19 2013 -0700 +++ b/shelldap Fri Mar 15 10:02:20 2013 -0700 @@ -84,6 +84,18 @@ =over 4 +=item B + +Optional. Use an alternate configuration file, instead of the +default ~/.shelldap.rc. + + --configfile /tmp/alternate-config.yml + -f /tmp/alternate-config.yml + +=back + +=over 4 + =item B Required. The LDAP server to connect to. This can be a hostname, IP @@ -407,20 +419,19 @@ # make 'die' backtrace in debug mode $SIG{'__DIE__'} = \&Carp::confess if $conf->{'debug'}; -############################################################### -# -# UTILITY FUNCTIONS -# -############################################################### -# initial shell behaviors -# +######################################################################## +### U T I L I T Y F U N C T I O N S +######################################################################## + +### Initial shell behaviors. +### sub init { my $self = shift; $self->{'API'}->{'match_uniq'} = 0; - $self->{'editor'} = $ENV{'EDITOR'} || 'vi'; + $self->{'editor'} = $conf->{'editor'} || $ENV{'EDITOR'} || 'vi'; $self->{'env'} = [ qw/ debug cacheage timeout / ]; # let autocomplete work with the '=' character @@ -434,24 +445,28 @@ $term->ReadHistory("$ENV{'HOME'}/.shelldap_history"); }; + # gather metadata from the LDAP server $self->{'root_dse'} = $self->ldap->root_dse(); + $self->{'schema'} = $self->ldap->schema(); + + # get an initial list of all objectClasses + $self->{'objectclasses'} = []; + foreach my $o ( $self->{'schema'}->all_objectclasses() ) { + push @{ $self->{'objectclasses'} }, $o->{'name'}; + } + if ( $conf->{'debug'} ) { - $self->{'schema'} = $self->ldap->schema(); my @versions = $self->{'root_dse'}->get_value('supportedLDAPVersion'); print "Connected to $conf->{'server'}\n"; print "Supported LDAP version: ", ( join ', ', @versions ), "\n"; print "Cipher in use: ", $self->ldap()->cipher(), "\n"; } - # try an initial search and die if it doesn't work - # (bad baseDN) + # try an initial search and bail early if it doesn't work. (bad baseDN?) my $s = $self->search(); die "LDAP baseDN error: ", $s->{'message'}, "\n" if $s->{'code'}; - $self->{'schema'} = $self->ldap->schema(); - - # okay, now do an initial population of 'cwd' - # for autocomplete. + # okay, now do an initial population of 'cwd' for autocomplete. $self->update_entries(); # whew, okay. Update prompt, wait for input! @@ -461,11 +476,12 @@ } -# get an ldap connection handle -# +### Return an LDAP connection handle, creating it if necessary. +### sub ldap { my $self = shift; + my $rv; # use cached connection object if it exists return $self->{'ldap'} if $self->{'ldap'}; @@ -482,15 +498,17 @@ You may try connecting insecurely, or install the module and try again.\n} if $@; } + # Prompt for a password after disabling local echo. + # if ( ($conf->{'binddn'} && ! $conf->{'bindpass'}) || $conf->{'promptpass'} ) { print "Bind password: "; Term::ReadKey::ReadMode 2; - chomp($conf->{'bindpass'} = ); + chomp( $conf->{'bindpass'} = ); Term::ReadKey::ReadMode 0; print "\n"; } - # make connection + # make the connection my $ldap = Net::LDAP->new( $conf->{'server'} ) or die "Unable to connect to LDAP server '$conf->{'server'}': $!\n"; @@ -506,7 +524,7 @@ keydecrypt => sub { print "Key Passphrase: "; Term::ReadKey::ReadMode 2; - chomp(my $secret = ); + chomp( my $secret = ); Term::ReadKey::ReadMode 0; print "\n"; return $secret; @@ -517,24 +535,22 @@ } } - # bind - my $rv; + # bind as an authenicated dn if ( $conf->{'binddn'} ) { - # authed $rv = $ldap->bind( $conf->{'binddn'}, password => $conf->{'bindpass'} ); } + + # bind anonymously else { - # anon $rv = $ldap->bind(); } my $err = $rv->error(); if ( $rv->code() ) { - $err .= " (try the --tls flag?)" - if $err =~ /confidentiality required/i; + $err .= " (try the --tls flag?)" if $err =~ /confidentiality required/i; die "LDAP bind error: $err\n"; } @@ -543,13 +559,13 @@ # authed with the server (non anonymous), and # we haven't cached anything in the past. # - if ( $conf->{'binddn'} && ! -e $conf->{'confpath'} ) { - print "Would you like to cache your connection information? [Y/n]: "; + if ( $conf->{'binddn'} && ! -e $conf->{'configfile'} ) { + print "Would you like to cache your connection information? [Yn]: "; chomp( my $response = ); unless ( $response =~ /^n/i ) { - YAML::Syck::DumpFile( $conf->{'confpath'}, $conf ); - chmod 0600, $conf->{'confpath'}; - print "Connection info cached to $conf->{'confpath'}.\n"; + YAML::Syck::DumpFile( $conf->{'configfile'}, $conf ); + chmod 0600, $conf->{'configfile'}; + print "Connection info cached to $conf->{'configfile'}.\n"; } } @@ -557,8 +573,10 @@ return $ldap; } -# just return an LDIF object -# + +### Return a new LDIF object, suitable for populating with +### a Net::LDAP::Entry. +### sub ldif { my $self = shift; @@ -591,13 +609,14 @@ return $self->{'ldif'}; } -# load and return an Entry object from LDIF -# + +### Return an Entry object from an LDIF filename, or undef if there was an error. +### sub load_ldif { my $self = shift; + my $ldif = Net::LDAP::LDIF->new( shift(), 'r' ); - my $ldif = Net::LDAP::LDIF->new( shift(), 'r' ); return unless $ldif; my $e; @@ -607,28 +626,35 @@ return $e; } -# given a filename, return an md5 checksum -# + +### Given a filename, return an md5 checksum. +### sub chksum { my $self = shift; my $file = shift or return; my $md5 = Digest::MD5->new(); - open F, $file or die "Unable to read temporary ldif: $!\n"; + open F, $file or die "Unable to read file: $!\n"; my $hash = $md5->addfile( *F )->hexdigest(); close F; return $hash; } -# prompt functions -# + +### Used by Term::Shell to generate the prompt. +### sub prompt_str { my $self = shift; return $self->{'prompt'}; } + + +### Display the current working entry as the prompt, +### truncating if necessary. +### sub update_prompt { my $self = shift; @@ -646,8 +672,22 @@ return; } -# search base accessor -# + +### Prompt the user to re-edit their LDIF on error. +### Returns true if the user wants to do so. +### +sub prompt_edit_again +{ + my $self = shift; + print "Edit again? [Yn]: "; + chomp( my $ans = ); + return $ans !~ /^n/i; +} + + +### Return the basedn of the LDAP connection, being either explicitly +### configured or determined automatically from server metadata. +### sub base { my $self = shift; @@ -667,23 +707,24 @@ return $self->{'base'}; } -# do a search on a dn to determine if it is valid. -# returns a bool. -# + +### Returns true if the specified dn is valid on this LDAP server. +### sub is_valid_dn { my $self = shift; my $dn = shift or return 0; my $r = $self->search({ base => $dn }); - return $r->{'code'} == LDAP_SUCCESS ? 1 : 0; } -# perform an ldap search -# return an hashref containing return code and -# arrayref of Net::LDAP::Entry objects -# + +### Perform an LDAP search. +### +### Returns a hashref containing the return code and +### an arrayref of Net::LDAP::Entry objects. +### sub search { my $self = shift; @@ -706,9 +747,9 @@ my $s = $self->with_retry( $search ); my $rv = { - code => $s->code(), - message => $s->error(), - entries => [] + code => $s->code(), + message => $s->error(), + entries => [] }; $rv->{'entries'} = @@ -717,16 +758,17 @@ return $rv; } -# update the autocomplete for entries -# in the current base tree, respecting or creating cache. -# + +### Maintain the cache of possible autocomplete values for +### the current DN. +### sub update_entries { my $self = shift; my %opts = @_; my $base = lc( $self->base() ); - my $s = $opts{'search'} || $self->search({ scope => 'one' }); + my $s = $opts{'search'} || $self->search({ scope => 'one', base => $base }); $self->{'cwd_entries'} = []; return if $s->{'code'}; @@ -759,8 +801,17 @@ return; } -# convert a given path to a DN: deal with '..', '.' -# Synopsis: $dn = $self->path_to_dn( $path ); + +### Roughly convert a given path to a DN. +### +### Additionally support: +### parent '..' +### current '.' +### last '-' +### home '~' +### +### Synopsis: $dn = $self->path_to_dn( $path ); +### sub path_to_dn { my $self = shift; @@ -784,6 +835,7 @@ my @base = @{ ldap_explode_dn($curbase, casefold => 'none') }; # deal with leading .., + # while ( $path =~ /^\.\./ ) { shift( @base ) if @base; $path =~ s/^\.\.//; @@ -809,9 +861,10 @@ return $path; } -# given an array ref of shell-like globs, -# make and return an LDAP filter object. -# + +### Given an array ref of shell-like globs, +### create and return a Net::LDAP::Filter object. +### sub make_filter { my $self = shift; @@ -823,10 +876,10 @@ my $filter; $filter = join('', map { (/^\(.*\)$/o) ? $_ : "($_)" } @$globs); $filter = '(|' . $filter . ')' if (scalar(@$globs) > 1); - $filter = Net::LDAP::Filter->new($filter); + $filter = Net::LDAP::Filter->new( $filter ); if ( $filter ) { - $self->debug('Filter parsed as: ' . $filter->as_string() . "\n"); + $self->debug( 'Filter parsed as: ' . $filter->as_string() . "\n" ); } else { print "Error parsing filter.\n"; @@ -837,9 +890,45 @@ } -# check whether a given string may be a filter -# Synopsis: $yesNo = $self->is_valid_filter($string); -# +### Given an arrayref of objectClasses, pull a complete list of +### required and optional attrbutes. Returns two arrayrefs. +### +sub fetch_attributes +{ + my $self = shift; + my $ocs = shift or return [], []; + + my ( %seen, @must_attr, @may_attr ); + foreach my $oc ( sort @{$ocs} ) { + + # required + my @must = $self->{'schema'}->must( $oc ); + foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @must ) { + next if $attr->{'name'} =~ /^objectclass$/i; + next if $seen{ $attr->{'name'} }; + push @must_attr, $attr->{'name'}; + $seen{ $attr->{'name'} }++; + } + + # optional + my @may = $self->{'schema'}->may( $oc ); + foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) { + next if $attr->{'name'} =~ /^objectclass$/i; + next if $seen{ $attr->{'name'} }; + push @may_attr, $attr->{'name'}; + $seen{ $attr->{'name'} }++; + } + } + + return \@must_attr, \@may_attr; +} + + +### Check whether a given string can be used directly as +### an LDAP search filter. +### +### Synopsis: $yesNo = $self->is_valid_filter($string); +### sub is_valid_filter { my $self = shift; @@ -849,11 +938,11 @@ } -# 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. -# +### 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 transparently re-establish a connection. +### sub with_retry { my $self = shift; @@ -879,8 +968,8 @@ } -# little. yellow. different. better. -# +### little. yellow. different. better. +### sub debug { my $self = shift; @@ -891,9 +980,9 @@ return; } -# setup command autocompletes for -# all commands that have the same possible values -# + +### Autocomplete values: Returns cached children entries. +### sub autocomplete_cwd { my $self = shift; @@ -902,28 +991,28 @@ return sort @{ $self->{'cwd_entries'} }; } + +### Autocomplete values: Returns previously set shelldap environment values. +### sub comp_setenv { my $self = shift; return @{ $self->{'env'} }; } + +### Autocomplete values: Returns all objectClasses as defined +### by the LDAP server. +### sub comp_create { my $self = shift; - return @{ $self->{'objectclasses'} } if $self->{'objectclasses'}; - - my @oc_data = $self->{'schema'}->all_objectclasses(); - my @oc; - foreach my $o ( @oc_data ) { - push @oc, $o->{'name'}; - } - @oc = sort @oc; - $self->{'objectclasses'} = \@oc; - - return @oc; + return @{ $self->{'objectclasses'} }; } + +### Inject various autocomplete and alias routines into the symbol table. +### { no warnings; no strict 'refs'; @@ -967,10 +1056,11 @@ } -# Given an $arrayref, remove LDIF continuation wrapping, -# effectively making each entry a single line. -# -sub unwrap { +### Given an $arrayref, remove LDIF continuation wrapping in place, +### effectively making each entry a single line for LCS comparisons. +### +sub unwrap_line { + my $self = shift; my $array = shift; my $i = 1; @@ -987,18 +1077,18 @@ } -############################################################### -# -# SHELL METHODS -# -############################################################### +######################################################################## +### S H E L L M E T H O D S +######################################################################## -# don't die on a newline -# +### Don't die on a newline, just no-op. +### sub run_ { return; } -# print shell debug actions -# + +### Term::Shell hook. +### Write history for each command, print shell debug actions. +### sub precmd { my $self = shift; @@ -1007,11 +1097,13 @@ my $term = $self->term(); eval { $term->WriteHistory("$ENV{'HOME'}/.shelldap_history"); }; - return unless $conf->{'debug'}; $self->debug( "$$cmd (" . ( join ' ', @$args ) . "), calling '$$handler'\n" ); return; } + +### Display an entry as LDIF to the terminal. +### sub run_cat { my $self = shift; @@ -1027,6 +1119,7 @@ $dn = $self->base() if $dn eq '.'; # support globbing + # my $s; if ( $dn eq '*' ) { $s = $self->search({ @@ -1043,8 +1136,10 @@ attrs => \@attrs }); } + + # absolute/relative dn + # else { - # convert given path to DN $dn = $self->path_to_dn( $dn ); $s = $self->search({ base => $dn, @@ -1053,18 +1148,27 @@ }); } + # emit error, if any + # if ( $s->{'code'} ) { print $s->{'message'} . "\n"; return; } + # display to stdout + # foreach my $e ( @{ $s->{'entries'} } ) { $self->ldif->write_entry( $e ); print "\n"; } + return; } + +### Change shelldap's idea of a current working 'directory', +### by adjusting the current default basedn for all searches. +### sub run_cd { my $self = shift; @@ -1097,56 +1201,66 @@ return; } + +### Simply clear the screen. +### sub run_clear { my $self = shift; - system('clear'); + system( 'clear' ); return; } + +### Fetch the source DN entry, modify it's DN data +### and write it back to the directory. +### sub run_copy { my $self = shift; my ( $s_dn, $d_dn ) = @_; unless ( $s_dn ) { - print "No source dn provided.\n"; + print "No source DN provided.\n"; return; } unless ( $d_dn ) { - print "No destination dn provided.\n"; + print "No destination DN provided.\n"; return; } # convert given source path to DN $s_dn = $self->path_to_dn( $s_dn ); + # sanity check source + # my $s = $self->search({ base => $s_dn, vals => 1 }); unless ( $s->{'code'} == LDAP_SUCCESS ) { print "No such object\n"; return; } - # see if we're copying the entry to a totally new path + # see if we're copying the entry to a nonexistent path + # my ( $new_dn, $old_dn ); ( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\w=]+),(.*)$/; - if ( $new_dn ) { + if ( $new_dn ) { # absolute unless ( $self->is_valid_dn( $new_dn ) ) { print "Invalid destination.\n"; return; } } - else { + else { # relative $new_dn = $self->base(); } $old_dn = $1 if $s_dn =~ /^[\w=]+,(.*)$/; - # get the source object + # get the source entry object my $e = ${ $s->{'entries'} }[0]; $e->dn( $s_dn ); # add changes in new entry instead of modifying existing - $e->changetype('add'); + $e->changetype( 'add' ); $e->dn( "$d_dn,$new_dn" ); # get the unique attribute from the dn for modification @@ -1155,94 +1269,104 @@ my ( $uniqkey, $uniqval ) = ( $1, $2 ) if $d_dn =~ /^([\.\w\-]+)(?:\s+)?=(?:\s+)?([\.\-\s\w]+),?/; unless ( $uniqkey && $uniqval ) { - print "Unable to parse unique values from rdn.\n"; + print "Unable to parse unique values from RDN.\n"; return; } $e->replace( $uniqkey => $uniqval ); - # update - my $rv = $e->update( $self->ldap() ); - print $rv->error , "\n"; + # update (which will actually create the new entry) + # + my $update = sub { return $e->update($self->ldap()) }; + my $rv = $self->with_retry( $update ); + print $rv->error(), "\n"; # clear caches + # $self->{'cache'}->{ $new_dn } = {} if $new_dn; $self->{'cache'}->{ $old_dn } = {} if $old_dn; $self->update_entries( clearcache => 1 ); return; } + +### Create a new entry from scratch, using attributes from +### what the server's schema says is available from the specified +### (optional) objectClass list. Populate a new LDIF file and +### present an editor to the user. +### sub run_create { my $self = shift; my @ocs = @_; - my ( $fh, $fname ) = - File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 ); - - # first print out the dn and object classes. - print $fh 'dn: ???,', $self->base(), "\n"; - foreach my $oc ( sort @ocs ) { - print $fh "objectClass: $oc\n"; - } - - # now gather attributes for requested objectClasses + # manually generate some boilerplate LDIF. # - my ( %seen, @must_attr, @may_attr ); - foreach my $oc ( sort @ocs ) { + unless ( $self->{'create_file'} ) { + my $fh; + + ( $fh, $self->{'create_file'} ) = + File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 ); - # required - my @must = $self->{'schema'}->must( $oc ); - foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @must ) { - next if $attr->{'name'} =~ /^objectclass$/i; - next if $seen{ $attr->{'name'} }; - push @must_attr, $attr->{'name'}; - $seen{ $attr->{'name'} }++; + # first print out the dn and object classes. + # + print $fh 'dn: ???,', $self->base(), "\n"; + foreach my $oc ( sort @ocs ) { + print $fh "objectClass: $oc\n"; } - # optional - my @may = $self->{'schema'}->may( $oc ); - foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) { - next if $attr->{'name'} =~ /^objectclass$/i; - next if $seen{ $attr->{'name'} }; - push @may_attr, $attr->{'name'}; - $seen{ $attr->{'name'} }++; - } + # gather and print attributes for requested objectClasses + # + my ( $must_attr, $may_attr ) = $self->fetch_attributes( \@ocs ); + print $fh "$_: \n" foreach @{ $must_attr }; + print $fh "# $_: \n" foreach @{ $may_attr }; + close $fh; } - # print attributes - print $fh "$_: \n" foreach @must_attr; - print $fh "# $_: \n" foreach @may_attr; - close $fh; - my $hash_a = $self->chksum( $fname ); - system( $self->{'editor'}, $fname ) && die "Unable to launch editor: $!\n"; + # checksum the file. + # + my $hash_orig = $self->chksum( $self->{'create_file'} ); + system( $self->{'editor'}, $self->{'create_file'} ) && die "Unable to launch editor: $!\n"; - # hash compare - my $hash_b = $self->chksum( $fname ); - if ( $hash_a eq $hash_b ) { + # detect a total lack of change + # + if ( $hash_orig eq $self->chksum($self->{'create_file'}) ) { print "Entry not modified.\n"; - unlink $fname; + unlink $self->{'create_file'}; + $self->{'create_file'} = undef; return; } # load in LDIF - my $ldif = Net::LDAP::LDIF->new( $fname, 'r', onerror => 'warn' ); - my $e = $ldif->read_entry(); + # + my $ldif = Net::LDAP::LDIF->new( $self->{'create_file'}, 'r', onerror => 'warn' ); + my $e = $ldif->read_entry(); unless ( $e ) { print "Unable to parse LDIF.\n"; - unlink $fname; + unlink $self->{'create_file'}; + $self->{'create_file'} = undef; return; } + + # create the new entry. + # $e->changetype('add'); 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(); + if ( $rv->code() != LDAP_SUCCESS && $self->prompt_edit_again() ) { + return $self->run_create(); + } - unlink $fname; + $self->update_entries( clearcache => 1 ); + unlink $self->{'create_file'}; + $self->{'create_file'} = undef; return; } + +### Remove an entry (or entries) from the LDAP directory. +### sub run_delete { my $self = shift; @@ -1259,12 +1383,12 @@ } my $s = $self->search({ scope => 'one', filter => $filter }); - if ( $s->{'code'} ) { + unless ( $s->{'code'} == LDAP_SUCCESS ) { print "$s->{'message'}\n"; return; } - print "Are you sure? [N/y]: "; + print "Are you sure? [Ny]: "; chomp( my $resp = ); return unless $resp =~ /^y/i; @@ -1278,6 +1402,11 @@ return; } + +### Fetch an entry from the directory, write it out to disk +### as LDIF, launch an editor, then compare changes and write +### it back to the directory. +### sub run_edit { my $self = shift; @@ -1291,66 +1420,80 @@ # convert given path to DN $dn = $self->path_to_dn( $dn ); + # sanity check + # my $s = $self->search({ base => $dn, vals => 1 }); - - if ( $s->{'code'} ) { + unless ( $s->{'code'} == LDAP_SUCCESS ) { print $s->{'message'} . "\n"; return; } - # fetch entry and write it out to disk + # fetch entry. my $e = ${ $s->{'entries'} }[0]; - my $ldif = $self->ldif(1); - $ldif->write_entry( $e ); - $ldif->done(); # force sync + $e->changetype( 'modify' ); + + # write it out to disk. + # + unless( $self->{'edit_again'} ) { + my $ldif = $self->ldif(1); + $ldif->write_entry( $e ); + $ldif->done(); # force sync + } # load it into an array for potential comparison open LDIF, "$self->{'ldif_fname'}" or return; my @orig_ldif = ; close LDIF; - # append optional, unused attributes as comments - # for fast reference. + # 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"; + unless ( $self->{'edit_again'} ) { + my %current_attrs = map { $_ => 1 } $e->attributes(); + my ( $must_attr, $may_attr ) = $self->fetch_attributes( $e->get_value('objectClass', asref => 1) ); + + open LDIF, ">> $self->{'ldif_fname'}"; + foreach my $opt_attr ( sort { $a cmp $b } @{$may_attr} ) { + next if $current_attrs{ $opt_attr }; + print LDIF "# " . $opt_attr . ":\n"; } + close LDIF; } - close LDIF; # checksum it, then open it in an editor - my $hash_a = $self->chksum( $self->{'ldif_fname'} ); - system( "$self->{'editor'} $self->{'ldif_fname'}" ) && + # + my $hash_orig = $self->chksum( $self->{'ldif_fname'} ); + system( $self->{'editor'}, $self->{'ldif_fname'} ) && die "Unable to launch editor: $!\n"; # detect a total lack of change - my $hash_b = $self->chksum( $self->{'ldif_fname'} ); - if ( $hash_a eq $hash_b ) { + # + if ( $hash_orig eq $self->chksum($self->{'ldif_fname'}) ) { print "Entry not modified.\n"; unlink $self->{'ldif_fname'}; return; } # check changes for basic LDIF validity - my $new_e = $self->load_ldif( $self->{'ldif_fname'} ); - unless ( $new_e ) { + # + while( ! $self->load_ldif($self->{'ldif_fname'}) ) { print "Unable to parse LDIF.\n"; - unlink $self->{'ldif_fname'}; - return; + if ( $self->prompt_edit_again() ) { + system( $self->{'editor'}, $self->{'ldif_fname'} ); + } + else { + unlink $self->{'ldif_fname'}; + return; + } } # load changes into a new array for comparison + # open LDIF, "$self->{'ldif_fname'}" or return; my @new_ldif = ; close LDIF; - $e->changetype('modify'); - + # parser subref + # my $parse = sub { my $line = shift || $_; return if $line =~ /^\#/; # ignore comments @@ -1360,8 +1503,8 @@ return ( $attr, $val ); }; - unwrap( \@orig_ldif ); - unwrap( \@new_ldif ); + $self->unwrap_line( \@orig_ldif ); + $self->unwrap_line( \@new_ldif ); my $diff = Algorithm::Diff->new( \@orig_ldif, \@new_ldif ); HUNK: @@ -1370,7 +1513,8 @@ my $diff_bit = $diff->Diff(); my %seen_attr; - # total deletions + # attr removals + # if ( $diff_bit == 1 ) { foreach ( $diff->Items(1) ) { my ( $attr, $val ) = $parse->( $_ ) or next; @@ -1379,7 +1523,8 @@ } } - # new insertions + # attr insertions + # if ( $diff_bit == 2 ) { foreach ( $diff->Items(2) ) { my ( $attr, $val ) = $parse->( $_ ) or next; @@ -1388,7 +1533,8 @@ } } - # replacements + # attr change + # if ( $diff_bit == 3 ) { foreach ( $diff->Items(2) ) { my ( $attr, $val ) = $parse->( $_ ) or next; @@ -1405,8 +1551,9 @@ } else { - # make sure the replace doesn't squash - # other attributes listed with the same name + # retain attributes that allow multiples, so updating + # one attribute doesn't inadvertently remove others with + # the same name. # next if $seen_attr{ $attr }; my @new_vals; @@ -1416,21 +1563,30 @@ $seen_attr{ $attr }++; push @new_vals, $new_val; } + $e->replace( $attr => \@new_vals ); } } } - } - unlink $self->{'ldif_fname'}; my $update = sub { return $e->update( $self->ldap ); }; my $rv = $self->with_retry( $update ); print $rv->error(), "\n"; + if ( $rv->code() != LDAP_SUCCESS && $self->prompt_edit_again() ) { + $self->{'edit_again'} = 1; + return $self->run_edit( $dn ); + } + + unlink $self->{'ldif_fname'}; + $self->{'edit_again'} = undef; return; } + +### Display current tunable runtime settings. +### sub run_env { my $self = shift; @@ -1442,6 +1598,25 @@ } } + +### Alter settings. +### +sub run_setenv +{ + my $self = shift; + my ( $key, $val ) = @_; + + ( $key, $val ) = split /=/, $key if $key && ! defined $val; + return unless $key && defined $val; + $key = lc $key; + + $conf->{$key} = $val; + return; +} + + +### Search across the directory and display matching entries. +### sub run_grep { my $self = shift; @@ -1472,13 +1647,11 @@ $self->debug("Filter parsed as: " . $filter->as_string() . "\n"); - my $s = $self->search( - { - scope => $recurse ? 'sub' : 'one', - base => $base, - filter => $filter - } - ); + my $s = $self->search({ + scope => $recurse ? 'sub' : 'one', + base => $base, + filter => $filter + }); foreach my $e ( @{ $s->{'entries'} } ) { my $dn = $e->dn(); @@ -1488,9 +1661,9 @@ return; } -# override internal help functions -# with pod2usage -# + +### Override internal help function with pod2usage output. +### sub run_help { return Pod::Usage::pod2usage( @@ -1500,6 +1673,10 @@ ); } + +### Generate and display a list of LDAP entries, relative to the current +### location the command was run from. +### sub run_list { my $self = shift; @@ -1511,6 +1688,7 @@ my ( $recurse, $long ); # parse arguments: [