--- 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<configfile>
+
+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<server>
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'} = <STDIN>);
+ chomp( $conf->{'bindpass'} = <STDIN> );
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 = <STDIN>);
+ chomp( my $secret = <STDIN> );
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 = <STDIN> );
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 = <STDIN> );
+ 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 = <STDIN> );
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 = <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 = <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: [ <option> ...] [<filter> ...] [<attribute> ...]
+ #
if ( scalar @args ) {
# options: support '-l' or '-R' listings
if ( $args[0] =~ /^\-(\w+)/o ) {
@@ -1523,10 +1701,12 @@
my @filters;
# get filter elements from argument list
+ #
while ( @args && $self->is_valid_filter($args[0]) ) {
push( @filters, shift(@args) );
}
+ # No filter for display? Default to all entries.
push( @filters, '(objectClass=*)' ) unless scalar @filters;
# construct OR'ed filter from filter elements
@@ -1601,8 +1781,10 @@
print join( "\t", @elements )."\n";
}
+
+ # show descriptions
+ #
else {
- # show descriptions
my $desc = $e->get_value( 'description' );
if ( $desc ) {
$desc =~ s/\n.*//s; # 1st line only
@@ -1611,6 +1793,7 @@
# no desc? Try and infer something useful
# to display.
+ #
else {
# pull objectClasses, hash for lookup speed
@@ -1637,6 +1820,9 @@
return;
}
+
+### Create a new organizationalUnit entry.
+###
sub run_mkdir
{
my $self = shift;
@@ -1670,6 +1856,9 @@
return;
}
+
+### Alter an entry's DN.
+###
sub run_move
{
my $self = shift;
@@ -1715,6 +1904,10 @@
return;
}
+
+### Change the 'userPassword' attribute of an entry, if
+### supported by the LDAP server.
+###
sub run_passwd
{
my $self = shift;
@@ -1757,10 +1950,8 @@
return;
}
- my $rv = $self->ldap->set_password(
- user => $dn,
- newpasswd => $pw
- );
+ my $setpw = sub { return $self->ldap->set_password( user => $dn, newpasswd => $pw ); };
+ my $rv = $self->with_retry( $setpw );
if ( $rv->code() == LDAP_SUCCESS ) {
print "Password updated successfully.\n";
@@ -1772,6 +1963,9 @@
return;
}
+
+### Display the current working "directory".
+###
sub run_pwd
{
my $self = shift;
@@ -1779,19 +1973,9 @@
return;
}
-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;
-}
-
+### Display the currently bound user.
+###
sub run_whoami
{
my $self = shift;
@@ -1800,18 +1984,17 @@
return;
}
-###############################################################
-#
-# MAIN
-#
-###############################################################
+
+########################################################################
+### M A I N
+########################################################################
package main;
use strict;
use warnings;
$0 = 'shelldap';
-my $VERSION = '0.8';
+my $VERSION = '0.9.0';
use Getopt::Long;
use YAML::Syck;
@@ -1826,6 +2009,7 @@
Getopt::Long::GetOptions(
$conf,
'server|H=s',
+ 'configfile|f=s',
'binddn|D=s',
'basedn|b=s',
'cacheage=i',
@@ -1845,12 +2029,20 @@
# show version
if ( $conf->{'version'} ) {
- print "$VERSION\n";
+ print "$0 $VERSION\n";
exit( 0 );
}
+# additional/different config file?
+#
+if ( $conf->{'configfile'} ) {
+ my $more_conf = load_config( $conf->{'configfile'} );
+ while ( my ($k, $v) = each %{$conf} ) { $conf->{ $k } = $v }
+}
+
+
# defaults
-$conf->{'confpath'} = "$ENV{'HOME'}/.shelldap.rc";
+$conf->{'configfile'} ||= "$ENV{'HOME'}/.shelldap.rc";
$conf->{'cacheage'} ||= 300;
$conf->{'timeout'} ||= 10;
@@ -1858,22 +2050,24 @@
my $shell = LDAP::Shell->new();
$shell->cmdloop();
-# load YAML config into global conf.
-#
+### load YAML config into global conf.
+###
sub load_config
{
+ my $confpath = shift;
my ( $d, $data );
- my $confpath;
- my @confs = (
- "$ENV{'HOME'}/.shelldap.rc",
- '/usr/local/etc/shelldap.conf',
- '/etc/shelldap.conf',
- );
- foreach ( @confs ) {
- if ( -e $_ ) {
- $confpath = $_;
- last;
+ unless ( $confpath ) {
+ my @confs = (
+ "$ENV{'HOME'}/.shelldap.rc",
+ '/usr/local/etc/shelldap.conf',
+ '/etc/shelldap.conf',
+ );
+ foreach ( @confs ) {
+ if ( -e $_ ) {
+ $confpath = $_;
+ last;
+ }
}
}
$confpath or return undef;
@@ -1891,5 +2085,5 @@
return $conf;
}
-## EOF
+### EOF