# HG changeset patch
# User mahlon
# Date 1228406809 0
# Node ID f7990a76e2173229f8703d1053e43279f227c151

Restructure for tags/branches.

diff -r 000000000000 -r f7990a76e217 shelldap
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/shelldap	Thu Dec 04 16:06:49 2008 +0000
@@ -0,0 +1,1669 @@
+#!/usr/bin/env perl
+# vim: set nosta noet ts=4 sw=4:
+#
+# Copyright (c) 2006, Mahlon E. Smith <mahlon@martini.nu>
+# All rights reserved.
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+#     * Redistributions of source code must retain the above copyright
+#       notice, this list of conditions and the following disclaimer.
+#     * Redistributions in binary form must reproduce the above copyright
+#       notice, this list of conditions and the following disclaimer in the
+#       documentation and/or other materials provided with the distribution.
+#     * Neither the name of Mahlon E. Smith nor the names of his
+#       contributors may be used to endorse or promote products derived
+#       from this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
+# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+# DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
+# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+=head1 NAME
+
+Shelldap / LDAP::Shell
+
+A program for interacting with an LDAP server via a shell-like
+interface.
+
+This is not meant to be an exhaustive LDAP editing and browsing
+interface, but rather an intuitive shell for performing basic LDAP
+tasks quickly and with minimal effort.
+
+=head1 SYNPOSIS
+
+ shelldap --server example.net --basedn dc=your,o=company [--tls] [--binddn ...] [--help]
+
+=head1 FEATURES
+
+ - Upon successful authenticated binding, credential information is
+   auto-cached to ~/.shelldap.rc -- future loads require no command line
+   flags.
+
+ - Custom 'description maps' for entry listings.  (See the 'list' command.)
+
+ - History and autocomplete via readline, if installed.
+
+ - Automatic reconnection attempts if the connection is lost with the
+   LDAP server.
+
+ - It feels like a semi-crippled shell, making LDAP browsing and editing
+   at least halfway pleasurable.
+
+=head1 OPTIONS
+
+All command line options follow getopts long conventions.
+
+    shelldap --server example.net --basedn dc=your,o=company
+
+You may also optionally create a ~/.shelldap.rc file with command line
+defaults.  This file should be valid YAML.  (This file is generated
+automatically on a successful bind auth.)
+
+Example:
+
+    server: ldap.example.net
+    binddn: cn=Manager,dc=your,o=company
+    bindpass: xxxxxxxxx
+    basedn: dc=your,o=company
+    tls: yes
+
+=over 4
+
+=item B<server>
+
+Required. The LDAP server to connect to.  This can be a hostname, IP
+address, or a URI.
+
+    --server ldaps://ldap.example.net
+
+=back
+
+=over 4
+
+=item B<binddn>
+
+The full dn of a user to authenticate as.  If not specified, defaults to
+an anonymous bind.  You will be prompted for a password.
+
+    --binddn cn=Manager,dc=your,o=company
+
+=back
+
+=over 4
+
+=item B<basedn>
+
+The directory 'root' of your LDAP server.  If omitted, shelldap will
+try and ask the server for a sane default.
+
+    --basedn dc=your,o=company
+
+=back
+
+=over 4
+
+=item B< tls>
+
+Enables TLS over what would normally be an insecure connection.
+Requires server side support.
+
+=back
+
+=over 4
+
+=item B<cacheage>
+
+Set the time to cache directory lookups in seconds.
+
+By default, directory lookups are cached for 300 seconds, to speed
+autocomplete up when changing between different basedns.
+
+Modifications to the directory automatically reset the cache.  Directory
+listings are not cached.  (This is just used for autocomplete.)  Set it
+to 0 to disable caching completely.
+
+=back
+
+=over 4
+
+=item B<timeout>
+
+Set the maximum time an LDAP operation can take before it is cancelled.
+
+=back
+
+=over 4
+
+=item B<debug>
+
+Print extra operational info out, and backtrace on fatal error.
+
+=back
+
+=head1 SHELL COMMANDS
+
+=over 4
+
+=item B< cat>
+
+Display an LDIF dump of an entry.  Globbing is supported.  Specify
+either the full dn, or an rdn.  For most commands, rdns are local to the
+current search base. ('cwd', as translated to shell speak.)  You may additionally
+add a list of attributes to display.  Use '+' for server side attributes.
+
+    cat uid=mahlon
+    cat ou=*
+    cat uid=mahlon,ou=People,dc=example,o=company
+    cat uid=mahlon + userPassword
+
+=item B<  cd>
+
+Change directory.  Translated to LDAP, this changes the current basedn.
+All commands after a 'cd' operate within the new basedn.
+
+    cd                cd to 'home' basedn
+    cd ~              same thing
+    cd -              cd to previous directory
+    cd ou=People      cd to explicit path
+    cd ..             cd to parent node
+
+Since LDAP doesn't actually limit what can be a container object, you
+can actually cd into any entry. Many commands then work on '.', meaning
+"wherever I currently am."
+
+    cd uid=mahlon
+    cat .
+
+=item B<clear>
+
+Clear the screen.
+
+=item B<copy>
+
+Copy an entry to a different dn path.  All copies are relative to the
+current basedn, unless a full dn is specified.  All attributes are
+copied, then an LDAP moddn() is performed.
+
+    copy uid=mahlon uid=bob
+    copy uid=mahlon ou=Others,dc=example,o=company
+    copy uid=mahlon,ou=People,dc=example,o=company uid=mahlon,ou=Others,dc=example,o=company
+
+aliased to: cp
+
+=item B<create>
+
+Create an entry from scratch.  Arguments are space separated objectClass
+names.  Possible objectClasses are derived automatically from the
+server, and will tab-complete.
+
+After the classes are specified, an editor will launch.  Required
+attributes are listed first, then optional attributes.  Optionals are
+commented out.  After the editor exits, the resulting LDIF is validated
+and added to the LDAP directory.
+
+    create top person organizationalPerson inetOrgPerson posixAccount
+
+aliased to: touch
+
+=item B<delete>
+
+Remove an entry from the directory.  Globbing is supported.
+All deletes are sanity-prompted.
+
+    delete uid=mahlon
+    delete uid=ma*
+
+aliased to: rm
+
+=item B<edit>
+
+Edit an entry in an external editor.  After the editor exits, the
+resulting LDIF is sanity checked, and changes are written to the LDAP
+directory.
+
+    edit uid=mahlon
+
+aliased to: vi
+
+=item B< env>
+
+ Show values for various runtime variables.
+
+=item B<grep>
+
+Search for arbitrary LDAP filters, and return matching dn results.
+The search string must be a valid LDAP filter.
+
+    grep uid=mahlon
+    grep uid=mahlon ou=People
+    grep -r (&(uid=mahlon)(objectClass=*))
+
+ aliased to: search
+
+=item B<list>
+
+List entries for the current basedn.  Globbing is supported.
+
+aliased to: ls
+
+    ls -l
+    ls -lR uid=mahlon
+    list uid=m*
+    list verbose
+
+In 'verbose' mode, descriptions are listed as well, if they exist.
+There are also some 'sane' long listings for common objectClass types.
+You can actually specify your own in your .shelldap.rc, like so:
+
+    ...
+    descmaps:
+        objectClass: attributename
+        posixAccount: gecos
+        posixGroup: gidNumber
+        ipHost: ipHostNumber
+        puppetClient: puppetclass
+
+=item B<mkdir>
+
+Creates a new 'organizationalUnit' entry.
+
+    mkdir containername
+    mkdir ou=whatever
+
+=item B<move>
+
+Move an entry to a different dn path.  Usage is identical to B<copy>.
+
+aliased to: mv
+
+=item B<passwd>
+
+If supported server side, change the password for a specified entry.
+The entry must have a 'userPassword' attribute.
+
+    passwd uid=mahlon
+
+=item B< pwd>
+
+Print the 'working directory' - aka, the current ldap basedn.
+
+=item B<setenv>
+
+Modify various runtime variables normally set from the command line.
+
+    setenv debug 1
+    export debug=1
+
+=item B<whoami>
+
+Show current auth credentials.  Unless you specified a binddn, this
+will just show an anonymous bind.
+
+=back
+
+=head1 TODO
+
+Referral support.  Currently, if you try to write to a replicant slave,
+you'll just get a referral.  It would be nice if shelldap automatically
+tried to follow it.
+
+For now, it only makes sense to connect to a master if you plan on doing
+any writes.
+
+"cd ../ou=SomewhereElse" doesn't work, but "cd ../../" does.  This is
+weird, as both should probably work.
+
+=head1 BUGS / LIMITATIONS
+
+There is currently no attribute multiline support - attribute values
+that span over one line will be ignored if modified.  (Thankfully, they
+are generally rare.)
+
+There is no support for editing binary data.  This is actually related
+to the lack of multiline support - if you just base64 encode data and
+paste it in, it will be ignored for the same reasons.
+
+=head1 AUTHOR
+
+Mahlon E. Smith <mahlon@martini.nu>
+
+=cut
+
+package LDAP::Shell;
+use strict;
+use warnings;
+use Term::ReadKey;
+use Term::Shell;
+use Digest::MD5;
+use Net::LDAP;
+use Net::LDAP::LDIF;
+use Data::Dumper;
+use File::Temp;
+use Algorithm::Diff;
+use Carp 'confess';
+use base 'Term::Shell';
+require Net::LDAP::Extension::SetPassword;
+
+my $conf = $main::conf;
+
+# make 'die' backtrace in debug mode
+$SIG{'__DIE__'} = \&Carp::confess if $conf->{'debug'};
+
+###############################################################
+#
+# UTILITY FUNCTIONS
+#
+###############################################################
+
+# initial shell behaviors
+# 
+sub init
+{
+	my $self = shift;
+	$self->{'API'}->{'match_uniq'} = 0;
+
+	$self->{'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;
+	$term->Attribs->{'completer_word_break_characters'} =~ s/=//m;
+
+	# read in history
+	eval {
+		$term->history_truncate_file("$ENV{'HOME'}/.shelldap_history", 50);
+		$term->ReadHistory("$ENV{'HOME'}/.shelldap_history");
+	};
+
+	$self->{'root_dse'} = $self->ldap->root_dse();
+	if ( $conf->{'debug'} ) {
+		$self->{'schema'}   = $self->ldap->schema();
+		my @versions = 
+			@{ $self->{'root_dse'}->get_value('supportedLDAPVersion', asref => 1) };
+		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)
+	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.
+	$self->update_entries();
+
+	# whew, okay.  Update prompt, wait for input!
+	$self->update_prompt();
+
+	return;
+}
+
+
+# get an ldap connection handle
+#
+sub ldap
+{
+	my $self = shift;
+
+	# use cached connection object if it exists
+	return $self->{'ldap'} if $self->{'ldap'};
+	
+	# fill in potentially missing info
+	die "No server specified.\n" unless $conf->{'server'};
+	if ( $conf->{'binddn'} && ! $conf->{'bindpass'} ) {
+		print "Bind password: ";
+		Term::ReadKey::ReadMode 2;
+		chomp($conf->{'bindpass'} = <STDIN>);
+		Term::ReadKey::ReadMode 0;
+		print "\n";
+	}
+
+	# make connection
+	my $ldap = Net::LDAP->new( $conf->{'server'} )
+		or die "Unable to connect to LDAP server '$conf->{'server'}': $!\n";
+	$ldap->start_tls( verify => 'none' ) if $conf->{'tls'};
+
+	# bind
+	my $rv;
+	if ( $conf->{'binddn'} ) {
+		# authed
+		$rv = $ldap->bind(
+			$conf->{'binddn'},
+			password => $conf->{'bindpass'}
+		);
+	}
+	else {
+		# anon
+		$rv = $ldap->bind();
+	}
+
+	my $err = $rv->error();
+	if ( $rv->code() ) {
+		$err .= " (forgot the --tls flag?)"
+			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'} ) {
+		print "Would you like to cache your connection information? [Y/n]: ";
+		chomp( my $response = <STDIN> );
+		unless ( $response =~ /^n/i ) {
+			YAML::Syck::DumpFile( $conf->{'confpath'}, $conf );
+			chmod 0600, $conf->{'confpath'};
+			print "Connection info cached.\n";
+		}
+	}
+
+	$self->{'ldap'} = $ldap;
+	return $ldap;
+}
+
+# just return an LDIF object
+#
+sub ldif 
+{
+	my $self	 = shift;
+	my $use_temp = shift;
+
+	# create tmpfile and link ldif object with it
+	if ( $use_temp ) {
+		my ( undef, $fname ) =
+		  File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
+		$self->{'ldif'}	   = Net::LDAP::LDIF->new( $fname, 'w', sort => 1 );
+		$self->{'ldif_fname'} = $fname;
+	}
+
+	# ldif -> stdout
+	else {
+		$self->{'ldif'} = Net::LDAP::LDIF->new( \*STDOUT, 'w', sort => 1 );
+	}
+
+	return $self->{'ldif'};
+}
+
+# load and return an Entry object from LDIF
+#
+sub load_ldif
+{
+	my $self = shift;
+
+	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
+#
+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";
+	my $hash = $md5->addfile( *F )->hexdigest();
+	close F;
+
+	return $hash;
+}
+
+# prompt functions
+#
+sub prompt_str
+{
+	my $self = shift;
+	return $self->{'prompt'};
+}
+sub update_prompt 
+{
+	my $self = shift;
+	my $base = $self->base();
+
+	if ( length $base > 50 ) {
+		my $cwd_dn = $1 if $base =~ /^(.*?),/;
+		$self->{'prompt'} = "... $cwd_dn > ";
+	}
+	else {
+		my $prompt = $base;
+		$prompt =~ s/$conf->{'basedn'}/~/;
+		$self->{'prompt'} = "$prompt > ";
+	}
+	return;
+}
+
+# search base accessor
+#
+sub base 
+{
+	my $self = shift;
+	$self->{'base'} ||= $conf->{'basedn'};
+
+	# try and determine base automatically from rootDSE
+	#
+	unless ( $self->{'base'} ) {
+		my $base = $self->{'root_dse'}->{'asn'} || {};
+		$base = $base->{'attributes'}			|| [];
+		$base = $base->[0]						|| {};
+		$base = $base->{'vals'}					|| [];
+		$conf->{'basedn'} = $base->[0];
+		$self->{'base'}   = $base->[0];
+	}
+	if ( $_[0] ) {
+		$self->{'base'} = $_[0];
+	}
+	return $self->{'base'};
+}
+
+# make sure a given rdn includes the current
+# base, making it a dn.
+# accepts a string reference.
+# 
+sub rdn_to_dn 
+{
+	my $self = shift;
+	my $rdn  = shift or return;
+
+	return unless ref $rdn;
+
+	# allow cd to 'basedn' and cd to directories 'higher' in the tree
+	return if $$rdn =~ /$conf->{'basedn'}$/;
+
+	# auto fill in current base for deeper DNs
+	my ( $dn, $curbase ) = ( $$rdn, $self->base() );
+	$dn = "$$rdn," . $curbase unless $$rdn =~ /$curbase/i;
+
+	$$rdn = $dn;
+}
+
+# do a search on a dn to determine if it is valid.
+# returns a bool.
+#
+sub is_valid_dn 
+{
+	my $self = shift;
+	my $dn   = shift or return 0;
+
+	my $r = $self->search({ base => $dn });
+
+	return $r->{'code'} == 0 ? 1 : 0;
+}
+
+# perform an ldap search
+# return an hashref containing return code and
+# arrayref of Net::LDAP::Entry objects
+#
+sub search 
+{
+	my $self = shift;
+	my $opts = shift || {};
+
+	$opts->{'base'}   ||= $self->base(),
+	$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'} || ['*']
+	);
+
+	my $rv = {
+		code	  => $s->code(),
+		message   => $s->error(),
+		entries   => []
+	};
+
+	# since search is used just about everywhere, this seems like 
+	# a pretty good place to check for connection errors.
+	#
+	# check for a lost connection, kill cached object so we
+	# try to reconnect on the next search.
+	#
+	$self->{'ldap'} = undef if $s->code() == 81;
+
+	$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.
+#
+sub update_entries 
+{
+	my $self = shift;
+	my %opts = @_;
+	my $base = lc( $self->base() );
+	
+	my $s = $opts{'search'} || $self->search({ scope => 'one' });
+
+	$self->{'cwd_entries'} = [];
+	return if $s->{'code'};
+
+	# setup cache object
+	$self->{'cache'} ||= {};
+	$self->{'cache'}->{ $base } ||= {};
+	$self->{'cache'}->{ $base } = {} if $opts{'clearcache'};
+	my $cache = $self->{'cache'}->{ $base };
+
+	my $now = time();
+	if ( ! exists $cache->{'entries'}
+		or $now - $cache->{'timestamp'} > $conf->{'cacheage'} )
+	{
+		$self->debug("Caching entries for $base\n");
+		foreach my $e ( @{ $s->{'entries'} } ) {
+			my $dn  = $e->dn();
+			my $rdn = $dn;
+			$rdn =~ s/,$base//i;  # remove base from display
+			push @{ $self->{'cwd_entries'} }, $rdn;
+		}
+		$cache->{'timestamp'} = $now;
+		$cache->{'entries'} = $self->{'cwd_entries'};
+	}
+	else {
+		$self->debug("Using cached lookups for $base\n");
+	}
+
+	$self->{'cwd_entries'} = $cache->{'entries'};
+	return;
+}
+
+# parse parent ('..') cn requests
+#
+sub parent_dn 
+{
+	my $self = shift;	
+	my $rdn  = shift or return;
+	return unless ref $rdn;
+
+	# FIXME: 'cd ../ou=somewhere' should work
+	my $dn = $self->base();
+	my $dotcount = $$rdn =~ s/\.\./\.\./g;
+	$dn =~ s/^.*?,// for 1 .. $dotcount;
+
+	$$rdn = $dn;
+}
+
+# given an array ref of shell-like globs, 
+# make and return an LDAP filter object.
+#
+sub make_filter 
+{
+	my $self  = shift;
+	my $globs = shift or return;
+
+	return unless ref $globs eq 'ARRAY';
+	return unless scalar @$globs;
+
+	my $filter;
+	$filter = join '', map { "($_)" } @$globs;
+	$filter = '(|' . $filter . ')' if scalar @$globs > 1;
+	$filter = Net::LDAP::Filter->new( $filter );
+
+	if ( $filter ) {
+		$self->debug('Filter parsed as: ' . $filter->as_string() . "\n");
+	}
+	else {
+		print "Error parsing filter.\n";
+		return;
+	}
+
+	return $filter;
+}
+
+# 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
+#
+sub autocomplete_cwd
+{
+	my $self = shift;
+	my $word = $_[0];
+
+	return sort @{ $self->{'cwd_entries'} };
+}
+
+sub comp_setenv
+{ 
+	my $self = shift;
+	return @{ $self->{'env'} };
+}
+
+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;
+}
+
+{
+	no warnings;
+	no strict 'refs';
+
+	# command, alias
+	my %cmd_map = (
+		whoami => 'id',
+		list   => 'ls',
+		grep   => 'search',
+		edit   => 'vi',
+		delete => 'rm',
+		copy   => 'cp',
+		cat	=> 'read',
+		move   => 'mv',
+		cd	 => undef,
+		passwd => undef
+	);
+
+	# setup autocompletes
+	foreach ( %cmd_map ) {
+		next unless $_;
+		my $sub = "comp_$_";
+		*$sub = \&autocomplete_cwd;
+	}
+	*comp_touch  = \&comp_create;
+	*comp_export = \&comp_setenv;
+
+	# setup alias subs
+	#
+	# Term::Shell has an alias_* feature, but
+	# it seems to work about 90% of the time.
+	# that last 10% is something of a mystery.
+	#
+	$cmd_map{'create'} = 'touch';
+	foreach my $cmd ( keys %cmd_map ) {
+		next unless defined $cmd_map{$cmd};
+		my $alias_sub = 'run_' . $cmd_map{$cmd};
+		my $real_sub  = 'run_' . $cmd;
+		*$alias_sub = \&$real_sub;
+	}
+}
+
+###############################################################
+#
+# SHELL METHODS
+#
+###############################################################
+
+# don't die on a newline
+#
+sub run_ { return; }
+
+# 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;
+} 
+
+sub run_cat 
+{
+	my $self  = shift;
+	my $dn    = shift;
+	my $attrs = \@_;
+	$attrs->[0] = '*' unless scalar @$attrs;
+
+	unless ( $dn ) {
+		print "No dn provided.\n";
+		return;
+	}
+
+	# support '.'
+	$dn = $self->base() if $dn eq '.';
+
+	# support globbing
+	my $s;
+	if ( $dn eq '*' ) {
+		$s = $self->search({
+			scope  => 'one',
+			vals   => 1,
+			attrs  => $attrs
+		});
+	}
+	elsif ( $dn =~ /\*/ ) {
+		$s = $self->search({
+			scope  => 'one',
+			vals   => 1,
+			filter => $dn,
+			attrs  => $attrs
+		});
+	}
+	else {
+		$self->rdn_to_dn( \$dn );
+		$s = $self->search({
+			base   => $dn,
+			vals   => 1,
+			attrs  => $attrs
+		});
+	}
+
+	if ( $s->{'code'} ) {
+		print $s->{'message'} . "\n";
+		return;
+	}
+
+	foreach my $e ( @{ $s->{'entries'} } ) {
+		$self->ldif->write_entry( $e );
+		print "\n";
+	}
+	return;
+}
+
+sub run_cd 
+{
+	my $self	= shift;
+	my $newbase = join ' ', @_;
+	
+	# support 'cd' going to root
+	$newbase ||= $conf->{'basedn'};
+
+	# support 'cd -'
+	if ( $newbase eq '-' ) {
+		$newbase = $self->{'previous_base'} || return;
+	}
+
+	# support '..'
+	if ( $newbase =~ /\.\./ ) {
+		$self->parent_dn( \$newbase );
+	}
+	else {
+		$self->rdn_to_dn( \$newbase );
+	}
+	
+	unless ( $self->is_valid_dn( $newbase ) ) {
+		print "No such object\n";
+		return;
+	}
+
+	# store old base
+	$self->{'previous_base'} = $self->base();
+
+	# update new base
+	$self->base( $newbase );
+
+	# get new 'cwd' listing
+	my $s = $self->search({ scope => 'one' });
+	if ( $s->{'code'} ) {
+		print "$s->{'message'}\n";
+		return;
+	}
+	$self->update_entries( search => $s );
+
+	# reflect cwd change in prompt
+	$self->update_prompt();
+	return;
+}
+
+sub run_clear
+{
+	my $self = shift;
+	system('clear');
+	return;
+}
+
+sub run_copy
+{
+	my $self = shift;
+	my ( $s_dn, $d_dn ) = @_;
+
+	unless ( $s_dn ) {
+		print "No source dn provided.\n";
+		return;
+	}
+	unless ( $d_dn ) {
+		print "No destination dn provided.\n";
+		return;
+	}
+
+	my $s_rdn = $s_dn;
+	$self->rdn_to_dn( \$s_dn );
+	my $s = $self->search({ base => $s_dn, vals => 1 });
+	unless ( $s->{'code'} == 0 ) {
+		print "No such object\n";
+		return;
+	}
+
+	# see if we're copying the entry to a totally new path
+	my ( $new_dn, $old_dn );
+	( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\w=]+),(.*)$/;
+	if ( $new_dn ) {
+		unless ( $self->is_valid_dn( $new_dn ) ) {
+			print "Invalid destination.\n";
+			return;
+		}
+	}
+	else {
+		$new_dn = $self->base();
+	}
+	$old_dn = $1 if $s_dn =~ /^[\w=]+,(.*)$/;
+
+	# get the source object
+	my $e = ${ $s->{'entries'} }[0];
+	$e->dn( $s_dn );
+
+	# add changes in new entry instead of modifying existing
+	$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";
+		return;
+	}
+	$e->replace( $uniqkey => $uniqval );
+
+	# update
+	my $rv = $e->update( $self->ldap() );
+	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;
+}
+
+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
+	#
+	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'} }++;
+		}
+	}
+
+	# 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;
+		return;
+	}
+
+	# load in LDIF
+	my $ldif = Net::LDAP::LDIF->new( $fname, 'r', onerror => 'warn' );
+	my $e	= $ldif->read_entry();
+	unless ( $e ) {
+		print "Unable to parse LDIF.\n";
+		unlink $fname;
+		return;
+	}
+	$e->changetype('add');
+	my $rv = $e->update( $self->ldap() );
+	print $rv->error(), "\n";
+
+	$self->update_entries( clearcache => 1 ) unless $rv->code();
+
+	unlink $fname;
+	return;
+}
+
+sub run_delete
+{
+	my $self = shift;
+	my @DNs  = @_;
+
+	unless ( scalar @DNs ) {
+		print "No dn specified.\n";
+		return;
+	}
+        my $filter;
+        unless ( $DNs[0] eq '*' ) {
+            $filter = $self->make_filter( \@DNs ) or return;
+        }
+
+
+	my $s = $self->search({ scope => 'one', filter => $filter });
+	if ( $s->{'code'} ) {
+		print "$s->{'message'}\n";
+		return;
+	}
+
+	print "Are you sure? [N/y]: ";
+	chomp( my $resp = <STDIN> );
+	return unless $resp =~ /^y/i;
+   
+	foreach my $e ( @{ $s->{'entries'} } ) {
+		my $dn = $e->dn();
+		my $rv = $self->ldap->delete( $dn );
+		print "$dn: ", $rv->error(), "\n";
+	}
+   
+	$self->update_entries( clearcache => 1 );
+	return;
+}
+
+sub run_edit
+{
+	my $self = shift;
+	my $dn   = join ' ', @_;
+
+	unless ( $dn ) {
+		print "No dn provided.\n";
+		return;
+	}
+
+	# support '.'
+	$dn = $self->base() if $dn eq '.';
+
+	$self->rdn_to_dn( \$dn );
+	my $s = $self->search({ base => $dn, vals => 1 });
+
+	if ( $s->{'code'} ) {
+		print $s->{'message'} . "\n";
+		return;
+	}
+
+	# fetch entry and write it out to disk
+	my $e = ${ $s->{'entries'} }[0];
+	my $ldif = $self->ldif(1);
+	$ldif->write_entry( $e );
+	$ldif->done();  # force sync
+
+	# load it into an array for potential comparison
+	my @orig_ldif;
+	open LDIF, "$self->{'ldif_fname'}" or return;
+	@orig_ldif = <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'}" ) &&
+		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 ) {
+		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 ) {
+		print "Unable to parse LDIF.\n";
+		unlink $self->{'ldif_fname'};
+		return;
+	}
+
+	# load changes into a new array for comparison
+	my @new_ldif;
+	open LDIF, "$self->{'ldif_fname'}" or return;
+	@new_ldif = <LDIF>;
+	close LDIF;
+
+	$e->changetype('modify');
+
+	my $parse = sub {
+		my $line = shift || $_;
+		return unless $line =~ /^\w/; # ignore multiline
+		return if $line	 =~ /^\#/; # ignore comments
+		my ( $attr, $val ) = ( $1, $2 ) if $line =~ /^(.+?): (.*)$/;
+		return if index($attr, ':') != -1;  # ignore base64
+		return ( $attr, $val );
+	};
+
+	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
+		if ( $diff_bit == 1 ) {
+			foreach ( $diff->Items(1) ) {
+				next unless /\w+/;
+				$self->debug("DELETE: $_");
+				my ( $attr, $val ) = $parse->( $_ ) or next;
+				$e->delete( $attr => [ $val ] );
+			}
+		}
+
+		# new insertions
+		if ( $diff_bit == 2 ) {
+			foreach ( $diff->Items(2) ) {
+				next unless /\w+/;
+				$self->debug("INSERT: $_");
+				my ( $attr, $val ) = $parse->( $_ ) or next;
+				$e->add( $attr => $val );
+			}
+		}
+
+		# replacements
+		# these are trickier with multivalue lines
+		if ( $diff_bit == 3 ) {
+			foreach ( $diff->Items(2) ) {
+				next unless /\w+/;
+				$self->debug("MODIFY: $_");
+				my ( $attr, $val ) = $parse->( $_ ) or next;
+
+				my $cur_vals = $e->get_value( $attr, asref => 1 ) || [];
+				my $cur_valcount = scalar @$cur_vals;
+				next if $cur_valcount == 0; # should have been an 'add'
+
+				# replace immediately 
+				#
+				if ( $cur_valcount == 1 ) {
+					$e->replace( $attr => $val );
+				}
+				else {
+
+					# make sure the replace doesn't squash
+					# other attributes listed 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 $rv = $e->update( $self->ldap );
+	print $rv->error(), "\n";
+
+	return;
+}
+
+sub run_env
+{
+	my $self = shift;
+
+	foreach ( sort @{ $self->{'env'} } ) {
+		print "$_: ";
+		print $conf->{$_} ? $conf->{$_} : 0; 
+		print "\n"
+	}
+}
+
+sub run_grep
+{
+	my $self = shift;
+	my ( $recurse, $filter, $base ) = @_;
+
+	# set 'recursion'
+	unless ( $recurse && $recurse =~ /\-r|recurse/ ) {
+		# shift args to the left
+		( $recurse, $filter, $base ) = ( undef, $recurse, $filter );
+	}
+
+	$filter = Net::LDAP::Filter->new( $filter );
+	unless ( $filter ) {
+		print "Invalid search filter.\n";
+		return;
+	}
+
+	# support '*'
+	$base = $self->base() if ! $base or $base eq '*';
+
+	unless ( $base ) {
+		print "No search base specified.\n";
+		return;
+	}
+	$self->rdn_to_dn( \$base );
+
+	$self->debug("Filter parsed as: " . $filter->as_string() . "\n");
+
+	my $s = $self->search(
+		{
+			scope  => $recurse ? 'sub' : 'one',
+			base   => $base,
+			filter => $filter
+		}
+	);
+
+	foreach my $e ( @{ $s->{'entries'} } ) {
+		my $dn = $e->dn();
+		print "$dn\n";
+	}
+
+	return;
+}
+
+# override internal help functions
+# with pod2usage
+#
+sub run_help 
+{
+	return Pod::Usage::pod2usage(
+		-exitval  => 'NOEXIT',
+		-verbose  => 99,
+		-sections => 'SHELL COMMANDS'
+	);
+}
+
+sub run_list
+{
+	my $self	= shift;
+	my @filters = @_;
+	my $base	= $self->base();
+
+	# setup filters
+	my ( $flags, $filter );
+	if ( scalar @filters ) {
+		# support '-l' or '-R' listings
+		if ( $filters[0] =~ /\-[lR]|verbose/ ) {
+			$flags = shift @filters;
+		}
+		
+		$filter = $self->make_filter( \@filters );
+	}
+
+	# flag booleans
+	my ( $recurse, $long );
+	if ( $flags ) {
+		$recurse = $flags =~ /R/;
+		$long	= $flags =~ /l/;
+	}
+
+	my $s = $self->search({ scope => $recurse ? 'sub' : 'one',
+							vals  => $long, filter => $filter });
+	if ( $s->{'code'} ) {
+		print "$s->{'message'}\n";
+		return;
+	}
+
+	# if an entry doesn't have a description field,
+	# try and show some nice defaults for ls -l !
+	# 
+	# objectClass -> Attribute to show
+	#
+	my %descs = %{
+		$conf->{'descmaps'}
+		  || {
+			posixAccount => 'gecos',
+			posixGroup   => 'gidNumber',
+			ipHost	   => 'ipHostNumber',
+		  }
+	  };
+
+	# iterate and print
+	#
+	my $dn_count = 0;
+	my $dn;
+	foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) {
+		$dn = $e->dn();
+		my $rdn = $dn;
+		$rdn =~ s/,$base//i;
+
+		unless ( $long ) {
+			$dn = $rdn;
+			next;
+		}
+
+		# 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', asref => 1 ) || [] };
+			my %ochash;
+			map { $ochash{$_} = 1 } @oc;
+
+			foreach my $d_listing ( sort keys %descs ) {
+				if ( exists $ochash{ $d_listing } ) {
+					my $str = $e->get_value( $descs{ $d_listing }, asref => 1 );
+					$dn .= ' (' . (join ', ', @$str) . ')' if $str && scalar @$str;
+				}
+				next;
+			}
+		}
+	} 
+	continue {
+		print "$dn\n";
+		$dn_count++;
+	}
+	
+	print "\n$dn_count " .
+		( $dn_count == 1 ? 'object.' : 'objects.') .
+		"\n" if $long;
+	return;
+}
+
+sub run_mkdir
+{
+	my $self = shift;
+	my $dir  = join ' ', @_;
+
+	unless ( $dir ) {
+		print "No 'directory' provided.\n";
+		return;
+	}
+
+	# normalize ou name, then pull uniq val back out.
+	$dir = "ou=$dir" unless $dir =~ /^ou=/i;
+	$self->rdn_to_dn( \$dir );
+
+	my $ou = $1
+	  if $dir =~ /^[\.\w]+(?:\s+)?=(?:\s+)?([\.\-\s\w]+),?/;
+
+	# add
+	my $r = $self->ldap()->add( $dir, attr => [
+		objectClass => [ 'top', 'organizationalUnit' ],
+		ou		  => $ou,
+	]);
+
+	print $r->error(), "\n";
+	$self->update_entries( clearcache => 1 );
+	return;
+}
+
+sub run_move
+{
+	my $self = shift;
+	my ( $s_dn, $d_dn ) = @_;
+
+	unless ( $s_dn ) {
+		print "No source dn provided.\n";
+		return;
+	}
+	unless ( $d_dn ) {
+		print "No destination dn provided.\n";
+		return;
+	}
+
+	my $s_rdn = $s_dn;
+	$self->rdn_to_dn( \$s_dn );
+	unless ( $self->is_valid_dn( $s_dn ) ) {
+		print "No such object\n";
+		return;
+	}
+
+	# see if we're moving the entry to a totally new path
+	my ( $new_dn, $old_dn );
+	( $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
+	);
+	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;
+}
+
+sub run_passwd 
+{
+	my $self = shift;
+	my $dn   = shift || $self->base();
+
+	$self->{'root_dse'} ||= $self->ldap->root_dse();
+
+	my $pw_extension = '1.3.6.1.4.1.4203.1.11.1';
+	unless ( $self->{'root_dse'}->supported_extension( $pw_extension ) ) {
+		print "Sorry, password changes not supported by LDAP server.\n";
+		return;
+	}
+
+	# support '.'
+	$dn = $self->base() if $dn eq '.';
+
+	$self->rdn_to_dn( \$dn );
+	my $s = $self->search( { base => $dn, scope => 'base' } );
+	if ( $s->{'code'} ) {
+		print $s->{'message'}, "\n";
+		return;
+	}
+	my $e = ${ $s->{'entries'} }[0];
+
+	unless ( $e->exists('userPassword') ) {
+		print "No userPassword attribute for $dn\n";
+		return;
+	}
+
+	print "Changing password for $dn\n";
+	Term::ReadKey::ReadMode 2;
+	print "Enter new password: ";
+	chomp( my $pw  = <STDIN> );
+	print "\nRetype new password: ";
+	chomp( my $pw2 = <STDIN> );
+	print "\n";
+	Term::ReadKey::ReadMode 0;
+
+	if ( $pw ne $pw2 ) {
+		print "Sorry, passwords do not match.\n";
+		return;
+	}
+
+	my $rv = $self->ldap->set_password(
+		user	  => $dn,
+		newpasswd => $pw
+	);
+
+	if ( $rv->code() == 0 ) {
+		print "Password updated successfully.\n";
+	} else {
+		print "Password error: " . $rv->error() . "\n";
+	}
+
+	return;
+}
+
+sub run_pwd 
+{
+	my $self = shift;
+	print $self->base() . "\n";
+	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;
+}
+
+sub run_whoami
+{
+	my $self = shift;
+	print $conf->{'binddn'} || 'anonymous bind';
+	print "\n";
+	return;
+}
+
+###############################################################
+#
+# MAIN
+#
+###############################################################
+
+package main;
+use strict;
+use warnings;
+
+$0 = 'shelldap';
+my $VERSION = '0.1';
+
+use Getopt::Long;
+use YAML::Syck;
+use Pod::Usage;
+eval 'use Term::ReadLine::Gnu';
+warn qq{Term::ReadLine::Gnu not installed.
+Continuing, but shelldap is of limited usefulness without it.\n\n} if $@;
+
+# get config - rc file first, command line overrides
+use vars '$conf';
+$conf = load_config() || {};
+Getopt::Long::GetOptions(
+	$conf, 
+	'server=s',
+	'binddn=s',
+	'basedn=s',
+	'cacheage=i',
+	'timeout=i',
+	'tls', 'debug',
+	 help => sub {
+		Pod::Usage::pod2usage(
+			-verbose => 1,
+			-message => "\n$0 command line flags\n" . '-' x 65
+		);
+	}
+);
+
+# defaults
+$conf->{'confpath'} = "$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.
+#
+sub load_config
+{
+	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;
+		}
+	}
+	$confpath or return undef;
+
+	open YAML, $confpath or return undef;
+	do {
+		local $/ = undef;
+		$data = <YAML>;  # slurp!
+	};
+	close YAML;
+
+	eval { $conf = YAML::Syck::Load( $data ) };
+	die "Invalid YAML in ~/.shelldap.rc\n" if $@;
+
+	return $conf;
+}
+
+## EOF
+