shelldap: comparison shelldap

equal deleted inserted replaced

-:57df728cdb77
+:21ba5eb5c2fc
 tls_cert:   ~/.ssl/client.cert.pem
 tls_key:    ~/.ssl/private/client.key.pem
 =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
 address, or a URI.
 my $conf = $main::conf;
 # make 'die' backtrace in debug mode
 $SIG{'__DIE__'} = \&Carp::confess if $conf->{'debug'};
-###############################################################
-#
+########################################################################
-# UTILITY FUNCTIONS
+### U T I L I T Y   F U N C T I O N S
-#
+########################################################################
-###############################################################
+### Initial shell behaviors.
-# 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
 	my $term = $self->term();
 	$term->Attribs->{'basic_word_break_characters'}	 =~ s/=//m;
 	eval {
 		$term->history_truncate_file("$ENV{'HOME'}/.shelldap_history", 50);
 		$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
+	# try an initial search and bail early if it doesn't work. (bad baseDN?)
-	# (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!
 	$self->update_prompt();
 	return;
 }
-# 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'};
 	# fill in potentially missing info
 		eval 'use IO::Socket::SSL';
 		die qq{IO::Socket::SSL not installed, but is required for SSL or TLS connections.
 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";
 	# secure connection options
 	#
 				clientcert => $conf->{'tls_cert'},
 				clientkey  => $conf->{'tls_key'},
 				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;
 				});
 		}
 		else {
 			$ldap->start_tls( verify => 'none' );
 		}
 	}
-	# bind
+	# bind as an authenicated dn
-	my $rv;
 	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?)"
+		$err .= " (try the --tls flag?)" if $err =~ /confidentiality required/i;
-			if $err =~ /confidentiality required/i;
 		die "LDAP bind error: $err\n";
 	}
 	# offer to cache authentication info
 	# if we enter this conditional, we have successfully
 	# authed with the server (non anonymous), and
 	# we haven't cached anything in the past.
 	#
-	if ( $conf->{'binddn'} && ! -e $conf->{'confpath'} ) {
+	if ( $conf->{'binddn'} && ! -e $conf->{'configfile'} ) {
-		print "Would you like to cache your connection information? [Y/n]: ";
+		print "Would you like to cache your connection information? [Yn]: ";
 		chomp( my $response = <STDIN> );
 		unless ( $response =~ /^n/i ) {
-			YAML::Syck::DumpFile( $conf->{'confpath'}, $conf );
+			YAML::Syck::DumpFile( $conf->{'configfile'}, $conf );
-			chmod 0600, $conf->{'confpath'};
+			chmod 0600, $conf->{'configfile'};
-			print "Connection info cached to $conf->{'confpath'}.\n";
+			print "Connection info cached to $conf->{'configfile'}.\n";
 		}
 	}
 	$self->{'ldap'} = $ldap;
 	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;
 	my $use_temp = shift;
 	}
 	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;
 	eval { $e = $ldif->read_entry(); };
 	return if $@;
 	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;
 	my $base = $self->base();
 		$self->{'prompt'} = "$prompt > ";
 	}
 	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;
 	$self->{'base'} ||= $conf->{'basedn'};
 		$self->{'base'} = $base if $base;
 	}
 	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
+### Perform an LDAP search.
-# arrayref of Net::LDAP::Entry objects
+###
-#
+### Returns a hashref containing the return code and
+### an arrayref of Net::LDAP::Entry objects.
+###
 sub search
 {
 	my $self = shift;
 	my $opts = shift || {};
 		);
 	};
 	my $s = $self->with_retry( $search );
 	my $rv = {
-		code	  => $s->code(),
+		code	=> $s->code(),
-		message   => $s->error(),
+		message => $s->error(),
-		entries   => []
+		entries => []
 	};
 	$rv->{'entries'} =
 	  $opts->{'scope'} eq 'base' ? [ $s->shift_entry() ] : [ $s->entries() ];
 	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'};
 	# setup cache object
 	$self->{'cwd_entries'} = $cache->{'entries'};
 	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;
 	my $path    = shift;
 	my %flags   = @_;
 	if ( $path =~ /^\.\./o ) {
 		# support '..' (possibly iterated and as prefix to a DN)
 		my @base = @{ ldap_explode_dn($curbase, casefold => 'none') };
 		# deal with leading ..,
+		#
 		while ( $path =~ /^\.\./ ) {
 			shift( @base ) if @base;
 			$path =~ s/^\.\.//;
 			last if $path !~ /[,\/]\s*/;
 			$path =~ s/[,\/]\s*//;
 	}
 	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;
 	my $globs = shift or return;
 	return unless scalar @$globs;
 	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";
 		return;
 	}
 	return $filter;
 }
-# check whether a given string may be a filter
+### Given an arrayref of objectClasses, pull a complete list of
-# Synopsis: $yesNo = $self->is_valid_filter($string);
+### 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;
 	my $filter = shift or return;
 	return Net::LDAP::Filter->new( $filter ) ? 1 : 0;
 }
-# Call code in subref $action, if there's any connection related errors,
+### 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
+### try it one additional time before giving up.  This should take care of
-# most server disconnects due to timeout and other generic connection
+### most server disconnects due to timeout and other generic connection
-# errors, and will attempt to re-establish a connection.
+### errors, and will attempt to transparently re-establish a connection.
-#
+###
 sub with_retry
 {
 	my $self = shift;
 	my $action = shift;
 	return $rv;
 }
-# little. yellow. different. better.
+### little. yellow. different. better.
-#
+###
 sub debug
 {
 	my $self = shift;
 	return unless $conf->{'debug'};
 	print "\e[33m";
 	print shift();
 	print "\e[0m";
 	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;
 	my $word = $_[0];
 	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'};
+	return @{ $self->{'objectclasses'} };
+}
-	my @oc_data = $self->{'schema'}->all_objectclasses();
-	my @oc;
-	foreach my $o ( @oc_data ) {
+### Inject various autocomplete and alias routines into the symbol table.
-		push @oc, $o->{'name'};
+###
-	}
-	@oc = sort @oc;
-	$self->{'objectclasses'} = \@oc;
-	return @oc;
-}
 {
 	no warnings;
 	no strict 'refs';
 	# command, alias
 		*$alias_sub = \&$real_sub;
 	}
 }
-# Given an $arrayref, remove LDIF continuation wrapping,
+### Given an $arrayref, remove LDIF continuation wrapping in place,
-# effectively making each entry a single line.
+### effectively making each entry a single line for LCS comparisons.
-#
+###
-sub unwrap {
+sub unwrap_line {
+	my $self  = shift;
 	my $array = shift;
 	my $i = 1;
 	while ( $i < scalar(@$array) ) {
 		if ( $array->[$i] =~ /^\s/ ) {
 		}
 	}
 }
-###############################################################
+########################################################################
-#
+### S H E L L   M E T H O D S
-# SHELL METHODS
+########################################################################
-#
-###############################################################
+### Don't die on a newline, just no-op.
+###
-# don't die on a newline
-#
 sub run_ { return; }
-# print shell debug actions
-#
+### Term::Shell hook.
+### Write history for each command, print shell debug actions.
+###
 sub precmd
 {
 	my $self = shift;
 	my ( $handler, $cmd, $args ) = @_;
 	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;
 	my $dn    = shift;
 	my @attrs = (@_) ? @_ : ('*');
 	# support '.'
 	$dn = $self->base() if $dn eq '.';
 	# support globbing
+	#
 	my $s;
 	if ( $dn eq '*' ) {
 		$s = $self->search({
 			scope  => 'one',
 			vals   => 1,
 			vals   => 1,
 			filter => $dn,
 			attrs  => \@attrs
 		});
 	}
+	# absolute/relative dn
+	#
 	else {
-		# convert given path to DN
 		$dn = $self->path_to_dn( $dn );
 		$s = $self->search({
 			base   => $dn,
 			vals   => 1,
 			attrs  => \@attrs
 		});
 	}
+	# 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;
 	my $newbase = shift;
 	# reflect cwd change in prompt
 	$self->update_prompt();
 	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
 	# perhaps there is a better way to do this...?
 	#
 	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
+	# update (which will actually create the new entry)
-	my $rv = $e->update( $self->ldap() );
+	#
-	print $rv->error , "\n";
+	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 ) =
+	# manually generate some boilerplate LDIF.
-		File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
+	#
+	unless ( $self->{'create_file'} ) {
-	# first print out the dn and object classes.
+		my $fh;
-	print $fh 'dn: ???,', $self->base(), "\n";
-	foreach my $oc ( sort @ocs ) {
+		( $fh, $self->{'create_file'} ) =
-		print $fh "objectClass: $oc\n";
+			File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
-	}
+		# first print out the dn and object classes.
-	# now gather attributes for requested objectClasses
+		#
-	#
+		print $fh 'dn: ???,', $self->base(), "\n";
-	my ( %seen, @must_attr, @may_attr );
+		foreach my $oc ( sort @ocs ) {
-	foreach my $oc ( sort @ocs ) {
+			print $fh "objectClass: $oc\n";
+		}
-		# required
-		my @must = $self->{'schema'}->must( $oc );
+		# gather and print attributes for requested objectClasses
-		foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @must ) {
+		#
-			next if $attr->{'name'} =~ /^objectclass$/i;
+		my ( $must_attr, $may_attr ) = $self->fetch_attributes( \@ocs );
-			next if $seen{ $attr->{'name'} };
+		print $fh "$_: \n"   foreach @{ $must_attr };
-			push @must_attr, $attr->{'name'};
+		print $fh "# $_: \n" foreach @{ $may_attr };
-			$seen{ $attr->{'name'} }++;
+		close $fh;
-		}
+	}
-		# optional
+	# checksum the file.
-		my @may  = $self->{'schema'}->may( $oc );
+	#
-		foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) {
+	my $hash_orig = $self->chksum( $self->{'create_file'} );
-			next if $attr->{'name'} =~ /^objectclass$/i;
+	system( $self->{'editor'}, $self->{'create_file'} ) && die "Unable to launch editor: $!\n";
-			next if $seen{ $attr->{'name'} };
-			push @may_attr, $attr->{'name'};
+	# detect a total lack of change
-			$seen{ $attr->{'name'} }++;
+	#
-		}
+	if ( $hash_orig eq $self->chksum($self->{'create_file'}) ) {
-	}
-	# 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";
-	# hash compare
-	my $hash_b = $self->chksum( $fname );
-	if ( $hash_a eq $hash_b ) {
 		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'};
-		return;
+		$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;
 	my @DNs  = @_;
 	unless ( $DNs[0] eq '*' ) {
 		$filter = $self->make_filter( \@DNs ) or return;
 	}
 	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;
 	foreach my $e ( @{ $s->{'entries'} } ) {
 		my $dn = $e->dn();
 	$self->update_entries( clearcache => 1 );
 	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;
 	my $dn   = shift;
 	}
 	# convert given path to DN
 	$dn = $self->path_to_dn( $dn );
+	# sanity check
+	#
 	my $s = $self->search({ base => $dn, vals => 1 });
+	unless ( $s->{'code'} == LDAP_SUCCESS ) {
-	if ( $s->{'code'} ) {
 		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);
+	$e->changetype( 'modify' );
-	$ldif->write_entry( $e );
-	$ldif->done();  # force sync
+	# 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
+	# append optional, unused attributes as comments for fast reference.
-	# for fast reference.
+	#
-	#
+	unless ( $self->{'edit_again'} )  {
-	open LDIF, ">> $self->{'ldif_fname'}";
+		my %current_attrs = map { $_ => 1 } $e->attributes();
-	my %current_attrs = map { $_ => 1 } $e->attributes();
+		my ( $must_attr, $may_attr ) = $self->fetch_attributes( $e->get_value('objectClass', asref => 1) );
-	foreach my $oc ( $e->get_value('objectClass') ) {
-		my @may = $self->{'schema'}->may( $oc );
+		open LDIF, ">> $self->{'ldif_fname'}";
-		foreach my $opt_attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) {
+		foreach my $opt_attr ( sort { $a cmp $b } @{$may_attr} ) {
-			next if $current_attrs{ $opt_attr->{'name'} };
+			next if $current_attrs{ $opt_attr };
-			print LDIF "# " . $opt_attr->{'name'} . ":\n";
+			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'};
+		if ( $self->prompt_edit_again() ) {
-		return;
+			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
 		my ( $attr, $val ) = ( $1, $2 ) if $line =~ /^(.+?): (.*)$/;
 		return unless $attr;
 		return if index($attr, ':') != -1;  # ignore base64
 		return ( $attr, $val );
 	};
-	unwrap( \@orig_ldif );
+	$self->unwrap_line( \@orig_ldif );
-	unwrap( \@new_ldif );
+	$self->unwrap_line( \@new_ldif );
 	my $diff = Algorithm::Diff->new( \@orig_ldif, \@new_ldif );
 	HUNK:
 	while ( $diff->Next() ) {
 		next if $diff->Same();
 		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;
 				$self->debug("DELETE: $_");
 				$e->delete( $attr => [ $val ] );
 			}
 		}
-		# new insertions
+		# attr insertions
+		#
 		if ( $diff_bit == 2 ) {
 			foreach ( $diff->Items(2) ) {
 				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$self->debug("INSERT: $_");
 				$e->add( $attr => $val );
 			}
 		}
-		# replacements
+		# attr change
+		#
 		if ( $diff_bit == 3 ) {
 			foreach ( $diff->Items(2) ) {
 				my ( $attr, $val ) = $parse->( $_ ) or next;
 				$self->debug("MODIFY: $_");
 				if ( $cur_valcount == 1 ) {
 					$e->replace( $attr => $val );
 				}
 				else {
-					# make sure the replace doesn't squash
+					# retain attributes that allow multiples, so updating
-					# other attributes listed with the same name
+					# one attribute doesn't inadvertently remove others with
+					# the same name.
 					#
 					next if $seen_attr{ $attr };
 					my @new_vals;
 					foreach my $line ( @new_ldif ) {
 						my ( $new_attr, $new_val ) = $parse->( $line ) or next;
 						next unless $new_attr eq $attr;
 						$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;
 	foreach ( sort @{ $self->{'env'} } ) {
 		print $conf->{$_} ? $conf->{$_} : 0;
 		print "\n"
 	}
 }
+### 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;
 	my ( $recurse, $filter, $base ) = @_;
 	# convert base path to DN
 	$base = $self->path_to_dn( $base );
 	$self->debug("Filter parsed as: " . $filter->as_string() . "\n");
-	my $s = $self->search(
+	my $s = $self->search({
-		{
+		scope  => $recurse ? 'sub' : 'one',
-			scope  => $recurse ? 'sub' : 'one',
+		base   => $base,
-			base   => $base,
+		filter => $filter
-			filter => $filter
+	});
-		}
-	);
 	foreach my $e ( @{ $s->{'entries'} } ) {
 		my $dn = $e->dn();
 		print "$dn\n";
 	}
 	return;
 }
-# override internal help functions
-# with pod2usage
+### Override internal help function with pod2usage output.
-#
+###
 sub run_help
 {
 	return Pod::Usage::pod2usage(
 		-exitval  => 'NOEXIT',
 		-verbose  => 99,
 		-sections => 'SHELL COMMANDS'
 	);
 }
+### Generate and display a list of LDAP entries, relative to the current
+### location the command was run from.
+###
 sub run_list
 {
 	my $self  = shift;
 	my @args  = @_;
 	my @attrs = ();
 	# flag booleans
 	my ( $recurse, $long );
 	# parse arguments: [ <option> ...] [<filter> ...] [<attribute> ...]
+	#
 	if ( scalar @args ) {
 		# options: support '-l' or '-R' listings
 		if ( $args[0] =~ /^\-(\w+)/o ) {
 			my $flags = $1;
 			$recurse  = $flags =~ /R/;
 		}
 		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
 		$filter = $self->make_filter( \@filters );
 				push( @elements, join(',', @vals) );
 			}
 			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
 				$dn .= " ($desc)";
 			}
 			# no desc?  Try and infer something useful
 			# to display.
+			#
 			else {
 				# pull objectClasses, hash for lookup speed
 				my @oc = $e->get_value( 'objectClass' );
 				my %ochash;
 		( $dn_count == 1 ? 'object.' : 'objects.') .
 		"\n" if $long;
 	return;
 }
+### Create a new organizationalUnit entry.
+###
 sub run_mkdir
 {
 	my $self = shift;
 	my $dir  = shift;
 	print $rv->error(), "\n";
 	$self->update_entries( clearcache => 1 );
 	return;
 }
+### Alter an entry's DN.
+###
 sub run_move
 {
 	my $self = shift;
 	my ( $s_dn, $d_dn ) = @_;
 	$self->{'cache'}->{ $old_dn } = {} if $old_dn;
 	$self->update_entries( clearcache => 1 );
 	return;
 }
+### Change the 'userPassword' attribute of an entry, if
+### supported by the LDAP server.
+###
 sub run_passwd
 {
 	my $self = shift;
 	my $dn   = shift || $self->base();
 	if ( $pw ne $pw2 ) {
 		print "Sorry, passwords do not match.\n";
 		return;
 	}
-	my $rv = $self->ldap->set_password(
+	my $setpw = sub { return $self->ldap->set_password( user => $dn, newpasswd => $pw ); };
-		user	  => $dn,
+	my $rv = $self->with_retry( $setpw );
-		newpasswd => $pw
-	);
 	if ( $rv->code() == LDAP_SUCCESS ) {
 		print "Password updated successfully.\n";
 	}
 	else {
 	}
 	return;
 }
+### Display the current working "directory".
+###
 sub run_pwd
 {
 	my $self = shift;
 	print $self->base() . "\n";
 	return;
 }
-sub run_setenv
-{
+### Display the currently bound user.
-	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;
-}
 sub run_whoami
 {
 	my $self = shift;
 	print $conf->{'binddn'} || 'anonymous bind';
 	print "\n";
 	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;
 use Pod::Usage;
 eval 'use Term::ReadLine::Gnu';
 use vars '$conf';
 $conf = load_config() || {};
 Getopt::Long::GetOptions(
 	$conf,
 	'server|H=s',
+	'configfile|f=s',
 	'binddn|D=s',
 	'basedn|b=s',
 	'cacheage=i',
 	'promptpass|W',
 	'timeout=i',
 	}
 );
 # 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;
 # create and enter shell loop
 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;
+	unless ( $confpath ) {
-	my @confs = (
+		my @confs = (
-		"$ENV{'HOME'}/.shelldap.rc",
+			"$ENV{'HOME'}/.shelldap.rc",
-		'/usr/local/etc/shelldap.conf',
+			'/usr/local/etc/shelldap.conf',
-		'/etc/shelldap.conf',
+			'/etc/shelldap.conf',
-	);
+		);
-	foreach ( @confs ) {
+		foreach ( @confs ) {
-		if ( -e $_ ) {
+			if ( -e $_ ) {
-			$confpath = $_;
+				$confpath = $_;
-			last;
+				last;
+			}
 		}
 	}
 	$confpath or return undef;
 	open YAML, $confpath or return undef;
 	die "Invalid YAML in $confpath\n" if $@;
 	return $conf;
 }
-## EOF
+### EOF

changeset 50	21ba5eb5c2fc
parent 49	57df728cdb77
child 51	27bbe75233a3