#!/usr/bin/env perl

# vim: set nosta noet ts=4 sw=4:

#

# Copyright (c) 2006-2011, 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 - A program for interacting with an LDAP server via a shell-like interface

=head1 DESCRIPTION

Shelldap /LDAP::Shell is 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 [--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

    tls_cacert: /etc/ssl/certs/cacert.pem

    tls_cert:   ~/.ssl/client.cert.pem 

    tls_key:    ~/.ssl/private/client.key.pem

=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

    -H 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

    -D 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

    -b dc=your,o=company

=back

=over 4

=item B< tls>

Enables TLS over what would normally be an insecure connection.

Requires server side support.

=item B<tls_cacert>

Specify CA Certificate to trust.

    --tls_cacert /etc/ssl/certs/cacert.pem

=item B<tls_cert>

The TLS client certificate.

    --tls_cert ~/.ssl/client.cert.pem

=item B<tls_key>

The TLS client key.  Not specifying a key will connect via TLS without

key verification.

    --tls_key ~/.ssl/private/client.key.pem

=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                  change to 'home' basedn

    cd ~                change to the binddn, or basedn if anonymously bound

    cd -                change to previous node

    cd ou=People        change to explicit path below current node

    cd ..               change to parent node

    cd ../../ou=Groups  change to node ou=Groups, which is a sibling

                        to the current node's grandparent

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*

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 entry. The type of object created depends on

the naming attribute given, and defaults to 'organizationalUnit'

if none is given.

Supported naming attributes and corresponding object classes are:

    c	- country

    o	- organization

    ou	- organizationalUnit

    mkdir myNewOrgUnit

    mkdir o=myNewOrg

=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.

=head1 BUGS / LIMITATIONS

There is no support for editing binary data.  If you need to edit base64

stuff, just feed it to the regular ldapmodify/ldapadd/etc tools.

=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 qw/ LDAP_SUCCESS LDAP_SERVER_DOWN /;

use Net::LDAP::Util qw/ canonical_dn ldap_explode_dn /;

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');

		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'};

	# Emit a nicer error message if IO::Socket::SSL is

	# not installed and Net::LDAP decides it is required.

	#

	if ( $conf->{'tls'} || $conf->{'server'} =~ m|ldaps://| ) {

		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 $@;

	}

	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";

	# secure connection options

	#

	if ( $conf->{'tls'} )  {

		if ( $conf->{'tls_key'} ) {

			$ldap->start_tls( 

				verify     => 'require',

				cafile     => $conf->{'tls_cacert'},

				clientcert => $conf->{'tls_cert'},

				clientkey  => $conf->{'tls_key'},

				keydecrypt => sub {

					print "Key Passphrase: "; 

					Term::ReadKey::ReadMode 2;

					chomp(my $secret = <STDIN>);

					Term::ReadKey::ReadMode 0;

					print "\n";

					return $secret;

				});

		}

		else {

			$ldap->start_tls( verify => 'none' );

		}

	}

	# 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 .= " (try the --tls flag?)"

			if $err =~ /confidentiality required/i;

		die "LDAP bind error: $err\n";

	}

	# offer to cache authentication info