#!/usr/bin/perl -w

# Copyright (c) 2003-2010, Larry Lile <lile@FreeBSD.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice unmodified, this list of conditions, and the following
#    disclaimer.
# 2. 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.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR OR 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.

# $Id: led,v 1.111 2010/05/26 20:01:31 lile Exp $

use strict;

use Net::LDAP qw(LDAP_REFERRAL LDAP_OPERATIONS_ERROR);
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw(LDAP_CONTROL_PAGED);
use Net::LDAP::LDIF;
use Getopt::Long qw(:config bundling noignore_case require_order);
use Digest::MD5;
use Fcntl;
use POSIX qw(:termios_h tmpnam strftime);
use URI;

my $RCSID = '$Id: led,v 1.111 2010/05/26 20:01:31 lile Exp $';
my ($VERSION) = $RCSID =~ m/,v (\d+\.[\d\.]+)/ ? $1 : "unknown";

our ($opt_b, $opt_c, $opt_C, $opt_d, $opt_D,
     $opt_e, $opt_E, $opt_f, $opt_h, $opt_i,
     $opt_L, @opt_m, $opt_n, $opt_N, $opt_p,
     $opt_P, $opt_r, $opt_s, $opt_S, $opt_v,
     $opt_V, $opt_w, $opt_W, $opt_x, $opt_X);

our (%ldap_opt, %connection_cache, %config, %maps, $uid, $home,
     $logfile, $signaled);

our $Authen_SASL_Cyrus = 0;

our $ldap_control_paged = LDAP_CONTROL_PAGED;

our @log_header = ( join(' ', $0, @ARGV) );

{
	# Load map definitions
	load_generic_maps();
	load_rfc2307_maps();
	load_iPlanet_maps();

	GetOptions( 'b=s', 'c', 'C=s', 'd', 'D=s',
		    'e=s', 'E', 'f=s', 'h=s', 'i=s',
		    'L+', 'n', 'N', 'p=i', 'P=i',
		    'r=s', 's=s', 'S:s', 'v', 'V',
		    'w=s', 'W', 'x', 'X=s',
		    'm=s' => \@opt_m,
		    'DumpInternalMaps' => \&Dump_Internal_Maps)
	    or usage() and exit 0;

	# Report version number
	version() && exit 0 if ($opt_V);

	# Set default config
	$opt_C = 'default' if ! $opt_C;

	# Load user configs
	load_config("/etc/led.ldif");
	load_user_maps(1);

	# Must have at least a mapname or filter
	usage() and exit 1 if (!@ARGV);

	# Export followed by import would imply a script
	print "Are you sure you don't want -r instead?\n"
	    if ($opt_f and $opt_i);

	# Scripts are a pipeline, we can't import or
	# export at the same time.
	die "You can't use -f or -i with -r.\n"
	    if ($opt_r and ($opt_f or $opt_i));

	# If you are cat'ing you should redirect it
	# not import, export or pipeline -- although
	# cat to a pipeline could be interesting
	die "You can't use -f, -i or -r with -c.\n"
	    if ($opt_c and ($opt_f or $opt_i or $opt_r));

	# If the user has not indicated a preference of
	# editor use vi, but who wouldn't prefer vi?
	my $editor = $ENV{'EDITOR'};
	$editor = "vi" if ! $editor;

	# First bare argument should be the map name (or filter),
	# everything else will be arguments to the map filter
	my $mapname = shift(@ARGV);

	my @args = @ARGV;

	# Load the basic LDAP configuration
	%ldap_opt = get_ldap_config();

	# Check the mapname to see if it matches one of the map aliases.
	foreach my $key (keys %maps)
	{
		next if ! $maps{$key}->exists('alias');
		my $alias = $maps{$key}->get_value('alias');
		if ($mapname =~ m/$alias/i)
		{
			unshift @args, $mapname;
			$mapname = $key;
			last;
		}
	}

	# Map override for host and base
	$ldap_opt{'host'} = $config{$opt_C}->get_value('host')
	    if $config{$opt_C}->exists('host');
	$ldap_opt{'base'} = $config{$opt_C}->get_value('basedn')
	    if $config{$opt_C}->exists('basedn');

	# Command line overrides for server, basedn and port
	$ldap_opt{'host'} = $opt_h if (defined $opt_h);
	$ldap_opt{'base'} = $opt_b if (defined $opt_b);
	$ldap_opt{'port'} = $opt_p if ($opt_p);

	# Default port for LDAP is 389/tcp if nothing else
	# was specified and name services are lacking the
	# entry
	$ldap_opt{'port'} = eval { getservbyname("ldap", "tcp") or "389" }
	    if (! $ldap_opt{'port'});

	# use "map" as an LDAP filter
	if (! $maps{lc $mapname} )
	{
		$maps{$mapname} = Net::LDAP::Entry->new;
		$maps{$mapname}->add(
					base	=> join('?',
							$ldap_opt{'base'},
							$opt_s || "",
							$mapname),
					ldif	=> 1,
					_filter	=> 1,
				);
	}
	else
	{
		$mapname = lc $mapname;
	}

	# Do we have a valid server and basedn config?
	die "Unable to find ldap server name.\n"
	    if ! defined $ldap_opt{'host'};
	die "Unable to find ldap search base dn.\n"
	    if ! defined $ldap_opt{'base'};


	# Override BindDN, auth method and password if specified by the map
	if ($maps{$mapname} and $maps{$mapname}->exists('binddn'))
	{
		$opt_D = $maps{$mapname}->get_value('binddn');
		print "Binding as dn: $opt_D\n";
	}

	# For now overriding the auth method only works for simple
	$opt_x = 1 if $maps{$mapname} and $maps{$mapname}->exists('auth') and
			$maps{$mapname}->get_value('auth') eq 'simple';

	if ($maps{$mapname} and $maps{$mapname}->exists('password'))
	{
		$opt_W = 1;
		undef $opt_w;
	}

	# Load the users LDAP password from the command
	# line or prompt for it if -w or -W respectively
	$opt_w = get_password() if $opt_W;

	# Our default protocol version is 3, unless overridden
	# by the user
	$opt_P = 3 if ! $opt_P;

	# 2 and 3 are the only protocol versions supported
	die "$opt_P is not a valid LDAP protocol version.\n"
	    if $opt_P != 2 and $opt_P != 3;

	# How should we encode dn's, let me count the ways
	die "$opt_e is not a valid encoding.\n"
	    if ($opt_e and ! grep { /^$opt_e$/ } qw(none canonical base64));

	# Search scope
	die "$opt_s is not a valid search scope.\n"
	    if ($opt_s and ! grep { /^$opt_s$/ } qw(base one sub));

	# none is the default encoding for Net::LDAP::LDIF
	$opt_e = "none" if ! $opt_e;

	# Connect and bind to LDAP server
	my $ldap = ldap_open() or die "\n";

	# XXX Get RootDSE, this should probably be done earlier.
	my $dse = $ldap->root_dse();

	# Check for for paged search results
	$ldap_control_paged = undef
	    unless grep ( /^$ldap_control_paged$/, $dse->get_value('supportedControl'));

	warn "supportedControl: ", LDAP_CONTROL_PAGED, " (LDAP_CONTROL_PAGED) found\n"
	    if $ldap_control_paged and $opt_d;

	# Set maxPageSize to unlimited if the value wasn't initialized
	# or was set to a text value
	$config{$opt_C}->get_value('maxpagesize') = 0
	    if ! defined $config{$opt_C}->get_value('maxpagesize');
	$config{$opt_C}->get_value('maxpagesize') = 0
	    if ! ($config{$opt_C}->get_value('maxpagesize') =~ m/[0-9]+/);

	# If the map is a shortcut to a filter then force LDIF mode
	$opt_L = 1 if $maps{$mapname} and $maps{$mapname}->exists('ldif');

	# m only works with maps, not in LDIF mode
	die "-m does not work in LDIF mode\n"
	    if ($opt_L and @opt_m);

	# Build a hash of attribute names to replacement
	# values, to allow user to fullfill required attribute
	# constraints
	my %attr_map;
	foreach (@opt_m)
	{
		next if undef;
		my ($attr, $val) = split(/=/, $_);
		$attr_map{lc $attr} = $val;
	}

	# Pull the data from the LDAP server
	my @search = get_entries(
						$ldap,
						$mapname,
						@args,
					);

	my $sleep;
	if (!$opt_L and !$maps{$mapname}->exists('ldif'))
	{
		# XXX To check for required structure in the DIT
		# XXX start with ourselves and work back through our
		# XXX parent nodes, if any.
		my $parent = $mapname;
		$parent = $maps{$parent}->get_value('parent')
		    while ($maps{$parent}->exists('parent'));

		if (! get_structural_entry($ldap, $parent, @args))
		{
			my $dn = build_dn($parent, undef, @args);

			warn "Updates to ", join(" ", $mapname, @args),
			    " will be discarded, the base dn: ", $dn,
				" does not exist.\n";
			$opt_n = 1;
			$sleep = 5;
		}
	}

	# Oops, nothing was put into the map, edit anyway?
	if (! @search and ! $opt_c)
	{
		warn "\n" if $sleep;

		if (! $opt_E)
		{
			$! = 2;
			die "Nothing found in map ",
			    join(" ", $mapname, @args),
			    ", use -E to edit anyway.\n";
		}
		else
		{
			warn join(" ", $mapname, @args),
			    " is empty, editing anyway.\n";
		}
		$sleep = 5;
	}

	sleep($sleep) if $sleep;

	my ($writer, $reader, $tmpfile, $pid);

	# Open our ouput filehandle WRITER based on what the
	# user wants.
	if ($opt_c)
	{
		open WRITER, ">&STDOUT" or die;
		$writer = \*WRITER;
		select((select(WRITER), $| = 1)[0]); # Autoflush WRITER
	}
	elsif ($opt_f)
	{
		open WRITER, ">$opt_f" or die;
		$writer = \*WRITER;
		select((select(WRITER), $| = 1)[0]); # Autoflush WRITER
	}
	elsif ($opt_r)
	{
		# -r is a bit different, we have to open $opt_r for
		# output on WRITER, but since were going to use open2
		# we will get READER as well.
		use FileHandle;
		use IPC::Open2;

		eval { open2(*READER, *WRITER, $opt_r); };
		die "$opt_r: $!\n$@\n" if $@ and $@ =~ /^open[23]/;

		FORK: {
			if ($pid = fork)
			{
				# Parent fork
				close READER;
				$writer = \*WRITER;
				# Autoflush WRITER
				select((select(*WRITER), $| = 1)[0]);
			}
			elsif (defined $pid)
			{
				# Child fork
				close WRITER;
				$reader = \*READER;
			}
			elsif ($! =~/No more process/)
			{
				# Temporary for failure, should
				# be recoverable
				sleep 5;
				warn "fork failed trying again: $!\n";
				redo FORK;
			}
			else
			{
				# Complete fork failure, I could
				# just die!
				die "Unable to fork: $!\n";
			}
		}
	}
	else
	{
		do { $tmpfile = tmpnam() }
		    until sysopen(WRITER, $tmpfile, O_RDWR|O_CREAT|O_EXCL);
		# Install an at_exit handler to remove the tempfile
		# even if we get killed unexpectedly
		END {
			if (defined $tmpfile)
			{
				unlink($tmpfile) or
				    die "Couldn't unlink $tmpfile: $!.\n"
			}
		}
		$writer = \*WRITER;
		select((select(WRITER), $| = 1)[0]); # Autoflush WRITER
	}

	# If we are not importing a file or the child of a led pipe
	# then we need to start producing the required output.
	if (! $opt_i and !($opt_r and !$pid))
	{

		my $ldif = Net::LDAP::LDIF->new($writer,
						"w",
						encode => $opt_e,
						onerror => 'die',
						) if $opt_L;

		# XXX Write all the entries
		($opt_L ?
		    $ldif->write_entry($_) :
		    write_entry($writer, $_, $mapname))
			foreach (@search);

		close WRITER;

		# All done if our output is STDOUT or a file export.
		exit 0 if $opt_c or $opt_f;

		# Wait for the fat lady to sing if we are the parent
		# of a led pipe
		if ($opt_r and $pid)
		{
			close WRITER;

			# Wait for our child to make the
			# updates to LDAP
			waitpid($pid, 0);

			# Shut down our LDAP connections
			ldap_close();

			# Exit with our child's exit code
			exit $?;
		}


		# and we are not executing a pipeline
		if (! $opt_r)
		{
			# We must be doing an interactive edit,
			# checksum the file
			my $cksum_a = file_checksum($tmpfile);

			# Launch the editor
			!system("$editor $tmpfile") or
			    die "editor failed.\n";

			# Checksum the file again.
			my $cksum_b = file_checksum($tmpfile);

			# Give up now, if no changes were made.
			exit 0 if ($cksum_a eq $cksum_b);
		}
	}

	# Just exit on read only maps
	exit 0 if $maps{$mapname}->exists('readonly');

	# We are importing from a file, so set our source file name
	$tmpfile = $opt_i if $opt_i;

	# Unless we are the child of a led pipe, we need to open the
	# input file on READER.  $tmpfile will be set correctly by now.
	if (! $opt_r)
	{
		open READER, "<$tmpfile" or die;
		$reader = \*READER;
	}

	my @file;

	# using LDIF mode
	if ($opt_L)
	{
		my $ldif = Net::LDAP::LDIF->new(
						$reader,
						"r",
						encode => $opt_e,
						onerror => 'die',
						);
		while (not $ldif->eof())
		{
			my $entry = $ldif->read_entry()
			    or next;

			if ($ldif->error() )
			{
				warn "LDIF error: ",
				    $ldif->error(), "\n";
				warn "     lines: ",
				    $ldif->error_lines(), "\n";
				die "Giving up on LDIF error.\n";
			}
			push @file, $entry;
		}
	}
	else
	{
		while(<$reader>)
		{
			# Skip any blank lines
			next if $_ =~ m/^\s*$/;
			my $entry = parse_line($mapname, $_, @args);
			push @file, $entry;
		}
	}

	close READER;

	# Now we have two neat bundles of data, the original array of ldap
	# entries and our new array of entries.  Now go and resolve the
	# differences obeying -n (do nothing) and -L (LDIF mode)
	my ($changes, $failures) = update_entries($ldap, $mapname,
		\@search, \@file, @args);

	warn "\nWarning, the ldap server rejected $failures of $changes ",
	     "changes.\n" if ($failures);

	# Unbind from the LDAP servers
	ldap_close();

	exit ($failures ? 2 : 0);
}

sub version
{
	warn "LED version $VERSION\n";
}

sub usage
{
	print "
Usage: led [switches] map|filter [arguments] [attr [...]]

 Map options:
  -c		   dump the specified map to stdout
  -C config	   load the named config instead of the default
  -e encode	   change the LDIF encoding (none, canonical, base64)
  -E		   edit map even if empty
  -f file	   dump the specified map to file
  -i file	   import file to the specified map
  -L		   use LDIF
  -m attr=value    force the value of attr to be value (can be repeated)
  -n		   show what would be done but don't make changes
  -N		   do not chase update referrals
  -r command	   execute command on specified map
  -V		   print led version number

 LDAP options:
  -b basedn	   base dn for searches
  -D binddn	   bind DN
  -h host	   LDAP server (implies -N)
  -p port	   port on LDAP server
  -P 2|3	   procotol version (default: 3)
  -s scope	   search scope: base, one, sub (default: sub)
  -S [attr[,...]]  sort the results by attr (default: dn)
  -v		   run in verbose mode
  -w password	   bind password (for simple authentication)
  -W		   prompt for bind password";
	print "
  -x		   use simple authentication (default: SASL/GSSAPI)
  -X authzid	   SASL authorization identity (\"dn:<dn>\" or \"u:<user>\")"
	if $Authen_SASL_Cyrus;

	print "\n\n";

	my @column = (
			length "map",
			length "arguments",
			length "description"
		     );
	foreach (keys %maps)
	{
		next if $_ =~ /^_/;
		$column[0] = $column[0] > length $_ ?
				$column[0] : length $_;
		$column[1] = $column[1] > length $maps{$_}->get_value('args') ?
				$column[1] : length $maps{$_}->get_value('args')
					if $maps{$_}->exists('args');
		$column[2] = $column[2] > length $maps{$_}->get_value('usage') ?
				$column[2] : length $maps{$_}->get_value('usage')
					if $maps{$_}->exists('usage');
	}

	printf "  %-*s  %-*s  %s\n",
	    $column[0], "map",
	    $column[1], "arguments",
	    "description";
	printf "  %-*s  %-*s  %s\n",
	    $column[0], "-"x$column[0],
	    $column[1], "-"x$column[1],
	    "-"x$column[2];
	foreach (sort keys %maps)
	{
		next if $_ =~ /^_/;
		printf "  %-*s  %-*s  %s\n",
		    $column[0], $_,
		    $column[1], eval { $maps{$_}->get_value('args') or "" },
		    eval { $maps{$_}->get_value('usage') or "" };
	}
	return 1;
}

sub file_checksum
{
	my $file = shift;
	my $return;
	my $ctx = Digest::MD5->new;

	# Open the given file
	open FILE, "<$file" or
	    die "Unable to open $file for reading.\n";

	# Compute the MD5 digest
	$ctx->addfile(*FILE);
	$return = $ctx->hexdigest;

	# Done with the file
	close FILE;

	# return the MD5 digest for the file
	return $return;
}

sub parse_line
{
	my $map  = shift;	# Name of map for maps hash
	my $line = shift;	# Line to be parsed
	my @args = @_;		# reference to args for ldap filter / dn

	my (@attrs, @splits, @matches);

	# Reduce the line noise
	@attrs = $maps{$map}->get_value('attrs')
	    if $maps{$map}->exists('attrs');
	@splits= $maps{$map}->get_value('splits')
	    if $maps{$map}->exists('splits');
	@matches= $maps{$map}->get_value('matches')
	    if $maps{$map}->exists('matches');

	# Index to the regex used for splitting each element
	my $split = 0;
	my $attr = 0;
	my %values;

	my $entry = Net::LDAP::Entry->new;

	chomp($line);
	my $orig = $line; # Save a copy of the line

	# Disasemble the entire line using the regex's from
	# the splits array, key them into the hash using
	# the keys from the attrs array
	while (defined $line)
	{
		# Chop up the line and put it in the hash
		(my $this, $line) = split($splits[$split], $line, 2);
		$this =~ s/\t+/ /g if defined $this;

		$entry->add( lc $attrs[$attr] => $this )
		    if defined $this and !($this =~ /^\s*$/);

		# Push the array indexes
		$split++ if ($splits[$split + 1]);
		$attr++  if ($attrs[$attr + 1]);

		if (@matches and $split == $#splits)
		{
			my $match = 0;
			while ($line)
			{
				if (($line =~ s/$matches[$match]//))
				{
					$entry->add (lc $attrs[$attr] => $1);
				}
				else
				{
					$match++ if $matches[$match + 1];
					$attr++  if ($attrs[$attr + 1]);
				}
			}
		}
	}

	# Set dn for new entry
	$entry->dn(build_dn($map, $entry, @args));

	# Check for required attributes, all bets are off
	# when using LDIF mode because this code is never reached
	die "Failed to properly parse line, $@:\n\t$orig\n"
	    if !check_required_attributes($map, $entry);

	$entry;
}

sub build_dn
{
	my $map = shift;
	my $entry = shift;
	my @args = @_;

	my $dn;

	if ($entry)
	{
		# The key values are contained within the LDAP
		# entry, so compose the key rdn.
		my @key;
		foreach (split('\+', $maps{$map}->get_value('key')))
		{
			# XXX An element of * is invalid in a dn, so 
			# XXX replace it with a /, the ldap server
			# XXX should fix up the entry
			my $val = $entry->get_value(lc $_);
			$val = '/' if $val eq '*';
			push @key, $_."=".$val;
		}
		$dn = join('+', @key);
	}

	die "base (", $maps{$map}->get_value('base'),") specified with empty basedn"
	    if ! $maps{$map}->exists('base');

	# Base is specified as basedn?scope?filter.
	my ($rdn, $scope, $filter) = split(/\?/, $maps{$map}->get_value('base'));

	# Check for base_* overrides
	my ($brdn, $bscope, $bfilter) = split(/\?/, $config{$opt_C}->get_value("base_$map"))
	    if $config{$opt_C}->exists("base_$map");

	$rdn = $brdn if $brdn;
	$scope = $bscope if $bscope;
	$filter = $bfilter if $bfilter;

	# If we've composed a key and have a rdn from base
	# then join them together, this is still only a rdn.
	if ($dn and $rdn)
	{
		$dn = join(',', $dn, $rdn);
	}
	# If we don't have a composed key then the rdn is
	# just the rdn.
	elsif ($rdn)
	{
		$dn = $rdn;
	}
	# What, no dn, this is just bad.
	else
	{
		$dn = $ldap_opt{'base'};
	}

	# If the current rdn ends with a , it should have
	# the systems basedn appended, otherwise its ready.
	$dn .= $ldap_opt{'base'} if $dn =~ m/,\s*$/;

	# Expand any variables or arguments
	$dn = sprintf($dn, @args) if @args && $dn =~ m/%s/;
	$dn = expand_variables($dn);
	$dn = normalize_dnstring($dn);

	# For the one time when you really, really, don't want a basedn.
	$dn = "" if $rdn and $rdn eq ".";

	return wantarray ? ($dn, $scope, $filter) : $dn;
}

sub normalize_dn
{
	my $entry = shift
	    or return;

	normalize_dnstring($entry->dn);
}

sub normalize_dnstring
{
	my $dn = shift
	    or return;
	
	return if ! $dn;

	$dn = lc $dn;
	$dn =~ s/\s*,\s*/,/g;

	$dn;
}

sub unique_attributes
{
	my @entries = @_;
	my @attrs;

	return if ! @entries;

	defined $_ and push @attrs, $_->attributes
	    foreach (@entries);

	my %attrs = map { lc $_ => $_ } @attrs;

	keys %attrs;
}

sub compare_attribute
{
	my $source = shift;
	my $target = shift;
	my $attr   = shift;

	my %a = map { lc $_ => $_ } $source->get_value($attr);
	my %b = map { lc $_ => $_ } $target->get_value($attr);

	join(' $ ', sort keys %b) cmp join(' $ ', sort keys %a);
}

sub update_entries
{
	my $ldap    = shift;	# LDAP connection
	my $map     = shift;	# Map name from maps hash
	my $orig    = shift;	# Ref for results from LDAP search
	my $file    = shift;	# Ref for file data
	my @args    = @_;
	my $changes = 0;
	my $failures= 0;

	my @orig = @$orig if $orig;
	my @file = @$file if $file;

	my $log = log_open($map);

	my %attr_map = map { split(/=/, lc $_, 2) } @opt_m;

	my $lut = { map { normalize_dn($_) => $_ } @file };

	# Roll through all of the entries from the ldap search
	# if we can find no file entry for the ldap entry we
	# should delete the ldap entry, if we find one we must
	# check for changes to the entry
	foreach my $source (@orig)
	{
		next if ! $source;

		my $result;

		my $key = lc $source->dn;
		$key =~ s/\s*,\s*/,/g;

		my $target = $lut->{$key};

		my @attrs = $opt_L ?
				unique_attributes($source, $target) :
				unique($maps{$map}->get_value('attrs'));

		if ($target)
		# Check to see if the entry has been modified.
		{
			my @update;
			foreach my $attr (@attrs)
			{
				# Mapped attributes are bogus, skip them
				next if defined $attr_map{$attr};

				# Well, if they don't match we should
				# update LDAP

				if (compare_attribute($source, $target, $attr))
				{
					print "Modifying $attr in dn: ",
					    $source->dn, "\n";
					print_attr('-', $attr,
					    join(' $ ', sort $source->get_value($attr)));
					print_attr('+', $attr,
					    join(' $ ', sort $target->get_value($attr)));

					push @update, $attr => [
					    $target->get_value(lc $attr)
								];
					# Okay, I'm poking around in
					# Net::LDAP::Entry's namespace
					# here - but I want a pristine copy of
					# the attribute we are modifying
					$source->{_attrs}{$attr} = [
						@{$source->{attrs}{$attr}}
								]
					    if $source->{attrs}{$attr};
				}

			}
			if (@update)
			{
				# Were all done with this file entry, update ldap
				# and dump the entry from the hash
				$source->replace(@update);
				$changes++;
				my $result = commit_update($ldap, $source, $log);
				$failures++ if ! $opt_n and $result->code;
			}
			delete $lut->{$key};
		}
		else
		# The entry been deleted.
		{
			# Shadow entries must be deleted using the primary map
			print "dn: ", $source->dn, " must be deleted ",
			    "using the ",$maps{$map}->get_value('shadow'),
			    " map.\n" and next if ($maps{$map}->exists('shadow'));

			# Yes, mark the entry for deletion
			print "Deleting dn: ", $source->dn, "\n";
			foreach my $attr (sort @attrs)
			{
				print_attr('-', $attr,
				    join(' $ ',
					sort($source->get_value($attr))
					));
			}
			$source->delete();
			$changes++;
			my $result = commit_update($ldap, $source, $log);
			$failures++ if ! $opt_n and $result->code;
		}
	}

	# Add or removed structural entries as needed for maps that
	# have parent maps.
	if ($maps{$map}->exists('parent') and (!@orig or !@file))
	{
		# Check for existing structural dn
		my $entry = get_structural_entry(
						$ldap,
						$maps{$map}->get_value('parent'),
				 		@args
						);

		# Creating a new map that needs a parent
		if (!@orig and @file and !$entry)
		{
			my $entry = create_structural_entry($ldap, $map, @args);
			print "Adding structural dn: ", $entry->dn, "\n";
			foreach my $attr (sort $entry->attributes) {
				print_attr('+', $attr,
				    join(' $ ', sort($entry->get_value($attr))));
			}
			$changes++;
			my $result = commit_update($ldap, $entry, $log);
			$failures++ if ! $opt_n and $result->code;
		}
		# Deleted a map that had a parent
		elsif (@orig and !@file and $entry)
		{
			print "Deleting structural dn: ", $entry->dn, "\n";
			foreach my $attr (sort $entry->attributes)
			{
				print_attr('-', $attr,
				    join(' $ ',
					sort($entry->get_value($attr))
					));
			}
			$entry->delete();
			$changes++;
			my $result = commit_update($ldap, $entry, $log);
			$failures++ if ! $opt_n and $result->code;
		}
	}

	# All of the file entries we have left were neither
	# deletions or modifications, therefore they must be
	# additions
	foreach my $key (keys %$lut)
	{
		# Just in case and undef slips through
		next if ! $key;

		my $target = $lut->{$key};

		# Shadow entries must be added using the primary map
		print "dn: ", $target->dn, " must be added ",
		    "using the ",$maps{$map}->get_value('shadow'),
		    " map.\n" and next if ($maps{$map}->exists('shadow'));

		# Add all of the attributes from the schema field
		# to the attributes hash
		my %attrs;
		if ($maps{$map}->exists('schema') and ! $opt_L)
		{
		    foreach my $attr ($maps{$map}->get_value('schema'))
		    {
			foreach my $obj ($maps{$map}->get_value($attr))
			{
			    $target->add(
					    lc $attr => [
						expand_variables(
							$obj,
							\@args,
							$target
								)
							]
					);
			}
		    }
		}

		print "Adding entry dn: ", $target->dn, "\n";
		foreach my $attr (sort $target->attributes)
		{
			print_attr('+', $attr,
			    join(' $ ', sort($target->get_value($attr))));
		}

		$changes++;
		my $result = commit_update($ldap, $target, $log);
		$failures++ if ! $opt_n and $result->code;
	}

	log_close($log, $changes, $failures);

	return ($changes, $failures);
}

sub commit_update
{
	my $ldap   = shift;	# Connection to ldap server
	my $entry  = shift;	# LDAP entry we are working
	my $log    = shift;	# Log file handle

	die "Unknown changetype: ", lc $entry->changetype, "\n"
	    if $entry->changetype ne "delete" and
		$entry->changetype ne "modify" and
		$entry->changetype ne "add";

	log_change($log, $entry);

	my $result;

	if (! $opt_n)
	{
		$result = $entry->update($ldap);

		# XXX Check for I/O Error on update, reconnect and
		# XXX retry if possible.  This could be much more sophisticated.
		$ldap = ldap_open($ldap) and $result = $entry->update($ldap)
		    if $result->code == LDAP_OPERATIONS_ERROR and
			$result->error =~ m!I/O Error!i;

		# Check for referral on update and chase if needed.
		$result = chase_referrals($result, $entry)
		    if $result->code == LDAP_REFERRAL;

		$result->code and
		    warn "failed to ", lc $entry->changetype,
			" entry: ", $result->error;
		log_result($log, $result);
	}
	$result;
}

sub get_structural_entry
{
	my $ldap   = shift;	# Connection to ldap server
	my $map    = shift;	# Mapname for maps hash
	my @args   = @_;	# Arguments for ldap filter

	my $dn = build_dn($map, undef, @args);

	my $result = $ldap->search(
				    base        => $dn,
				    filter      => '(objectclass=*)',
				    scope       => 'base',
				);

	return if $result->code or $result->count == 0;

	$result->shift_entry;
}

sub create_structural_entry
{
	my $ldap   = shift;	# Connection to ldap server
	my $map    = shift;	# Mapname for maps hash
	my @args   = @_;	# Arguments for ldap filter

	my $parent = $maps{$map}->get_value('parent');

	my $entry = Net::LDAP::Entry->new;
	$entry->dn(build_dn($parent, undef, @args));

	# Add all of the attributes from the schema field
	# to the attributes hash
	my %attrs;
	if ($maps{$parent}->exists('schema'))
	{
		foreach my $attr ($maps{$parent}->get_value('schema'))
		{
			foreach my $obj ($maps{$parent}->get_value($attr))
			{
				$entry->add(
					lc $attr => [
					    expand_variables(
							$obj,
							\@args,
						    )
						]
					);
			}
		}
	}
	$entry;
}

sub get_entries
{
	my $ldap   = shift;	# Connection to ldap server
	my $map    = shift;	# Mapname for maps hash
	my @args   = @_;	# Arguments for ldap filter
	my @rc;

	warn "\nget_entries($ldap, $map",
	    (@args ? join(", ", "", @args) : ""),
		  ")\n"
		if $opt_d;

	# Check for an entry form $map in the maps hash
	die "No map defined for $map.\n" if (! defined %{$maps{$map}});

	# XXX Do this once to get the filter, so we can determine
	# XXX how many arguments are needed
	my ($dn, $scope, $filter) = build_dn($map, undef, ());

	my $num_args = grep (/%{1}\d*\.?\d*[[:alpha:]]+/,$filter);

	die "$map requires ",
	    ($num_args ? $num_args : "no"),
	    " argument",
	    ($num_args > 1 ? "s" : ""),
	    ".\n"
		if scalar @args < $num_args;

	# XXX Now do it for real, passing the arguments
	($dn, $scope, $filter) = build_dn($map, undef, @args);

	# Reduce line noise, so that we aren't casting the
	# attributes array constantly
	my @attrs = $maps{$map}->exists('attrs') ?
		    $maps{$map}->get_value('attrs') : undef;

	my @search_attrs = unique(
				    '*',
				    (
					(@args - $num_args) > 0 ?
					splice @args,
					       $num_args,
					       @args - $num_args : '*'
				    ),
				    (scalar @attrs ? @attrs : '*')
				);

	# Fill in the arguments for the filter
	$filter = sprintf($filter, @args);
	$filter = expand_variables($filter);

	# Expand any variables or arguments
	$dn = sprintf($dn, @args) if $dn =~ m/%s/;
	$dn = expand_variables($dn);

	# The default search scope is sub,
	# however allow the user to override the scope
	$scope = 'sub' unless $scope;
	$scope = $opt_s if $opt_s;

	# Check for existing structural dn
	return if ($maps{$map}->exists('parent') &&
		    !get_structural_entry(
					    $ldap,
					    $maps{$map}->get_value('parent'),
			 		    @args));


	# Set up any LDAP Controls for our query
	my @control;

	# LDAP_CONTROL_PAGED
	my ($page, $cookie);
	if ($ldap_control_paged)
	{
		# XXX Reasonable default, should query server instead
		my $size;
		if ($config{$opt_C}->exists('maxpagesize'))
		{
			$size = $config{$opt_C}->get_value('maxpagesize');
			$size = 0 if ! defined $size;
			$size = 0 if ! ($size =~ m/[0-9]+/);
		}
		if ($config{$opt_C}->get_value('maxpagesize') > 0)
		{
			$page = Net::LDAP::Control::Paged->new(size => $config{$opt_C}->get_value('maxpagesize'));
			push @control, $page;
			warn "Control $page size => ", $config{$opt_C}->get_value('maxpagesize'), "\n"
			    if $opt_d or $opt_v;
		} else {
			warn "LDAP_CONTROL_PAGED disabled by configuration.\n"
			    if $opt_v or $opt_d;
			$ldap_control_paged = undef;
		}
	}

	my @search = (
			base    => $dn,
			filter  => $filter,
			scope   => $scope,
			attrs   => \@search_attrs,
			control => \@control,
		    );

	my $once = 1;

	while (1)
	{
		# Search ldap for the specified entries
		my $result = $ldap->search( @search );

		# Reduce the debug spam, only print this message once
		warn "\nbase: ", ($dn ? $dn : ""),
		     "\nfilter: $filter\nscope: $scope\nattrs: " .
		     join(", ", sort @search_attrs) . "\n\n"
			if $result->code or ($opt_v and $once);
		$once = undef;

		$result->code && die "Unable to load $map map: ", $result->error, "\n";

		warn "get_entries(): \$result->count == ", $result->count, "\n"
		    if $opt_d;

		foreach my $entry ($result->entries)
		{
			# Check for required attributes, all bets are off
			# when using LDIF mode
			warn "Dropping dn: ", $entry->dn, ", ", $@, ".\n" and next
			    if (!check_required_attributes($map, $entry));
			push @rc, $entry;
		}

		# Manage the paged control cookie
		if ($ldap_control_paged)
		{
			# Get cookie from paged control
			my ($mesg) = $result->control( LDAP_CONTROL_PAGED ) or last;
			$cookie = $mesg->cookie or last;

			$page->cookie($cookie);
		} else {
			# Not paged, we should have all our results.
			last;
		}
	}

	if ($ldap_control_paged and $cookie)
	{
		$page->cookie($cookie);
		$page->size(0);
		$ldap->search( @search );
	}

	push @log_header, "base: " . ($dn ? $dn : "");
	push @log_header, "filter: $filter";
	push @log_header, "scope: $scope";
	push @log_header, "attrs: " . join(", ", sort @search_attrs);

	warn "get_entries(): \@rc == ", scalar @rc, "\n"
	    if $opt_d;

	# Get attribute sort list
	$opt_S = $maps{$map}->get_value('key')
	    if ! $opt_S && $maps{$map}->exists('key');
	my @sort_attrs = split(/\s*,\s*/, $opt_S) if $opt_S;

	# Return the result set if no sorting is required
	# or there is only 1 entry
	return @rc unless @rc > 1 and $opt_S;

	# Shamelessly stolen and modified from Net::LDAP::Search::sorted
	# since I doubt I could produce a better transform than Graham
	map { $_->[0] }
	  sort {
	      my $v;
	      my $i = 2;
	      foreach my $attr (@sort_attrs) {
		$v = ($a->[$i] ||= join("\000", @{$a->[0]->get_value($attr, asref => 1) || []}))
		      cmp
		     ($b->[$i] ||= join("\000", @{$b->[0]->get_value($attr, asref => 1) || []}))
		  and last;
		$i++;
	      }

	      $v ||= ($a->[1] ||= Net::LDAP::Util::canonical_dn( $a->[0]->dn, "reverse" => 1, separator => "\0"))
			cmp
		     ($b->[1] ||= Net::LDAP::Util::canonical_dn( $b->[0]->dn, "reverse" => 1, separator => "\0"));
	    }
	    map { [ $_ ] } @rc
}

sub write_entry
{
	my $fh     = shift;	# Handle to the output descriptor
	my $entry  = shift;	# LDAP entry we are working
	my $map    = shift;	# Mapname for maps hash

	warn "\nwrite_entry($fh, ", ($entry ? $entry : "undef"), ", $map)\n"
	    if $opt_d;

	my $rc;

	return if !$entry;

	my %attr_map = map { split(/=/, $_, 2) } @opt_m;

	# Check for an entry form $map in the maps hash
	die "No map defined for $map.\n" if (! defined %{$maps{$map}});

	# Check for required attributes, all bets are off
	# when using LDIF mode
	warn "Dropping dn: ", $entry->dn, ", ", $@, ".\n" and return
	    if (!check_required_attributes($map, $entry));

	my ($join, $stash);

	if (! defined $maps{$map}->{_attr_count})
	{
		$stash->{attr_count}->{lc $_}++
		    foreach ($maps{$map}->get_value('attrs'));
	}

	my @joins = $maps{$map}->get_value('joins');
	my @attrs = $maps{$map}->get_value('attrs');

	my $val;
	my $attr = lc shift @attrs;

	while ($attr)
	{
		$stash->{$attr} = 
		    # Override values for mapped attributes
		    defined $attr_map{$attr} ?
			[ $attr_map{$attr} ] :
			[ $entry->get_value($attr) ]
		    unless scalar $stash->{$attr};

		# Try to handle the '*' '/' automount map
		# situation elegantly better known as the
		# automounter hack, ewww.  Try to be very
		# liberal in what we accept.
		pop @{$stash->{$attr}}
		    if @{$stash->{$attr}} == 2 and
			(($stash->{$attr}[0] eq '*' and
			  $stash->{$attr}[1] eq '/') or
			 ($stash->{$attr}[0] eq '/' and
			  $stash->{$attr}[1] eq '*'));

		if ($stash->{attr_count}->{$attr}-- == 1 && 
		    @{$stash->{$attr}} > 1)
		{
			my $peek = shift @joins || $join;
			$val = join($peek, sort @{$stash->{$attr}});
			undef $stash->{$attr};
		}
		else
		{
			$val = shift @{$stash->{$attr}};
		}

		$rc = $rc ? join(
					$join ? $join : "",
					$rc,
					defined $val ? $val : "",
					)
				: $val ? $val : "";

		$attr = lc shift @attrs;
		$join = shift @joins if @joins;
	}
	print $fh $rc, "\n";
}

sub check_required_attributes
{
	my $map = shift;
	my $entry = shift;

	# Build a lookup hash for mapped attributes
	my %attr_map = map { split(/=/, lc $_, 2) } @opt_m;

	# Grab the list of required attributes, return if
	# nothing is required.
	my @attrs = $maps{$map}->get_value('required')
	    or return 1;

	# Special case for required attribute of 'all', in
	# that case grab all the maps attributes.
	@attrs = unique($maps{$map}->get_value('attrs'))
	    if (lc $maps{$map}->get_value('required') eq "all");

	foreach (@attrs)
	{
		# Don't check mapped attributes, they're bogus.
		if (!$attr_map{lc $_} and !$entry->exists($_))
		{
			$@ = "missing required attribute $_";
			return 0;
		}
	}
	return 1;
}

sub chase_referrals
{
	my $result = shift;
	my $entry  = shift;

	return $result if $result->code != LDAP_REFERRAL;

	print "\nReferral received: ",
	    join(" ", $result->referrals, '') if $opt_v;

	return $result
	    if !(grep { $_ eq $entry->changetype } qw(add modify delete)) or
		$opt_N;

	foreach ($result->referrals)
	{
		print "\nChasing referral: $_\n" if $opt_v;
		my $ldap;
		my $uri = URI->new($_);
		if (! $connection_cache{$uri->host_port})
		{
			warn "\nAttempting to contact ",
			    $uri->host_port, "\n" if $opt_v;

			($ldap, my $result) = ldap_connect($uri->host,
							   $uri->port);
			warn $@ and next if ! $ldap;

			if ($result and $result->code)
			{
				warn "Failed to bind ", $uri->host_port, ": ",
				    $result->error, "\n";
				next;
			}
			$connection_cache{($uri->host_port)} = $ldap;
		}
		$ldap = $connection_cache{($uri->host_port)};

		my $dn = ($uri->dn ? $uri->dn : $entry->dn);
		print "dn modified: ", $entry->dn, " => $dn\n"
		    if ($dn ne $entry->dn) and $opt_v;

		if ($entry->changetype eq "delete")
		{
			return $ldap->delete( $dn );
		}
		elsif ($entry->changetype eq "modify")
		{
			return $ldap->modify( $dn, $entry->changes );
		}
		elsif ($entry->changetype eq "add")
		{
			$entry->dn($dn);
			return $entry->update($ldap);
		}
	}
	return $result;
}

sub ldap_open
{
	my $ldap = shift;

	my $result;

	my @servers = split(/\s+/, $ldap_opt{'host'});

	if ($ldap)
	{
		warn "\nConnection to ", $ldap->{net_ldap_host},
		    " broken, attempting to reconnect.\n"
			if $opt_v;

		# XXX Try to close the socket as best we can.
		close $ldap->{net_ldap_socket};

		foreach my $server (split(/\s+/, $ldap_opt{'host'}))
		{
			($server, my $port) = split(/:/, $server, 2);
			$port = $ldap_opt{'port'} if ! $port;
			last if lc $server eq lc $ldap->{net_ldap_host};
			push @servers, shift @servers;
		}
	}

	foreach my $server (@servers)
	{
		($server, my $port) = split(/:/, $server, 2);
		$port = $ldap_opt{'port'} if ! $port;

		warn "\nAttempting to contact $server\n" if $opt_v;

		($ldap, $result) = ldap_connect($server, $port);
		warn $@ and next if ! $ldap;

		if ($result and $result->code)
		{
			warn "Failed to bind $server: ", $result->error, "\n";
			next;
		}
		elsif ($result)
		{
			last;
		}
	}

	die "\n" if ! $ldap or ! $result;

	$connection_cache{"_"} = $ldap;

	$ldap;
}

sub ldap_close
{
	foreach my $server (keys %connection_cache)
	{
		# Catch sigpipe on dead connections
		local $SIG{PIPE} = 'IGNORE';
		$connection_cache{$server}->unbind();
	}
}

sub log_open
{
	my $map = shift;
	my $logdir = $config{$opt_C}->get_value('logdir');

	if (! -d "$logdir" )
	{
		warn "Unable to log changes, $logdir does not exist.\n\n"
		    if $opt_v;
		return;
	}
	if (! -w "$logdir" )
	{
		warn "Unable to log changes, $logdir is not writable.\n\n"
		    if $opt_v;
		return;
	}
	if (! -x "$logdir" )
	{
		warn "Unable to log changes, $logdir is not executable.\n\n"
		    if $opt_v;
		return;
	}

	# No, I should build a tempfile for the editor
	# Keep trying temp file names, until we get one
	{
		my $pass = 0;
		do {
			$logfile = "$logdir/";
			$logfile .= "$map." if ! $maps{$map}->exists('_filter');
			$logfile .= strftime("%G_%m_%d_%H%M%S", localtime($^T));
			$logfile .= ".$pass" if $pass++;
			$logfile .= ".ldif";
			if ($pass > 99)
			{
				warn "Unable to log changes, ",
				     "number of retries exceeded ",
				     "while creating logfile\n\n";
				return;
			};
		} until sysopen(FILE, $logfile, O_RDWR|O_CREAT|O_EXCL);
	}

	warn "log file: $logfile\n\n" if $opt_v;

	select((select(FILE), $| = 1)[0]); # Autoflush FILE

	$SIG{INT}  = sub { $signaled = shift and exit 1 };
	$SIG{QUIT} = sub { $signaled = shift and exit 1 };

	END {
		if (defined $logfile)
		{
			if ($signaled)
			{
				print FILE "\n#\n# Killed by SIG",
					   $signaled, "\n#\n";
				log_close(\*FILE, 0, 0);
			}
			unlink($logfile) if -z $logfile;
		}
	}

	return *FILE;
}

sub log_close
{
	my $fh = shift;
	my $changes = shift;
	my $failures = shift;

	return if ! $fh;

	print $fh "\n# $failures of $changes updates failed\n"
	    if $failures;

	print $fh "\n# No updates made, -n was invoked.\n"
	    if $changes and $opt_n;

	close $fh or warn "Error closing log file: $!\n";

	log_rotate();
}

sub log_change
{
	my $fh = shift;
	my $entry = shift;

	return if !$fh;

	if (@log_header)
	{
		print $fh "#\n# ", $log_header[0], "\n#\n";
		print $fh "# ", join("\n# ", @log_header[1 .. $#log_header], "\n#\n");
		@log_header = ();
	}

	if ($entry->changetype eq "delete")
	{
		print $fh "\ndn: ", $entry->dn, "\n";
		print $fh "changetype: delete\n";
		foreach my $attr (sort $entry->attributes)
		{
			foreach (sort $entry->get_value($attr))
			{
				print $fh "# $attr", ldap_attr($_);
			}
		}
	}
	elsif ($entry->changetype eq "modify")
	{
		print $fh "\ndn: ", $entry->dn, "\n";
		print $fh "changetype: modify\n";
		# This code was cribbed from Net::LDAP::Entry::modify
		# and yes again I am peeking in to Net::LDAP's namespace.
		my $j = 0;
		while ($j < @{$entry->{changes}})
		{
			my $opcode = $entry->{changes}[$j++];
			my $chg = $entry->{changes}[$j++];
			if (ref($chg))
			{
				my $i = 0;
				while($i < @$chg)
				{
					print $fh $opcode, ": ", $chg->[$i], "\n";
					foreach (ref($chg->[$i+1]) ? @{$chg->[$i+1]} : $chg->[$i+1] )
					{
						print $fh $chg->[$i], ldap_attr($_);
					}
					foreach (@{$entry->{_attrs}{$chg->[$i]}})
					{
						print $fh "# ", $chg->[$i], ldap_attr($_);
					}
					print $fh "-\n";
					$i += 2;
				}
			}
		}
	}
	elsif ($entry->changetype eq "add")
	{
		print $fh "\ndn: ", $entry->dn, "\n";
		print $fh "changetype: add\n";
		foreach my $attr (sort $entry->attributes)
		{
			print $fh "attr: $attr\n";
			foreach (sort $entry->get_value($attr))
			{
				print $fh "$attr", ldap_attr($_);
			}
		}
	}

}

sub log_result
{
	my $fh     = shift;
	my $result = shift;

	return if !$fh;

	print $fh "# ", $result->error, "\n" if $result and $result->code;
}

sub log_rotate
{
	my $logdir = $config{$opt_C}->get_value('logdir');
	my @logfiles;

	return if lc $config{$opt_C}->get_value('logging') eq "no" or
		  lc $config{$opt_C}->get_value('logging') eq "off" or
		     $config{$opt_C}->get_value('maxlogfiles') == 0;

	warn "Rotating log files in $logdir\n" if $opt_v;

	if (! -d "$logdir" )
	{
		warn "Unable to rotate log files, $logdir does not exist.\n\n"
		    if $opt_v;
		return;
	}

	if (! opendir LOGDIR, "$logdir" )
	{
		warn "Unable to open log directory $logdir.\n\n"
		    if $opt_v;
		return;
	}

	foreach (grep { /.ldif$/ && -f "$logdir/$_" } readdir LOGDIR )
	{
		push @logfiles, [ stat("$logdir/$_"), "$logdir/$_" ];
	}
	close LOGDIR;

	@logfiles = sort { $$b[9] <=> $$a[9] } @logfiles;

	delete @logfiles[0 .. ($config{$opt_C}->get_value('maxlogfiles') - 1)]
	    if $config{$opt_C}->exists('maxlogfiles');

	foreach (@logfiles)
	{
		my $logfile = $$_[$#$_];
		warn "Removing logfile $logfile.\n"
		    if $logfile and $opt_v;
		warn "Unable to delete $logfile.\n"
		    if $logfile and ((unlink $logfile) != 1) and $opt_v;
	}
}

sub ldap_connect
{
	my $server  = shift;
	my $port    = shift;

	my $fqdn;
	my $result;
	my $ldap;

	# Get our fqdn, we will need it if we authenticate
	if (!(($fqdn) = gethostbyname($server)))
	{
		$@ = "Unable to resolve host name $server\n";
		return undef;
	}

	if ($Authen_SASL_Cyrus and ! $opt_x)
	{
		warn "Starting SASL/GSSAPI authentication\n" if $opt_v;
		# SASL/GSSAPI authentication to LDAP
		if (!($ldap = new Net::LDAP(
					$server,
					port	=> $port,
					version	=> $opt_P,
					)))
		{
			$@ = "Unable to init for $server: $@\n";
			return;
		}

		my $authzid = $opt_X;
		$authzid = "dn:$opt_D" if $opt_D and ! $opt_X;

		my $bind_dn = $opt_D;
		$bind_dn = "uid=$uid" if ! $opt_D;

		use Authen::SASL;
		my $sasl = Authen::SASL->new(
				'GSSAPI',
				'service'=> 'ldap',
				'fqdn'	=> $fqdn,
				'user'	=> ($authzid ? $authzid : ''),
				);

		warn "Binding to LDAP $bind_dn\n" if $opt_v;
		warn "SASL authzid: $authzid\n" if $opt_v and $authzid;
		$result = $ldap->bind($bind_dn, sasl => $sasl);
	}
	else
	{
		warn "Starting simple authentication\n" if $opt_v;
		# Simple authentication to LDAP
		if (!($ldap = new Net::LDAP(
					$server,
					port	=> $port,
					version	=> $opt_P,
					)))
		{
	 		$@ = "Unable to init for $server: $@\n";
			return;
		}

		if ($opt_D)
		{
			# with a specific bind_dn
			warn "Binding to LDAP dn: $opt_D\n" if $opt_v;
			if ($opt_w or $opt_W)
			{
				# and password
				$result = $ldap->bind($opt_D,
				    password => $opt_w);
			}
			else
			{
				$result = $ldap->bind($opt_D);
			}
		}
		else
		{
			# Anonymous
			warn "Binding to LDAP anonymously\n" if $opt_v;
			$result = $ldap->bind;
		}
	}
	return ($ldap, $result);
}


sub expand_variables
{
	my $line = shift;
	my $rargs = shift;
	my $record = shift;
	my @args = @{$rargs} if $rargs;
	my %record;

	if ($record)
	{
		foreach ($record->attributes)
		{
			$record{lc $_} = [ $record->get_value(lc $_) ];
		}
	}

	my $newline;
	while ($line =~ m/(.*)?(\${1}[[:alnum:]_]+(\{{1}([[:alnum:]]+)\}{1})*(\[\d+\]){0,1})/)
	{
		$newline .= ($1 ? $1 : "") . (eval $2 ? eval $2 : $2);
		$line =~ s/\Q$1$2\E//;
	}
	$newline .= $line if $line;
	return $newline;
}

sub get_ldap_config
{
	# Location of the OpenLDAP config file
	my @conf = qw( /etc/openldap/ldap.conf ~/.ldaprc ./.ldaprc );
	my %opts;

	foreach my $file (@conf)
	{
		# Open the config file
		open (FILE, "<", glob $file) or next;

		# Parse out the values we are interested in
		# server, basedn and port
		while (<FILE>)
		{
			s/#.*//;
			$opts{lc $1} = $2 if (m/\b(\w+)\b\s+(.*)/);
		}

		# Close the file
		close FILE;
	}

	return %opts;
}

sub print_attr
{
	my $mode = shift;
	my $attr = shift;
	my $val  = shift;

	print "$mode $attr", ldap_attr($val);
}

sub ldap_attr
{
	my $val = shift;

	# This was cribbed from Net::LDAP::LDIF::_write_attr
	if ($val =~ /[\x00-\x1f\x7f-\xff]/)
	{
		require MIME::Base64;
		":: ".substr(MIME::Base64::encode_base64($val,''),0,-1)."\n";
	}
	else
	{
		": " . $val . "\n";
	}
}

sub get_password
{
	my $r;
	my $term = POSIX::Termios->new;
	my $echo = (ECHO | ECHOK);
	my $stdin = fileno(STDIN);
	my $oterm;

	# Reading a password from stdin, we should go
	# into noecho mode to keep people from reading
	# over our shoulders
	$term->getattr($stdin);
	$oterm = $term->getlflag;

	print "Enter LDAP Password: ";
	# Set no echo mode
	$term->setlflag($oterm & ~$echo);
	$term->setattr($stdin, TCSANOW);
	# Read the passwd
	chomp($r = <STDIN>);
	# Restore the terminal settings
	$term->setlflag($oterm);
	$term->setattr($stdin, TCSANOW);
	# Push down a line since the <cr> didn't echo
	print "\n";

	return $r;
}

sub unique
{
	# Fast and dirty, unique set of entries returned
	# in an array
	my @array = @_;
	my %hash = map { lc $_, lc $_ } grep { $_ } @array;
	return keys %hash;
}

END {
	# Someone might hit ^C while we are in noecho mode
	# Make sure echo is back on before we exit, nothing
	# is more annoying than being left with a weirded out
	# terminal...
	my $term = POSIX::Termios->new;
	my $stdin = fileno(STDIN);
	$term->getattr($stdin);
	my $oterm = $term->getlflag;
	$term->setlflag($oterm | ECHO | ECHOK);
	$term->setattr($stdin, TCSANOW);
}

sub load_config
{
	my @config = (@_);

	# Make sure name services match reality, failures
	# usually indicate a NIS failure (don't ask)
	my @pwent = getpwuid($<) or
	    die "Go away, you don't exist.\n";
	$uid = $pwent[0];
	$home = $pwent[7];

	if (! -d "$home/.led" )
	{
		warn "Creating .led directory\n" if $opt_v;
		if (! mkdir "$home/.led")
		{
			warn "Unable to create .led directory: $!\n"
			    if $opt_v;
		}
	}

	# XXX This should be coming from outside
	push @config, "$home/.led/config.ldif";

	# XXX This has gotten deep enough that it should
	# XXX be refactored.
	foreach my $cf (@config)
	{
		warn "Loading config file: $cf\n" if $opt_v;
		my $perm;
		if (-f $cf)
		{
			$perm = (stat $cf)[2] & 0777;
			if (!open CONFIG, $cf)
			{
				warn "Unable to open $cf\n" if $opt_v;
			}
			else
			{
				my $ldif = Net::LDAP::LDIF->new(\*CONFIG,
								"r",
								onerror => 'die',
								);
				while (not $ldif->eof())
				{
					my $entry = $ldif->read_entry();
					if ($ldif->error() )
					{
						warn "LDIF error: ",
						    $ldif->error(), "\n";
						warn "     lines: ",
						    $ldif->error_lines(), "\n";
						die "Giving up on LDIF error\n";
					}

					warn "Loaded configuration: ", $entry->dn, ".\n"
					    if $opt_v;
					die sprintf "$cf is mode %.4lo %s\n", $perm,
					    "and contains password(s), should be 0600 at most."
						if $entry->exists('bindpasswd') and
						    $entry->get_value('bindpasswd') and
						    $perm != 0600 and $perm != 0400;

					if (exists $config{lc $entry->dn})
					{
						foreach ($entry->attributes)
						{
							$config{lc $entry->dn}->replace(
							    $_ => $entry->get_value($_)
								);
						}

					}
					else
					{
						$config{lc $entry->dn} = $entry;
					}
					
				}
				close CONFIG;
			}
		}
	}

	$config{default} = Net::LDAP::Entry->new
	    if ! exists $config{default};
	$config{default}->add(logging => 'on')
	    if ! $config{default}->exists("logging");
	$config{default}->add(logdir => "$home/.led/log")
	    if ! $config{default}->exists("logdir");
	$config{default}->add(maxlogfiles => 25)
	    if ! $config{default}->exists("maxlogfiles");
	$config{default}->add(mapdir => "$home/.led/maps")
	    if ! $config{default}->exists("mapdir");
	#$config{default}->add(wrap => 78)
	#    if ! $config{default}->exists("wrap");
	
	# XXX Should be pulled from the DIT but this is the
	# Windows 2000 default value for maxPageSize
	$config{default}->add(maxpagesize => 1000)
	    if ! $config{default}->exists("maxpagesize");

	foreach my $key (keys %config)
	{
		foreach ($config{default}->attributes)
		{
			$config{$key}->add(
					$_ => $config{default}->get_value($_)
				) if ! $config{$key}->exists($_);
		}
	}

	die "Unable to locate config $opt_C.\n"
	    if $opt_C and ! $config{$opt_C};

	my $logdir = $config{$opt_C}->get_value('logdir');

	if (! -d "$logdir" )
	{
		warn "Creating $logdir directory\n" if $opt_v;
		warn "Unable to create $logdir directory: $!\n"
		    if !mkdir $logdir and $opt_v;
	}

	my $mapdir = $config{$opt_C}->get_value('mapdir');

	if (! -d "$mapdir" )
	{
		warn "Creating $mapdir directory\n" if $opt_v;
		warn "Unable to create $mapdir directory: $!\n"
		    if !mkdir $mapdir and $opt_v;
	}

	$opt_e = $config{$opt_C}->get_value('encoding')
		 if $config{$opt_C}->exists('encoding') and
		    ! $opt_e;

	$opt_b = $config{$opt_C}->get_value('basedn')
		 if $config{$opt_C}->exists('basedn') and 
		    ! $opt_b;

	$opt_D = $config{$opt_C}->get_value('binddn')
		 if $config{$opt_C}->exists('binddn') and
		    ! $opt_D;

	$opt_h = join(" ", $config{$opt_C}->get_value('host')) and $opt_N = 1
		 if $config{$opt_C}->exists('host') and
		    ! $opt_h;

	$opt_p = $config{$opt_C}->get_value('port')
		 if $config{$opt_C}->exists('port') and
		    ! $opt_p;

	$opt_P = $config{$opt_C}->get_value('version')
		 if $config{$opt_C}->exists('version') and
		    ! $opt_P;


	$opt_s = $config{$opt_C}->get_value('scope')
		 if $config{$opt_C}->exists('scope') and
		    ! $opt_s;

	if ($config{$opt_C}->exists('bindpasswd') and !$opt_w and !$opt_W)
	{
		if (length $config{$opt_C}->get_value('bindpasswd'))
		{
			$opt_w = $config{$opt_C}->get_value('bindpasswd');
		}
		else
		{
			$opt_W = 1;
		}
	}

	$opt_x = 1 if $config{$opt_C}->exists('auth') and
		      lc $config{$opt_C}->get_value('auth') eq 'simple' and
			! $opt_x;

	$opt_X = $config{$opt_C}->get_value('authzid')
		 if $config{$opt_C}->exists('authzid') and
		    ! $opt_X;

	$opt_n = 1 if $config{$opt_C}->exists('readonly') and
		      (lc $config{$opt_C}->get_value('readonly') eq "yes" or
		       lc $config{$opt_C}->get_value('readonly') eq "on") and
			! $opt_n;
}

sub Dump_Internal_Maps
{
	# Set default config
	$opt_C = 'default' if ! $opt_C;

	# Load user configs
	load_config();

	my $dumpdir = $config{$opt_C}->get_value('mapdir') . "/internal";

	if (! -d "$dumpdir" )
	{
		warn "Creating $dumpdir directory\n" if $opt_v;
		warn "Unable to create $dumpdir directory: $!\n"
		    if !mkdir $dumpdir and $opt_v;
	}

	foreach my $map (keys %maps)
	{
		$maps{$map}->dn($map);
		my $ldif = Net::LDAP::LDIF->new(
						"$dumpdir/$map.ldif",
						"w",
						encode => $opt_e,
						onerror => 'die',
						);
		$ldif->write_entry( $maps{$map} );
		$ldif->done;
	}

	exit 0;
}

sub load_generic_maps
{
	return if ! (shift);

	$maps{aci} = Net::LDAP::Entry->new;
	$maps{aci}->add(
			usage	=> 'LDAP ACI entries',
			base	=> '??(aci=*)',
			attrs	=> [ qw(aci) ],
			ldif	=> 1,
		);

	$maps{rootdse} = Net::LDAP::Entry->new;
	$maps{rootdse}->add(
			usage	=> 'LDAP root DSE entry (Read only)',
			base	=> '.?base?(objectClass=*)',
			attrs	=> [ qw(namingContexts supportedExtension
					supportedControl supportedSASLMechanisms
					supportedLDAPVersion) ],
			ldif	=> 1,
			readonly=> 1,
		);
}

sub load_rfc2307_maps
{
	return if ! (shift);
	my $shadow = shift;

	$maps{passwd} = Net::LDAP::Entry->new;
	$maps{passwd}->add(
			usage	=> 'unix password map',
			attrs	=> [ qw(uid userPassword uidNumber gidNumber
					gecos homeDirectory loginShell) ],
			key	=> 'uid',
			required=> [ qw(uid userPassword uidNumber gidNumber
					homeDirectory) ],
			joins	=> [ ':' ],
			splits	=> [ '\s*:\s*' ],
			base	=> 'ou=People,??(objectClass=posixAccount)',
			schema	=> [ qw(objectClass sn cn) ],
			objectClass => [ qw(top posixAccount) ],
			cn	=> [ qw( $record{uid}[0] ) ],
		);

	if ($shadow)
	{
		$maps{passwd}->add(
			schema	=> [ qw(userPassword) ],
			objectClass => [ qw(shadowAccount) ],
			userPassword => [ qw({crypt}*) ],
		);
		$maps{passwd}->delete(
			attrs	=> [ qw(userPassword) ],
			required=> [ qw(userPassword) ],
		);
		$maps{passwd}->replace(
			filter	=> '(&(objectClass=posixAccount)(objectClass=shadowAccount))',
			joins	=> [ ':x:', ':' ],
			splits	=> [ '\s*:\s*x\s*:\s*', '\s*:\s*' ],
		);

		$maps{shadow} = Net::LDAP::Entry->new;
		$maps{shadow}->add(
			usage	=> 'unix shadow password map',
			attrs	=> [ qw(uid userPassword shadowLastChange
					shadowMin shadowMax shadowWarning
					shadowInactive shadowExpire
					shadowFlag) ],
			key	=> 'uid',
			required=> [ qw(uid) ],
			joins	=> [ ':' ],
			splits	=> [ '\s*:\s*' ],
			base	=> $maps{passwd}->get_value('base'),
			shadow	=> 'passwd',
		);
	}

	$maps{people} = Net::LDAP::Entry->new;
	$maps{people}->add(
			usage	=> 'LDAP people (LDIF only)',
			filter	=> '(objectClass=person)',
			ldif	=> 1,
		);

	$maps{group} = Net::LDAP::Entry->new;
	$maps{group}->add(
			usage	=> 'unix group map',
			attrs	=> [ qw(cn gidNumber memberUid) ],
			key	=> 'cn',
			required=> [ qw(cn gidNumber) ],
			joins	=> [ ':', ':', ',' ],
			splits	=> [ '\s*:\s*', '\s*:\s*', '\s*,\s*' ],
			base	=> 'ou=Group,??(objectClass=posixGroup)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top posixGroup) ],
		);

	$maps{hosts} = Net::LDAP::Entry->new;
	$maps{hosts}->add(
			usage	=> 'unix hosts map',
			attrs	=> [ qw(ipHostNumber cn cn) ],
			key	=> 'cn',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base	=> 'ou=Hosts,??(objectClass=ipHost)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top device ipHost) ],
		);

	$maps{ethers} = Net::LDAP::Entry->new;
	$maps{ethers}->add(
			usage	=> 'unix ethers map',
			attrs	=> [ qw(macAddress cn) ],
			key	=> 'cn',
			required=> [ qw(cn) ],
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base	=> 'ou=Ethers,??(objectClass=ieee802device)',
			schema	=> [qw(objectClass) ],
			objectClass=> [ qw(top device ieee802device) ],
		);

	$maps{netgroup} = Net::LDAP::Entry->new;
	$maps{netgroup}->add(
			usage	=> 'NIS netgroup map',
			attrs	=> [ qw(cn nisNetgroupTriple memberNisNetgroup) ],
			key	=> 'cn',
			required=> [ qw(cn) ],
			joins	=> [ ' ' ],
			splits	=> [ '\s+' ],
			matches	=> [ '\s*(\(.*?\))\s*', '\s*(\S+)\s*' ],
			base	=> 'ou=NetGroup,??(objectClass=nisNetgroup)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top nisNetgroup) ],
		);

	$maps{networks} = Net::LDAP::Entry->new;
	$maps{networks}->add(
			usage	=> 'unix networks map',
			attrs	=> [ qw(cn ipNetworkNumber cn) ],
			key	=> 'cn',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base	=> 'ou=Networks,??(objectClass=ipNetwork)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top ipNetwork) ],
		);

	$maps{netmasks} = Net::LDAP::Entry->new;
	$maps{netmasks}->add(
			usage	=> 'unix netmask map',
			attrs	=> 'ipNetworkNumber',
			attrs	=> 'ipNetmaskNumber',
			key	=> 'ipNetworkNumber',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base    => $maps{networks}->get_value('base'),
			schema	=> [ qw(objectClass top ipNetwork) ],
			shadow	=> 'networks',
		);

	$maps{automount} = Net::LDAP::Entry->new;
	$maps{automount}->add(
			usage	=> 'master automount map',
			attrs	=> [ qw(nisMapName) ],
			key	=> 'nisMapName',
			required=> 'all',
			joins	=> [ ' ' ],
			splits	=> [ '$' ],
			base	=> 'ou=automount,??(objectClass=nisMap)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top nisMap) ],
		);

	$maps{automountmap} = Net::LDAP::Entry->new;
	$maps{automountmap}->add(
			usage	=> 'NIS automount map',
			alias	=> '^auto\..*',
			args	=> 'mapname',
			attrs	=> [ qw(cn nisMapEntry) ],
			key	=> 'cn',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+', '$' ],
			base	=> 'nisMapName=%s,ou=automount,??'.
				    '(&(objectClass=nisObject)(nisMapName=%s))',
			parent	=> '_automount',
			schema	=> [ qw(objectClass nisMapName) ],
			objectClass=> [ qw(top nisObject) ],
			nisMapName=> [ qw($args[0]) ],
		);

	# XXX Watch the parent path here.
	# XXX automountmap -> _automount -> automount
	$maps{_automount} = Net::LDAP::Entry->new;
	$maps{_automount}->add(
			base	=> $maps{automountmap}->get_value('base'),
			parent	=> 'automount',
			schema	=> [ qw(objectclass nisMapName) ],
			objectclass=> [ qw(top nisMap) ],
			nisMapName=> [ qw($args[0]) ],
		);

	$maps{mailgroup} = Net::LDAP::Entry->new;
	$maps{mailgroup}->add(
			usage	=> 'LDAP mail groups',
			attrs	=> [ qw(cn mgrpRFC822MailMember) ],
			key	=> 'cn',
			base	=> 'ou=mailgroup,??(objectClass=mailGroup)',
			required=> 'cn',
			joins	=> [ ':',  ',' ],
			splits	=> [ '\s*:\s*', '\s*,\s*' ],
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top mailGroup) ],
		);

	$maps{services} = Net::LDAP::Entry->new;
	$maps{services}->add(
			usage	=> 'unix services map',
			attrs	=> [ qw(cn ipServicePort
					ipServiceProtocol cn) ],
			key	=> 'cn+ipServiceProtocol',
			required=> 'all',
			joins	=> [ "\t", '/', "\t" ],
			splits	=> [ '\s+', '/', '\s+' ],
			base	=> 'ou=Services,??(objectClass=ipService)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top ipService) ],
		);

	$maps{rpc} = Net::LDAP::Entry->new;
	$maps{rpc}->add(
			usage	=> 'unix rpc map',
			attrs	=> [ qw(cn oncRpcNumber cn) ],
			key	=> 'cn',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base	=> 'ou=Rpc,??(objectClass=oncRpc)',
			schema	=> [ qw(objectClass) ],
			objectClass => [ qw(top oncRpc) ],
		);

	$maps{protocols} = Net::LDAP::Entry->new;
	$maps{protocols}->add(
			usage	=> 'unix protocols map',
			attrs	=> [ qw(cn ipProtocolNumber cn) ],
			key	=> 'cn',
			required=> 'all',
			joins	=> [ "\t" ],
			splits	=> [ '\s+' ],
			base	=> 'ou=Protocols,??(objectClass=ipProtocol)',
			schema	=> [ qw(objectClass) ],
			objectClass=> [ qw(top ipProtocol) ],
		);
}

sub load_iPlanet_maps
{
	return if ! (shift);

	$maps{replica} = Net::LDAP::Entry->new;
	$maps{replica}->add(
			usage	=> 'iPlanet Directory Server 5 Replication',
			base	=> 'cn=mapping tree,cn=config??'.
				    '(&(objectClass=nsDS5ReplicationAgreement)'.
				    '(nsDS5ReplicaRoot=$ldap_opt{base}))',
			ldif	=> 1,
			binddn	=> 'cn=Directory Manager',
			auth	=> 'simple',
			password=> 1,
		);

	$maps{schema} = Net::LDAP::Entry->new;
	$maps{schema}->add(
			usage	=> 'iPlanet Directory Server 5 Schema',
			base	=> 'cn=schema??(objectClass=*)',
			attrs	=> [ qw(ldapsyntaxes attributetypes aci) ],
			ldif	=> 1,
		);

	$maps{config} = Net::LDAP::Entry->new;
	$maps{config}->add(
			usage	=> 'iPlanet Directory Server 5 Config',
			base	=> 'cn=config??(objectClass=*)',
			ldif	=> 1,
			binddn	=> 'cn=Directory Manager',
			auth	=> 'simple',
			password=> 1,
		);

	$maps{netscaperoot} = Net::LDAP::Entry->new;
	$maps{netscaperoot}->add(
			usage	=> 'iPlanet Directory Server 5 NetscapeRoot',
			base	=> 'o=NetscapeRoot??(objectClass=*)',
			ldif	=> 1,
			binddn	=> 'cn=Directory Manager',
			auth	=> 'simple',
			password=> 1,
		);
}

sub load_user_maps
{
	return if ! (shift);

	my $mapdir = $config{$opt_C}->get_value('mapdir');
	my @mapfiles;

	return if ! $mapdir and ! -d $mapdir;

	if (! opendir MAPDIR, "$mapdir" )
	{
		warn "Unable to open map directory $mapdir.\n\n"
		    if $opt_v;
		return;
	}

	foreach (grep { /.ldif$/ && -f "$mapdir/$_" } readdir MAPDIR )
	{
		push @mapfiles, "$mapdir/$_";
	}
	closedir MAPDIR;

	foreach (@mapfiles)
	{
		warn "loading map: $_\n" if $opt_v;

		if (-f "$_")
		{
			if (!open MAP, "$_")
			{
				warn "Unable to open $_\n"
				    if $opt_v;
			}
			else
			{
				my $ldif = Net::LDAP::LDIF->new(\*MAP,
								"r",
								onerror => 'die',
								);
				while (not $ldif->eof())
				{
					my $entry = $ldif->read_entry();
					if ($ldif->error() )
					{
						warn "LDIF error: ",
						    $ldif->error(), "\n";
						warn "     lines: ",
						    $ldif->error_lines(), "\n";
						die "Giving up on LDIF error\n";
					}
					next if ! $entry;
					$maps{lc $entry->dn} = $entry;
					warn "Loaded map: ", $entry->dn, ".\n"
					    if $opt_v;
				}
				$ldif->done();
				close MAP;
			}
		}
	}


}

__END__

=head1 NAME

led - LDAP editor

=head1 SYNOPSIS

B<led> S<[ options ]> map|filter S<[ arguments ]> S<[ attr [...] ] >

=head1 DESCRIPTION

Led is a general purpose LDAP editor which allows editing of
LDIF records or standard unix flat file representations
of LDAP databases using your favorite editor.

The I<map> argument should be one of the maps listed in the
usage message for Led.  Alternately any query can be specified
using I<filter>, and will implicitly invoke B<-L>.  The filter
should conform to the string representation for search filters as
defined in B<RFC 2254>.  There is no default I<map> or I<filter>.

The B<automountmap> map has an alias regex that will match any map
named B<^auto.*>.  For example, B<led auto.home> is equivalent to
B<led automountmap auto.home>.

The usage message for Led and map list can be displayed by executing
Led with no parameters.

=head1 OPTIONS

=over 5

=item B<-c>

Concatenate the contents of the map or LDIF to standard output.

=item B<-C> I<config>

Use the configuration named dn: I<config> from B<config.ldif> instead
of the default.

=item B<-e> I<encode>

Some values in LDIF cannot be written verbatim and have to be
encoded in some way. This option lets you specify how. Valid
encoding options are 'none' (the default), 'canonical' (see
the canonical_dn entry in the L<Net::LDAP::Util>), or
'base64'.

=item B<-E>

In the event that an LDAP filter is specified incorrectly, Led
will not allow you to edit an empty result set, so as to avoid
creating empty braches in your LDAP database. This option
overrides the default behaviour, allowing you to create new,
empty branches in your LDAP directory.

=item B<-f> I<file>

Export the contents of the map or LDIF file to the named I<file>
and do not start an interactive editing session.

=item B<-i> I<file>

Import the contents of the named LDIF I<file> into the LDAP database
without starting an interactive editing session.

=item B<-L>

Present the result set in LDIF format.

=item B<-m> I<attr>=I<value>

Force all occurrences of the named attribute I<attr> to be I<value>.
This option can be repeated as necessary.  Any changes to these
attributes will be discarded.

=item B<-n>

Print the changes that would be executed, but do not commit
them to the LDAP database.

=item B<-N>

Do not allow Led to chase update referrals to the authoritive LDAP
server.

=item B<-r> I<command>

Invoke I<command> as a pipeline on the result set instead of starting
an interactive editing session.  Led will send the result set to
I<command> on standard input and retrieve the modified result set
from standard output and exit with the return value of I<command>.
If I<command> does not exit with a 0 return code Led will not commit
any changes and will exit with the same return code as I<command>.
This is useful for doing bulk search and replace actions.

=item B<-V>

Print the version of Led and exit.

=back

=head1 LDAP OPTIONS

=over 5

=item B<-b> I<searchbase>

Use searchbase as the starting point for the search instead of the
default.

=item B<-D> I<binddn>

Use the Distinguished Name I<binddn> to bind to the LDAP directory.

=item B<-h> I<ldaphost>[:I<port>] ...

Specify an alternate host and port on which the LDAP server is
running.  Multiple I<ldaphost>s can be specified in a space seperated
list.

=item B<-p> I<ldapport>

Specify an alternate TCP port where the LDAP server is listening.

=item B<-P> I<2>|I<3>

Specify the LDAP protocol version to use.

=item B<-s> I<base>|I<one>|I<sub>

Specify the scope of the search to be one of I<base>, I<one>, or
I<sub> to specify a base object, one-level, or subtree search.
The default is I<sub>.

=item B<-S> I<attribute>,...

Sort the entries returned based on I<attribute>. The default is
not to sort entries returned.  If I<attribute> is a zero-length
string (""), the entries are sorted by the components of their
Distingished Name.  See L<ldap_sort> for more details.

=item B<-v>

Run in verbose mode, with many diagnostics written to standard output.

=item B<-w> I<bindpasswd>

Use I<bindpasswd> as the password for simple authentication.

=item B<-W>

Prompt for simple authentication.  This is used instead of specifying
the password on the command line.

=item B<-x>

Use simple authentication instead of SASL.

=item B<-X> I<authzid>

Specify the requested authorization ID for SASL bind.  I<authzid>
must be one of the following formats: dn:E<lt>I<distinguished name>E<gt>
or u:E<lt>I<username>E<gt>.

=back

=head1 CONFIGURATION

Most of the defaults in led can be altered by writing an LDIF entry
for 'dn: config' in the following file.

The precedence for configuration from highest to lowest are command
line options, $HOME/.led/config.ldif, $CWD/.ldap.conf, $HOME/.ldap.conf
and /etc/openldap/ldap.conf.

=over 5

=item B<$HOME/.led/config.ldif>

 dn: default
 logdir: $home/.led/log
 logging: on
 maxlogfiles: 25

=item B<auth>

Set the value of this attribute to 'simple' to use simple authentication
instead of SASL.

=item B<authzid>

Specify the requested authorization ID for SASL bind.  authzid must be one
of the following formats: dn:<distinguished name> or u:<username>.

=item B<base_>I<map>

Specifies the base for I<map>.  This is very useful if your DIT is organized
in a non-standard way to make up for missing rdn components.  It is of the
same format as base in the user defined map section, base?scope?filter.

=item B<binddn>

Use the Distinguished Name I<binddn> to bind to the LDAP directory.

=item B<bindpasswd>

Use bindpasswd as the password for simple authentication.  If this attribute
is specified but has no value then Led will prompt for simple authentication.

=over 4

=item B<Warning>:

B<If you supply a value for bindpasswd Led will require the config file to
be mode 0600 or 0400.>

=back

=item B<dn>

Specifies the name of the configuration.  The default configuration
is named "default".  You can override the defaults for all configurations
by providing a configuration named "DEFAULT".

=item B<encoding>

Some values in LDIF cannot be written verbatim and have to be encoded
in some way.  This option lets you specify how.  Valid encoding options
are 'none' (the default), 'canonical' (see the canonical_dn entry in
the the L<Net::LDAP::Util>, or 'base64'.

=item B<host>

Specify an alternate host and port on which the LDAP server is running.
Multiple hosts can be specified by repeating this attribute.  Use of this
attribute implicitly invoke -N.

=item B<logdir>

Specifies the directory for storing the LDIF change logs, if logging
is enabled.  $home will be interpreted as the users home directory
from L<pwent>.  The default for I<logdir> is B<$home/.led/log>.

=item B<logging>

Can be used to disable storing of LDIF change logs, if set to B<no>
or B<off>.  The default is B<on>.

=item B<mapdir>

Is used to specify the location for user defined maps.  The default location
is $HOME/.led/maps and available in each configuration.  If explicity set
for a given configuration the default user defined map set will not be 
available.

=back

=item B<maxlogfiles>

Can be used to set the maximum number of LDIF change log files that
will be retained.  The oldest change log files are removed first.  The
default number of change log files retained is B<25>.

=item B<maxpagesize>

Used to set the number of entries requested in a sigle result page from an
LDAP servers that advertise LDAP_CONTROL_PAGED in their supported controls.
The default value is B<1000>.  Paging can be disabled by setting this value
to B<0>.

=item B<port>

Specify the LDAP protocol version to use.

=item B<readonly>

If the value of readonly is set to on or yes the -n option will be invoked.

=item B<scope>

Specify the scope of the search to be one of base, one, or sub to specify
a base object, one-level, or subtree search.  The default is sub.

=head1 USER DEFINED MAPS

Led can import user defined maps from LDIF files located in $HOME/.led/maps.
These can be either additional maps or can be use to replace internally 
defined maps.

Led can dump LDIF versions of the internal maps using the --DumpInternalMaps
command line argument.  The maps will be stored in $HOME/.led/maps/internal
to avoid overwriting user defined maps.

=over 5

=item B<attrs>

Can be used repeatedly to specify the attributes used in the map.  In LDIF
only maps this can be used to specify attributes that aren't normally returned
by the query.

=item B<auth>

Specifies that this map requires binding via this auth mechanism.  The only
supported value currently is "simple".

=item B<base>

Base controls the naming context, search scope and filter for a map.  It
is specified as base?scope?filter.  The base component can be specified
as a full dn, or can be a relative dn, if it ends with a comma, an empty
base component will be replaced by the default dn and lastly if an actual
empty basedn is required, in the case of querying a rootdse, a single period
should be used.  The scope component is optional and can be base, one or sub,
if left blank the default scope will be used.  The last component filter is
used as the ldap search filter for the query, there is no default for filter.

The base component will be used to create the basedn for new entries when
editing maps, in LDIF mode the basedn is explicit.

=item B<binddn>

Specifies that this map requires binding through with the specifed I<binddn>'s
credentials.  This is analagous to the config I<binddn> or -D command line 
argument.

=item B<dn>

Specifies the name of the map.  This is a required attribute, if the first
character of the dn is '_' the map will not be displayed in the usage message.

=item B<joins>

Can be used repeatedly to specify the separator strings to be used between
attributes.  The last separator will be used repeatedly until all attributes
have been exhausted.  The joins attributes should be Base-64 encoded to avoid
any possible misinterpretations.  The perl join function is used to join map
elements.  The joins attribute has no meaning for LDIF only maps.

=item B<key>

Specifies the naming attribute for the LDAP entry.

=item B<ldif>

Process the result set in LDIF.

=item B<matches>

Can be used as an adjunct to the splits attribute for maps that have mixed
attributes that must be parsed into multiple attributes.  The matches are
actually performed using the perl s/// operator.  This is a highly advanced
feature that is currently only used by the netgroups map.

=item B<parent>

If a map requires intermediate structural nodes to be created, this attribute
can be used to specify the name of the map used to create and delete these
structural nodes.  This is a highly advanced feature that is currently only
used by automount maps.

=item B<password>

If this attribute is present the user will be prompted to provide the password
for the I<binddn> being used.

=item B<readonly>

Specify that the map is informational only and do not process any changes.

=item B<required>

Specifies the last required attribute or can be set to all to require all
attributes.  If an entry does not contain all of the required attributes it
will be dropped from the result set.

=item B<schema>

Use the schema attribute repeatedly to define the required attributes for
creating new entries.

=item B<schema-attributes>

These can be any attribute listed as a value for a schema attribute.  They
should contain the synthesized data for the attributes created for new
entries that can not be taken from the map.  Objectclasses are the most
frequent example.

=item B<shadow>

Specifies that this map is a supporting map to another map.  Modification to
attributes will be allowed but additions and deletions must be made through
the structural map named in this attribute.

=item B<splits>

Can be used repeatedly to specify the regex used to parse map lines.  The last
regex will be used repeatedly until the map line has been fully consumed.  The
splits attributes should be Base-64 encoded to avoid any possible
misinterpretations.  The perl split function is used to parse the map lines.
The splits attribute has no meaning for LDIF only maps.

=item B<usage>

Specifies the map description that will be used in the usage message for Led.

=back

Variables can be used in schema attributes, ldap filters and BaseDNs.

=over 5

=item B<$args[>I<elem>B<]>

Map arguments.

=item B<$ldap_opt{'>I<option>B<'}>

LDAP configuration options.

=item B<$record{'>I<attr>B<'}[>I<elem>B<]>

Attribute values internal to the current entry.

=back

=head1 LOGGING

Led generates an LDIF change log for every session including the command
line and search parameters.  Each change log contains LDIF change records
for every modification made during the session.  These change records
include all necessary information to either replay the operations or
construct a change record to reverse the operation.  If an operation
fails the failure is noted with the accompanying error message.

B<Example>

  #
  # led uid=jbriggs
  #
  # base: dc=example,dc=com
  # filter: uid=jbriggs
  # scope: sub
  # attrs: *
  #

  dn: uid=jbriggs,ou=People,dc=example,dc=com
  changetype: delete
  # cn: Joe Bob Briggs
  # gecos: Joe Bob Briggs
  # gidNumber: 150
  # givenName: Joe
  # homeDirectory: /usr/home/jbriggs
  # loginShell: /bin/tcsh
  # mail: jbriggs@example.com
  # mailRoutingAddress: jbriggs@imap.example.com
  # objectClass: inetOrgPerson
  # objectClass: mailRecipient
  # objectClass: organizationalPerson
  # objectClass: person
  # objectClass: posixAccount
  # objectClass: top
  # sn: Briggs
  # uid: jbriggs
  # uidNumber: 101
  # Insufficient 'delete' privilege to delete the
    entry 'uid=jbriggs,ou=People,dc=example,dc=com'.

  # 1 of 1 updates failed

=head1 DIAGNOSTICS

Exit status is zero if no errors occur.  Errors result in a nonzero
exit status and diagnostic messages being written to standard error.

=head1 ENVIRONMENT

=over 12

=item EDITOR

The editor to invoke for interactive editing sessions.

=back

=head1 FILES

I</etc/openldap/ldap.conf>

I</etc/led.ldif>

I<$HOME/.ldap.conf>

I<$CWD/.ldap.conf>

I<$HOME/.led/config.ldif>

I<$HOME/.led/maps/*.ldif>

=head1 DIRECTORIES

I<$HOME/.led>

I<$HOME/.led/log>

I<$HOME/.led/maps>

=head1 SEE ALSO

L<ldap>, L<ldap.conf>, L<ldapsearch>, L<ldif>,
L<Net::LDAP>, L<Net::LDAP::LDIF>, RFC 2254, RFC 2307

=head1 WARNING

It is not advisable to alter the login attribute of an entry in the
I<passwd> map, additional LDAP attributes like B<mail>, B<mailRoutingAddress>
and B<mailAlternateAddress> will be lost.  LDIF mode should be used or
the entry edited directly using an LDAP filter.

=head1 AUTHOR

Larry Lile E<lt>lile@stdio.comE<gt>

=head1 ACKNOWLEDGEMENTS

B<OpenLDAP> is developed and maintained by The B<OpenLDAP>
Project (L<http:E<sol>E<sol>www.openldap.orgE<sol>>).   B<OpenLDAP> is derived
from University of Michigan LDAP 3.3 Release.

Thanks to the authors, developers and maintainers of B<Net::LDAP>,
B<Authen::SASL>, B<Getopt::Long>, B<Digest::MD5>, B<Fcntl>,
B<POSIX> and B<URI>

Thanks to Luke Howard E<lt>lukeh@PADL.COME<gt> for B<nss_ldap>
and B<RFC 2307>.

I<$Id: led,v 1.111 2010/05/26 20:01:31 lile Exp $>
