package Viper;
#$Viper::VERSION= '.1p1'; # Thu Dec 18 21:33:10 CET 2008
#$Viper::VERSION= '.1p4'; # Sun Mar  1 01:34:04 CET 2009
#$Viper::VERSION= '.1p6'; # Mon Mar  2 23:45:11 CET 2009
#$Viper::VERSION= '.1p8'; # Mon Mar  2 23:45:11 CET 2009
#$Viper::VERSION= '.1p84'; # Sat Mar 14 21:24:24 CET 2009
#$Viper::VERSION= '.1p86'; # Sun Mar 15 14:13:38 CET 2009
$Viper::VERSION= '.1p88'; # Sun Mar 15 14:13:38 CET 2009
#
# vim: se ts=2 sts=2 sw=2 ai
#
# Viper -- Custom Perl backend for use with the OpenLDAP server.
#
# Spinlock Solutions --
#   Advanced GNU/Linux networks in commercial and education sectors.
#
# Davor Ocelic, docelic@spinlocksolutions.com
#
# http://www.spinlocksolutions.com/
# http://techpubs.spinlocksolutions.com/
#
# The Viper backend implements regular LDAP functionality and can be used in
# general-purpose scenarios where you want quick results on a flexible
# platform allowing for custom features.
#
# However, it's main role is serving as the backend for automatic system
# installations and configurations, where the clients are Debian-based
# systems retrieving configuration data using Debconf and its LDAP driver.
# A whole set of features has been implemented specifically for this purpose.
# 
#
# The backend has a few specifics, of course; some are coming to play in all
# usage scenarios, and some primarily in automatic install scenarios.
#
# Here's the summary:
#
# - Server data is kept in form of LDIF files in the filesystem, where
#   each entry is represented by a directory structure (DN components)
#   and a single file representing the final entry (leaf).
#   It means that internally, you can modify LDAP values like a filesystem
#   operation (editing files and directories), that you can use symlinks and
#   hardlinks, and that you can set file permissions to affect reading/writing.
#
# - Each file is expected to contain only one entry, and so within each file,
#   exactly and only the first entry is relevant. Everything in there that
#   is either another entry or just invalid data (be it after or within
#   the first entry) is IGNORED. You are of course discouraged from modifying
#   entry file contents in invalid ways, but it does allow for some 
#   interesting tricks, as long as you remember the entry is rewritten each
#   time on ADD (with addOverwrites==true) or MODIFY and this data is then lost.
#
# - There is a config option available to allow ADD operation to overwrite
#   existing entries without throwing ALREADY_EXISTS error. See 'addoverwrites'
#
# - There is a config option available to allow ADD operation to ignore adds
#   on already existing entries without throwing ALREADY_EXISTS error.
#   Applicable only when addoverwrites=false. See 'addignoredups'
#
# - When a modify request is issued and the specific entry to modify is there,
#   everything goes on as usual. But if the entry is not there (it comes from
#   a fallback), then it's possible to either return NO_SUCH_OBJECT (as if
#   the entry was not found at all), or to modify & copy the fallback to the
#   expected name, effectively creating the entry in the process.
#   See 'modifycopyonwrite'
#
# - There is a config option available to ignore MODIFY requests which 
#   do not result in a different entry. (Useful with Debconf which treats
#   all invoked questions as modified, and submits them back to the directory
#   as modifications, even if their value did not change
#   during the process). See 'modifysmarts'
#
# - When a search is made, it is possible to regex match combination of the
#   input params (base, scope, deref, size, time, filter, attrOnly), and
#   if all of them match a specification, then the params can be arbitrarily
#   rewritten, i.e. replace search base with another base if certain filter
#   is used).See 'searchsubst'.
#
# - When a specific search base (individual entry) is requested, and it does
#   not exist in the searched location, it is possible to fallback to
#   a chain of default entries. See 'searchdefault'
#
# - When an entry is found (it exists), it
#   can be appended with attributes from other entries. The default entries
#   to use for appending can be specified in the entry's seeAlso attribute,
#   or directly in a config file through regex replacement on the original
#   entry DN. You can control whether the attributes are added always, or 
#   only if missing in the original entry. Also, you can specify schemacheck
#   policy. See 'searchappend'
#
# - When entry is read, it is possible to cause attribute value expansion into
#   values of on-disk files, ALWAYS relative to server data dir, such as:
#     "result is $ file [spec] $ FNAME" ===> "result is FILE-DATA". [Spec] is
#     optional and when number, specific line number is returned; when 
#     string, a line or $1 matching the regex is returned; otherwise whole
#     file is returned. See 'fileval'
#
# - When entry is read, it is possible to cause attribute value expansion into
#   values of other entries' attributes, such as:
#     "result is $ exp $ DN ATTR VALX" ===> "result is VALUE". DN is the 
#     wished entry's DN, ATTR is its attribute you want to expand to, and
#     VALX is a numerical ID in case the attribute has multiple values.
#     Shorthand notation is also possible: simply ATTR [VALX] implies ATTR
#     in the current entry, with selected VALX (or 0). Note that expanded
#     attrs from the same entry are not processed-- their value is taken
#     verbatim. See 'expandval'
#
# - When entry is read, it is possible to cause Perl evaluation of contents
#   within attributes, such as:
#     "result is $ perl $ 3 + 4" ===> "result is 7".
#     ** WARNING ** DANGEROUS ** DISABLED BY DEFAULT **. See 'perleval'
#
# - Regarding values normalization, on every ADD we normalize entry DN and
#   save it that way. It is not possible to retrieve the DN back in the
#   original form submitted. Attribute values (such as ou=Hosts) are left
#   as-is and are not modified even if they were normalized within DN.
#
# XXX make configurable which attr and which value triggers this
# - When entry is added somewhere under Debconf tree (configurable
#   via a list of regexes), it is possible to check the list of entry's
#   variables and see if the entry should be relocated in other parts of
#   the tree. This functionality is client- and debconf- specific, and requires
#   that the client inserts debconf variable viper_location=  into the
#   entry. See 'relocate'
#
#
# All of the above features are tunable from the config file, and in fact must
# be present there to be enabled. Features with no configuration specified in
# slapd.conf are effectively disabled.
#
# Fine. Now let's take a look at the ways of configuring the backend for use:
#
# * For general-purpose scenarios, there isn't much to say about it; configure
# the backend as follows and connect to it with a regular LDAP client:
#
# modulepath	/usr/lib/ldap
# moduleload	back_perl
# 
# database        perl
# suffix          "dc=spinlock,dc=hr"
# perlModulePath  "/home/docelic/p/debconf-backend/"
# perlModule      "Viper"
# directory       "/home/docelic/p/debconf-backend/tree"
#
# * For automatic installations, configure the backend as seen in the example
# slapd.conf (part of Viper package), and use debconf's LDAP backend to connect
# to it. Debconf also needs to use Viper-frontend.pm as frontend (which is
# basically debconf gnome frontend with adjustments for Viper).
#
# NOTE: it is completely possible to connect to the directory with a regular
# LDAP client even in automatic install scenarios. Everything will work
# as expected and the dynamic features won't be getting in the way. (Just keep
# in mind that, in a regular LDAP client, you will not see any default entries,
# as they appear only when a certain LDAP entry is specifically requested,
# which is not how a typical general-purpose LDAP client operates. Therefore,
# to test default entries, you will most probably want to use a command-
# line program that requests and prints individually requested entries. One
# such is also included in Viper package).
#

#
# Random notes:
#
# - OpenLDAP locking is such that only one function from this file may be
# executing at a time, so no custom locking is necessary.
#
# - The backend is called from OpenLDAP's back_perl handler, which is severely
# limited when it comes to user and access control. If you need any access 
# control beyond bind DN and password, chances are you'll have to extend
# back_perl.c.
#

use strict;
use warnings;
use IO::File            qw//;
use Data::Dumper        qw/Dumper/;
use File::Find::Rule    qw/find/;
use Net::LDAP::Constant qw/LDAP_SUCCESS LDAP_PARAM_ERROR LDAP_OPERATIONS_ERROR/;
use Net::LDAP::Constant qw/LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_OTHER/;
use Net::LDAP::Constant qw/LDAP_INVALID_SYNTAX LDAP_INVALID_DN_SYNTAX/;
use Net::LDAP::Constant qw/LDAP_NOT_ALLOWED_ON_NONLEAF LDAP_FILTER_ERROR/;
use Net::LDAP::LDIF     qw//;
use Net::LDAP::Schema   qw//;
use Net::LDAP::Filter   qw//;
use Net::LDAP::FilterMatch qw//;
use Storable            qw/freeze/;
use File::Path          qw/rmtree/;

use subs                qw/p/;

# To make use of DEBUG, server must run in foreground mode. Something like:
# su -c 'LD_PRELOAD=/usr/lib/libperl.so.5.10 /usr/sbin/slapd -d 256'
use constant DEBUG    => 1; # General debug output
use constant DEBUG_OVL=> 0; # Overlays-related debug output

# Enable/disable options
use constant DYNAMIC  => 1; # Enable to unlock further dynamic suboptions:
use constant APPENDER => 1; #  Enable appending with other entries' attributes.
use constant FILEVAL  => 1; #  Enable value expansion by reading files.
use constant EXPANDVAL=> 1; #  Enable value expansion by loading DN attrs.
use constant PERLEVAL => 0; #  Enable Perl evaluation of field values.
use constant RELOCATOR=> 1; #  Enable relocation of Debconf keys.

# Search scope defines
use constant BASE     => 0;
use constant ONE      => 1;
use constant SUB      => 2;
use constant CHILDREN => 3;

# Referral chasing
use constant NEVER    => 0;
use constant ALWAYS   => 1;
use constant SEARCH   => 2;
use constant FIND     => 3;

# Raw/binary value regex
our $RAW              = qr/(?i:^jpegPhoto|;binary)/;

# LDAP scope to fs tree depth level
our %S2L= (
	1 => 1,     # ONE      (1 level)
	2 => undef, # SUB      (unlimited)
	3 => undef, # CHILDREN (unlimited)
);

# Overlays that will run on an entry if DYNAMIC== 1 and individual
# overlay is enabled. Name here should match the name of overlay's
# config array (see sub new()'s $this object) and in turn it is also
# name by which overlay will be recognized by run_overlays() within
# attribute's values. (If it doesn't make sense for you yet, skip it.)
our @OVERLAYS= ( grep { defined $_ } (
	FILEVAL   ? 'file' : undef,
	EXPANDVAL ? 'exp'  : undef,
	PERLEVAL  ? 'perl' : undef,
));


# Backend instance
sub new {
	my( $class)= @_;

	p "NEW @_";

	# Assign instance defaults. List all allowed options here,
	# even if their value is '' or 0. (Do not use undef because
	# it will implicitly make the option invalid).
	# Arrays get values pushed, scalars get values assigned.
	my $this= {
		treesuffix     => '',      # Suffix (too bad we're not called with it),
		                           # and 'suffix' directive can only be specified
		                           # before Viper.pm module so we can't get that
		                           # one. We basically have to invent a new 
		                           # directive and set it to the same value.
		directory      => '',      # Base directory / datadir for tree. Can be
		                           # different for each suffix, but suffixes in
		                           # the same directory can use each other's
		                           # fallback/default values etc.
		extension      => '.ldif', # Extension for leaf nodes (files). Can be set
		                           # to anything, but .ldif is usually most
		                           # reasonable. Note that you cannot go without
		                           # extension as that makes files and directories
		                           # indistinguishable, and breaks the server.

		addoverwrites  => 0,       # Allow ADD to overwrite existing entries?
		addignoredups  => 0,       # If overw=0, ignore ADD on existing entries?
		addrelocate    => {},      # name=>[$a,$b] for $name==loc && $dn=~ s/$a/$b/

		modifysmarts   => 1,       # Allow MODIFY to detect no-change & do no-op
		modifycopyonwrite=> 1,     # Modify & copy dfl entry to new DN if !exist?

		deletetrees    => 1,       # DELETE allows deleting of non-leafs?

		searchsubst    => [],      # List of [...->...] search subst rules
		searchdefault  => [],      # List of [$a,$b] for $dn or $dn=~ s/$a/$b/
		searchappend   => [],      # List of [$a,$t,$b,$p,$n] to append dfl attrs

		# All directives below are in form [ [$m, $nm], ... ], where $m and
		# $nm are regexes that attribute name must match and NOT match (respe-
		# ctively) for the overlay to execute on its values.
		perl           => [],      # Match/No-Match regex list for perleval
		'exp'          => [],      # Match/No-Match regex list for expandval
		file           => [],      # Match/No-Match regex list for fileval

		schemaldif     => [],      # Schema in LDIF format (to be aware of schema).
		                           # To produce schema file, start server, then use
		                           # schema.pl to retrieve schema from server in
		                           # LDIF format and dump it to a file.

		schema         => undef,   # Will contain schema (load with 'schemaLDIF')
	};

	$this->{schema}= new Net::LDAP::Schema;

	bless $this, $class
}


# Called after all configuration processing is over
sub init {
	my( $this)= @_;

	p "INIT @_";

	# Let's do some environment checking.

	# First, ensure that the root of the configured tree exists. To do that,
	# all we need to do is create the components on the way to final
	# component.
	#
	# For now we just verify the paths are there, if not, throw
	# warning.

	my $dn= $this->{treesuffix};
	$dn=~ s/^.+?,\s*//; # part of the path that needs to be there
	
	my( $ret, %ret);
	$ret= $this->dn2leaf( $dn, \%ret, qw/namesonly 1/);
	return $ret unless $ret== LDAP_SUCCESS;

	if( not -e $ret{file}) {
		warn 'Components leading up to the tree suffix are missing; ' .
			"create them and restart slapd.\n";
		return LDAP_OPERATIONS_ERROR
	}

	# Second, make sure 'extension' is non-empty, which is required. (As to
	# why, read note on 'extension' above).
	if( not $this->{extension}) {
		warn 'File extension for leaf nodes cannot be empty; ' .
			"set a value (such as '.ldif') and restart slapd.\n";
		return LDAP_PARAM_ERROR
	}

	LDAP_SUCCESS
}


# Called to verify bind credentials
sub bind {
	my( $this)= @_;

	p "BIND @_";

	# XXX Any password lets a user in.

	LDAP_SUCCESS
}


# Handle our config lines
sub config {
		my( $this, $key, @val)= @_;

		$key= lc $key;

		p "CONFIG $key @val";

		# Support config file to specify longer names of config options for
		# clarity. Internally, we use short names. I.e. a config line of 
		# "expandval opt1 opt2" is translated to "exp" internally.
		# (But you can also specify 'exp' directly (or anything in between)).
		if(!( defined $this->{$key})) {
			my @keys;
			for my $cfgkey( keys %$this) {
				push @keys, $cfgkey if $key =~ /^$cfgkey/
			}
			if( @keys== 1) { # Great, uniquely found the right key
				p "Resolved config key '$key' to '$keys[0]'";
				$key= $keys[0];
			} else {
				warn "Invalid or ambiguous config directive '$key'";
				return LDAP_PARAM_ERROR
			}
		}

		# Append suffix to all args ending in double comma (convenience helper).
		do { $_.= $this->{treesuffix} if /,,$/} for @val;

		# Very simple: if we know about this key, allow it. If not, throw error.
		if( defined $this->{$key}) {

			# Handle config directives that call for immediate work as soon
			# as they're encountered (should be only few of those):

			if( $key eq 'schemaldif') {
				my $schema= $this->{schema};

				for( @val) {
					p "Parsing schema file '$_'";

					$schema->parse( $_) or do {
						my $error= $schema->error;
						warn "Error parsing schema '$_' ($error)\n";

						return LDAP_OPERATIONS_ERROR
					}
				}
			}

			# Now generic handling:

			# If key is defined as arrayref, push [a, b, ...] onto it;
			# If key is defined as hashref, do name= [a, b, ...];
			# Otherwise, perform regular scalar assignment.
			if( ref $this->{$key} eq 'ARRAY') {
				push @{ $this->{$key}}, [ @val]

			} elsif( ref $this->{$key} eq 'HASH') {
				my $locname= shift @val;
				$this->{$key}->{$locname}= [ @val];

			} else {
				$this->{$key}= join ' ', @val
			}

		} else {
			return LDAP_PARAM_ERROR
		}

		LDAP_SUCCESS
}


# Adding entries
sub add {
    my( $this, $ldif)= @_;

		my( $ret, $entry)= $this->ldif2e( \$ldif);
		return $ret unless $ret== LDAP_SUCCESS;

		#
		# LDIF now as ENTRY, do any changes
		#

		# Normalize DN
		$this->normalize( $entry);

		#
		# Save ENTRY
		#

		my $dn= $entry->dn;

		DEBUG and p "ADD '$dn': " . ( Dumper \$ldif);

		$ret= $this->save( $dn, $entry);
		return $ret unless $ret== LDAP_SUCCESS;

		return LDAP_SUCCESS unless DYNAMIC and RELOCATOR;

		#
		# Now, see if there's any job for the relocator.
		#

		$ret= $this->check_relocation( $entry);
		return $ret unless $ret== LDAP_SUCCESS;

		LDAP_SUCCESS
}


# Searching for entries
sub search {
	my $this= shift;
	my( %req, @attrs); 
	( @req{qw/base scope deref size time filter attrOnly/}, @attrs)=@_;

	# Explanation of input parameters:
	#
	# BASE search base
	# SCOPE (0-3) base, one, sub, children
	#   base: just the one
	#   one: 1-level sub, no base
	#   sub: base + sub
	#   children: sub, no base
	# DEREF (0-3) never, always, search, find
	# SEARCH only on search
	# FIND only the base object
	# TIMELIMIT: secs, 0 - unlimited, max - max
	# SIZELIMIT: nr. entries limit. 0 -unlimited, max - max
	# FILTER: dfl (objectClass=*)
	# ATTRONLY - attributes only, no values
	# @ATTRS list of attrs to return, special: */null = all, + = operational

	# Normalize base DN
	$this->normalize( \$req{base});

	p "SEARCH @_";

	# Let's see if we have to do any substitution on input params. Substitution
	# via subst allows one to match arbitrary parameters of the search
	# request, and if all of them satisfy, then perform specified substitutions
	# on the params.
	my( $id, $i, $ok, $k, $v, $r, @stack)= ( 0);
	for my $rule( @{ $this->{searchsubst}}) {
		$id++;

		( $i, $ok, $k, $v, $r)= ( 0, 1, undef, undef, undef); # Clear vars
		$#stack= -1; # Clear stack

		# Phase 1: see if all subst conditions match
		do {
			# XXX error ckin, make sure $i/$i+1 are valid
			( $k, $v)= ( $$rule[$i], $$rule[$i+1]);

			# If rule matches, save eventual matches to @stack
			if( $req{$k}=~ /$v/) {
				push @stack, [ $1, $2, $3, $4, $5, $6, $7, $8, $9];

			} else {
				p "SEARCH SUBST #$id skipped ($k!~ /$v/)";
				$ok= 0;
				last
			}

		} while( $i+= 2 and $$rule[$i] ne '->');

		next if !$ok; # if this rule doesn't match, search further

		# Phase 2: now we know all conditions matched, so perform actual substs
		p "SEARCH SUBST #$id matched '@$rule'";
		$i++; # Skip the '->' marker

		do {
			( $k, $v, $r)= ( $$rule[$i], $$rule[$i+1], $$rule[$i+2]);
			$v=~ s/(?<!\\)\$\[(\d+)\]\[(\d+)\]/$stack[$1][$2]/g;
			$r=~ s/(?<!\\)\$\[(\d+)\]\[(\d+)\]/$stack[$1][$2]/g;

			$req{ $k}=~ s/$v/$r/; # <- substs performed here (/g needed?)

			p "SEARCH SUBST #$id action $k=~ s/$v/$r/ RESULT $req{ $k}";

		} while(
			$i+= 3
			and defined $$rule[$i]
			and defined $$rule[$i+1]
			and defined $$rule[$i+2]
		);
	}

	# Now, continue as normal

	# We were letting OpenLDAP handle filtering with filterSearchResults
	# directive, but that wasn't optimal because we weren't able to modify
	# search filter. This way we do filtering ourselves and we can do
	# anything we want anywhere we want (with filter and all other search
	# params), producing only final results for passing back onto slapd.
	my $filter= new Net::LDAP::Filter $req{ filter} or do {
		warn "Invalid filter '$req{ filter}'\n";
		return LDAP_FILTER_ERROR
	};

	my @matches= ();

	my( $ret, $newbase, %ret);
	my ($ldif, $entry);

	# First entry is always the base, if -s base or -s sub was specified
	# for search scope.
	if( $req{scope}== BASE or $req{scope}== SUB) {

		( $ret, $newbase, $ldif, $entry)=
			$this->load( $req{base}, qw/entry 1 ldif 1/);
		return $ret unless $ret== LDAP_SUCCESS;

		# If original search base was found, this is a no-op. Otherwise
		# $newbase is some fallback base found and we "switch" to it.
		$req{base}= $newbase;

		# We unshift because on return from Perl to ldap, data is read
		# in reverse order.
		unshift @matches, $ldif if $filter->match( $entry)
	}

	# Further entries may follow unless only base was specifically
	# requested with -s base
	if( $req{scope} != BASE){
		my $level= 0;

		( $ret, $req{base})= $this->resolve( $req{base}, \%ret, qw/leaf 0/);
		return $ret unless $ret== LDAP_SUCCESS;

		my $dir= $ret{directory};
		my $md= $S2L{$req{scope}};

		# Use File::Find::Rule to traverse the directory tree selectively
		# and scoop out what we want.
		File::Find::Rule->file()
			->name( '*'.$this->{extension})
			->exec( sub {
					( $ret, undef, $ldif, $entry)= $this->load( $_[2], qw/dnasfile 1/);
					return $ret unless $ret== LDAP_SUCCESS;
					unshift @matches, $ldif if $filter->match( $entry);
			} )
			->maxdepth( $md)
			->readable
			->in( $dir)
	}

	if( DEBUG and @matches) { p 'SEARCH FOUND:', scalar @matches, 'matches.' }

	( LDAP_SUCCESS, @matches)
}


# Modifying existing entries
sub modify {
    my( $this, $dn, @list)= @_;
		my $ldif;

		# Normalize DN
		$this->normalize( \$dn);

		DEBUG and p "MODIFY '$dn': " . ( Dumper \@list);

		my( $ret, $newdn, %ret, $fh, $entry, $orig);

		# Load existing entry. Done with load() so that all dynamic work
		# is honored. This allows us to compare final entry to final entry
		# (to better detect no-change situations).
		#
		( $ret, $newdn, undef, $entry)= $this->load( $dn, qw/entry 1/);
		return $ret unless $ret== LDAP_SUCCESS;

		# If entry exists, no problems -- go on with modification.
		# But if it is changed and does not exist (i.e. it comes from a fallback)
		# then we look up config option modifyCopyOnWrite. When 1, modification
		# is performed and entry is saved to where it belongs (we create&modify it)
		# However, if modifyCopyOnWrite is 0, we return LDAP_NO_SUCH_OBJECT.
		if( $dn ne $newdn) {
			if( $this->{modifycopyonwrite}) {
				p "MODIFY & COPY '$dn' to '$newdn'"
			} else {
				p "MODIFY WON'T CREATE '$newdn', modifyCopyOnWrite OFF";
				return LDAP_NO_SUCH_OBJECT
			}
		}

		$orig= $entry->clone if DYNAMIC; # For comparison when modifysmarts==1

		# Perform changes on the in-memory entry
    while ( @list > 0) {
			my( $action, $key)= ( shift @list, shift @list);

			my @values;
			while ( @list) {
				# Ignore undefined values. If a key had only one value and it was
				# undefined, it'll get deleted due to if( scalar @values) check below.
				if( defined $list[0]) {
					if( $list[0] !~ /^(ADD|DELETE|REPLACE)$/) {
						push @values, ( shift @list)
					} else {
						last
					}
				} else {
					shift @list
				}
			}

			$action= lc $action;
			next unless $key;

			if( scalar @values) {
				if(!( $entry->$action( $key, [@values]))) {
					warn "Unable to perform $action($key, ...) on '$dn'\n";
					return LDAP_OPERATIONS_ERROR
				}
			}
			else {
				# If there are no values, delete key
				if(!( $entry->delete( $key))) {
					warn "Unable to perform delete($key) on '$dn'\n";
					return LDAP_OPERATIONS_ERROR
				}
			}
		}

		# Changes to the in-memory entry have been performed correctly.
		# We can now remove the old entry and create a new one.
		# NOTE: we do NO-OP if modifysmarts==1 and entry is the same after
		# change. (Debconf submits MODIFY lines for every requested key even
		# if no values actually changed in it, so detecting this is great).
		my $changed= 1;
		if( DYNAMIC) {
			$changed= 0 if $this->{modifysmarts} and $this->dequal( $entry, $orig);
		}

		# If changed, either unconditionally (of course, since we're in modify()),
		# or really, actually changed, which is detected by dequal.
		if( $changed) {
			$ret= $this->dn2leaf( $dn, \%ret);
			return $ret unless $ret== LDAP_SUCCESS;
			$this->save( $dn, $entry, qw/overwrite 1 modify 1/);
		}

		LDAP_SUCCESS
}


# Deleting entries
sub delete {
	# XXX Make perl backend actually pass various delete options onto us.
	# (-r not possible currently because we don't receive any parms, so
	# whether non-leaf delete is allowed is controled with 'deletetrees' option)
	my( $this, $dn)= @_;

	# Normalize DN
	$this->normalize( \$dn);

	DEBUG and p "DELETE '$dn'";

	my( $ret, %ret);

	# For now, this function is deleting actual entries, not taking into
	# account various fallbacks etc. So it means it's possible to get
	# NO_SUCH_OBJECT error on delete even if you get the value when you
	# search for it. Let's see how that works in practice for a while and if
	# it needs a change or not.
	# And this is also consistent with ADD where the entries are also
	# added to specific locations.
	# In any case, to switch to a fallback-aware version (which then deletes
	# the fallback), replace dn2leaf() with resolve() and the same args.
	$ret= $this->dn2leaf( $dn, \%ret, qw/leaf 0 namesonly 1 verify 1/);
	return $ret unless $ret== LDAP_SUCCESS;

	# If entry ain't there in the first place...
	return LDAP_NO_SUCH_OBJECT if !$ret{file} and !$ret{directory};

	if( defined $ret{directory}) {
		if( $this->{deletetrees}) { $ret= rmtree $ret{directory}  }
		else                   { $ret= rmdir $ret{directory} }

		if( not $ret) {
			return LDAP_OPERATIONS_ERROR if $!== 13;       # EACCESS
			return LDAP_NOT_ALLOWED_ON_NONLEAF if $!== 39; # ENOTEMPTY
			return LDAP_OTHER
		}
	}

	# $ret{file} should always be defined if we reach here, but if directory
	# exists and file does not, in dn2leaf we don't halt but issue a serious
	# warning and resume processing, so in that case it may be undefined.
	if( defined $ret{file}) {
		unlink $ret{file} or return LDAP_OPERATIONS_ERROR
	}

	LDAP_SUCCESS
}


#
# Helper functions below
#

# A function with a lot of built-in value. Given DN OR FILE,
# reads it in, performs all dynamic operations and returns final
# entry as either entry object or ldif.
# Error handling and everything is proper, feel free to propagate
# non-success return value back to OpenLDAP.
sub load {
	my( $this, $dn, %opts)= @_;
	%opts= (
		dnasfile => 0,
		ldif     => 0, # currently either ldif or entry
		entry    => 0,
		%opts,
	);
	$opts{ldif}= 1 unless $opts{entry};

	DEBUG and p "LOAD '$dn', opts: ", join( ' ', %opts);

	my( $ret, %ret);

	# Default to return as ldif if nothing specified
	# XXX see this conditional 'my'
	my $open_as= 'entry' if DYNAMIC or $opts{entry};
  $open_as||= 'ldif';

	# Find our base entry, with possible fallbacks etc. (Note that the entry
	# is right away opened here as entry object or filehandle through %opts).
	( $ret, $dn)= $this->resolve( $dn, \%ret,
		$open_as, 1, 'dnasfile', $opts{dnasfile});
	return $ret unless $ret== LDAP_SUCCESS;

	# Entry will not be initialized if $open_as != 'entry'
	my( $entry, $fh)= @ret{qw/entry fh/};
	my $ldif= '';

	if( $open_as eq 'entry') {
		# If open as entry, and dynamic functions are enabled, do the whole thing.
		if( DYNAMIC) {
			$this->run_appender( $entry) if APPENDER;
			$this->run_overlays( $entry)
		}

		# If we opened as entry but need to return as ldif, convert.
		if( $opts{ldif}) {
			# Entry -> LDIF
			open my $out, '>', \$ldif;
			my $writer= new Net::LDAP::LDIF (
				$out, 'w',
				change => 0,
				raw => $RAW
			);
			if(!( $writer->write_entry( $entry))) {
				warn "Can't write_entry('$dn') to scalar\n";
				return LDAP_OPERATIONS_ERROR
			}
			$writer->done;
		}

	} else {
		# If dynamic functions are not used, and we need ldif output,
		# we can read in file data directly, without any in-memory 
		# conversion to entry object.
		$ldif= new Net::LDAP::LDIF $fh;

		if( $ldif->error) {
			warn 'LDIF Load Error: '.$ldif->error.': '.$ldif->error_lines;
			return LDAP_OPERATIONS_ERROR
		}

		unless( $fh->close) {
			warn "Can't rdclose '$ret{file}' ($!)\n";
			return LDAP_OPERATIONS_ERROR
		}
	}

	$ldif and $ldif=~ s/^\s*//s; # !@#$%^& LDIF write_entry outputs \n at the top!
	( LDAP_SUCCESS, $dn, $ldif, $entry)
}

# Main function converting DNs to filesystem hierarchy. Optionally, it 
# can create missing paths, read/write/overwrite entries, return open
# file handle, etc.
# Additionally, this function was extended to accept filename in place
# of DN when option dnasfile=1. Most often, this is done when
# subtree is requested in search results, so Find routine goes reading
# in file by file, and does not need various DN resolving, but can still
# benefit from various file open functionalities built-in to dn2leaf.
sub dn2leaf {
	my( $this, $dn, $ret, %opts)= @_;
	%opts= (
		# List defaults here
		dnasfile => 0, # DN passed is a file we want to open?
		leaf     => 1, # Last element in path is entry? (if leaf=0, it's a dir)
		writeop  => 0, # Some write operation or pure read?
		overwrite=> 0, # Overwrite if exists? (Allows ADD on existing entries)
		openfh   => 0, # Open the file and return filehandle?
		entry    => 0, # Return Net::LDAP::Entry?
		verify   => 0, # Verify that fs path components exists. Ret '' if not.
		namesonly=> 0, # Return leaf name and dir name of an entry.
		# And overlay with caller options
		%opts
	);

	DEBUG and p "DN2LEAF '$dn', opts: ", join(' ', %opts);

	my( $file, $directory);

	# Quick provision for re-using this function's code even in cases
	# where DN passed is literal file we want to open and read in.
	# (Most notably in returning results from subtree traversals).
	if( $opts{dnasfile}) {
		$file= $dn;
		( $directory= $file) =~ s{/.[^/]*$}{};
		goto DN_AS_FILE
	}

	# Must be normalized by the time we reach here
	$dn =~ /^[a-z0-9,=\/_\.-]+$/ or do {
		warn "DN2LEAF Invalid or non-normalized DN '$dn'";
		return LDAP_INVALID_DN_SYNTAX
	};

	# First, split DN into filesystem path
	my @paths= reverse( split ',', $dn);
	# XXX testing if allowing dots would cause any problems
	#s{\.}{}g for @paths; # Dot is not allowed
	s{/}{.}g for @paths; # Slashes are converted to dots

	my $leaf;

	$leaf= pop @paths if $opts{leaf};

	# Important that this rewinds $currdir to the right place and does
	# the right things if we're going for any filesystem work besides reading.
	if( $opts{writeop}) {
		my $currdir=$this->{directory};
		my @i= @paths;
		while ( my $comp = shift @i) {

			$currdir .= '/'.$comp;
			my $currfile = $currdir . $this->{extension};

			if( ! -r $currfile) {
				p "DN2LEAF -r '$currfile': $!\n";
				return LDAP_NO_SUCH_OBJECT

			# We could create dir along with .ldif file on every ADD, but that would
			# leave us with empty dirs for all leaf entries. So to avoid that, we
			# create the directory only when subentries are to be placed in it.
			# The cost of this is a bit more complex elsif as follows:
			} elsif( ! -d $currdir) {
				if( @i or ( !@i and $leaf)) {
					mkdir $currdir or do {
						warn "dn2leaf: mkdir '$currdir': $!\n";
						return LDAP_OPERATIONS_ERROR
					};
				} elsif( @i) {
					return LDAP_NO_SUCH_OBJECT
				}
			}
		}
	}

	$directory= join( '/', $this->{directory}, @paths);

	push @paths, $leaf if $leaf;

	$file= join( '/', $this->{directory}, @paths).$this->{extension};

	if( $opts{namesonly}) {
		# If names only requested, return file and directory (subtree) name
		# of the corresponding entry. If verify=1, if they do not exist on
		# the filesystem, '' is returned in place of file or dir.

		# If verify==0, return whatever the fs path appears to be. Otherwise,
		# return undef if file or directory is not actually there.
		if( ! -e $directory) { $directory= $opts{verify} ? undef : $directory}

		if( ! -e $file) {
			# Small consistency check -- this should never happen:
			if( defined $directory and $directory ne $this->{directory}) {
				warn "WARNING: data tree inconsistency: directory about to be used, " .
					"but file '$file' missing.\n";
			}
			$file= $opts{verify} ? undef : $file
		}

		@$ret{qw/file directory/}= ( $file, $directory);
		return LDAP_SUCCESS
	}

	DN_AS_FILE:

	$opts{openfh}= 1 if $opts{entry} or $opts{ldif};

	if( -e $file) {
		if( $opts{writeop} and !$opts{overwrite}) {
			p "DN2LEAF WON'T OVERWRITE: '$dn'\n";
			return LDAP_ALREADY_EXISTS
		} else {
			p "DN2LEAF FOUND '$dn'"; # in file '$file'";
		}
	} else {
		if( $opts{openfh}) {
			p "DN2LEAF NOT FOUND '$dn'"; # in file '$file'";
			return LDAP_NO_SUCH_OBJECT
		}
	}

	my $fh;

	if( $opts{writeop}) {
		$fh= new IO::File "> $file";
		defined $fh or do {
			warn "Can't wropen '$file' ($!)\n";
			return LDAP_OPERATIONS_ERROR
		};
	}
	elsif( $opts{openfh}) {
		$fh= new IO::File "< $file";
		defined $fh or do {
			warn "Can't rdopen '$file' ($!)\n";
			return LDAP_OPERATIONS_ERROR
		};
	}

	my $entry;

	if( $fh and $opts{entry}) {
		my $ldif= new Net::LDAP::LDIF $fh;

		if( $ldif->error) {
			warn 'LDIF Load Error: '.$ldif->error.': '.$ldif->error_lines;
			return LDAP_OPERATIONS_ERROR
		}

		$entry= $ldif->read_entry;

		unless( $fh->close) {
			warn "Can't rdclose '$file' ($!)\n";
			return LDAP_OPERATIONS_ERROR
		}
	}

	@$ret{qw/file fh directory entry/}= ( $file, $fh, $directory, $entry);

	LDAP_SUCCESS
}

# Quick debug print. p(...)
sub p { if( DEBUG) { print STDERR '### ', join( ' ', @_), "\n" } }

# Deep comparison of arbitrary structures
sub dequal {
  my( $this, $a_ref, $b_ref) = @_;
  local $Storable::canonical = 1;
  return freeze( $a_ref) eq freeze( $b_ref)
}

# Resolve DN->file.ldif. Takes into account fallbacks and everything else.
sub resolve {
	my( $this, $obase, $oret, %opts) = @_;

	DEBUG and p "RESOLVE '$obase', opts:", join( ' ', %opts);

	# Open entry
	my $ret= $this->dn2leaf( $obase, $oret, %opts);
	# If not there, loop over defaults
	if( $ret != LDAP_SUCCESS) {

		# Weird to see error happen if DN was specific file...
		# some permission error on file?
		return LDAP_OTHER if $opts{dnasfile};

		for( @{ $this->{searchdefault}}) {
			my $base = $obase;
			# If substitution from config file is successful
			if( $base=~ s/$$_[0]/$$_[1]/) {
				p "RESOLVE FALLBACK TO '$base'";

				$ret= $this->dn2leaf( $base, $oret, %opts);
				next unless $ret == LDAP_SUCCESS;
				return( $ret, $base) # If we reach here, some default base was found
			}
		}
	}
	( $ret, $obase)
}

# Function able to read a file and return it all, or according to $spec
# (specific linenumber or line matching a regex)
sub read_file {
	my( $this, $file, $spec) = @_;

	$file =~ s/\.\./\./g;
	$file = $this->{directory} . '/' . $file;

	DEBUG and p "READ FILE '$file'";

	my( $fh, @data);

	$fh= new IO::File "< $file";
	defined $fh or do {
		warn "Can't rdopen '$file' ($!)\n";
		return ''
	};

	@data= <$fh>;

	unless( $fh->close) {
		warn "Can't rdclose '$file' ($!)\n";
		return ''
	}

	# Spec may be a number (line number), or a regex. If it
	# is specified, the specific line number or $1 from the first
	# line matching the regex is returned. If not found, empty string
	# is returned.
	if( $spec =~ /^\d+$/) {
		return defined $data[$spec] ? $data[$spec] : ''
	} elsif( $spec) {
		for( @data) {
			return defined $1 ? $1 : $_ if /$spec/
		}
		return ''
	}

	# If here, no spec was given, so return whole file.
	wantarray ? @data : join '', @data
}

# Save LDIF string to given DN.
# $ldif can directly be an entry and it's then first converted to
# LDIF.
# File we save to is determined from $dn, not dn: specified in ldif.
sub save {
	my( $this, $dn, $ldif, %opts)= @_;

	my( $ret, %ret);

	# If we were called with an entry, turn it to LDIF.
	$ldif= $this->e2ldif( $dn, $ldif) if ref $ldif;

	# Locate/resolve the file to which we'll save data and open filehandle
	# to it. Two things can also be specified in the config file which
	# affect behavior:
	#  addoverwrites= 1/0  -- overwrite existing entry with new ADD?
	#  addignoredups= 0/1  -- if overwrite=0, do we complain or ignore the ADD?
	$ret= $this->dn2leaf( $dn, \%ret,
		qw/writeop 1/, 'overwrite', $this->{addoverwrites},
		%opts);
	if( $ret!= LDAP_SUCCESS and !$opts{modify}) {
		return LDAP_SUCCESS if
			$ret== LDAP_ALREADY_EXISTS and $this->{addignoredups};
		return $ret
	}

	# Save ldif data into file
	my $fh= $ret{fh};
	unless( print $fh $ldif) {
		warn "Can't print to '$ret{file}' ($!)\n";
		return LDAP_OPERATIONS_ERROR
	}

	# Close file
	unless( $fh->close) {
		warn "Can't wrclose '$ret{file}' ($!)\n";
		return LDAP_OPERATIONS_ERROR
	}

	LDAP_SUCCESS
}

# Entry 2 LDIF
sub e2ldif {
	my( $this, $dn, $entry)= @_;

	my $ldif= '';
	open my $out, '>', \$ldif;
	my $writer= new Net::LDAP::LDIF (
		$out, 'w',
		change => 0,
		raw => $RAW
	);
	if(!( $writer->write_entry( $entry))) {
		warn "Can't write_entry('$dn') to scalar\n";
		return LDAP_OPERATIONS_ERROR
	}
	$writer->done;

	$ldif =~ s/^\s*//s; # !@#$%^& LDIF write_entry outputs \n at the top!

	$ldif
}

# LDIF 2 entry
sub ldif2e {
	my( $this, $ldifref)= @_;

	# Turn $ldif into an entry object right away.
	open my $fh, '<', $ldifref;
	my $input= new Net::LDAP::LDIF $fh;
	my $entry= $input->read_entry;

	if( $input->error) {
		warn 'LDIF Load Error: '.$input->error.': '.$input->error_lines;
		return LDAP_OPERATIONS_ERROR
	}

	unless( $fh->close) {
		warn "Can't rdclose filehandle on scalar ($!)\n";
		return LDAP_OPERATIONS_ERROR
	}

	( LDAP_SUCCESS, $entry)
}

# Normalize. Can give scalar ref (just a DN), or a whole entry so possibly
# more than DN normalization will be done.
sub normalize {
	my( $this, $ptr)= @_;

	# Just in case we only get DN as a scalar to normalize.
	if( ref $ptr eq 'SCALAR') {
		$$ptr= lc $$ptr;
		$$ptr=~ s/\s+//g;
	} else {
		( my $dn= lc $ptr->dn)=~ s/\s+//g;
		$ptr->dn( $dn);
	}

	LDAP_SUCCESS
}

# Relocator code looks for 'variables' attribute in the Debconf entry
# ('variables' is defined in debconf.schema and as this is debconf-
# specific, it should make sense to enable it only under the debconf tree).
# If variables exist, parse them to grep out viper_location=NAME (there
# should always be none or one found).
# If name matches a known relocation recipe, perform DN regex replacement
# that corresponds to this named relocation, and actually relocate it.
sub check_relocation {
	my ($this, $entry, $where)= @_;

	my ($ret, @variables);

	# No work if there's no 'variables' attribute
	return LDAP_SUCCESS unless @variables= $entry->get_value( 'variables');

	my $dn= $entry->dn;

	my $location_name= ''; # Wanted relocation place

	# XXX Safety check, remove when confident it's not happening
	# We don't want two var=value definitions in the single attribute value.
	for( @variables) {
		if( /=.+=/) {
			warn "***** Multiple '=' found in $dn variables attribute, skipping relocation *****\n";
			return LDAP_SUCCESS
		}
	}

	# Extract location we want to relocate to and remove it from the 
	# variables list. (Implementation without removal would be more
	# elegant, but I think it's better to remove them).
	my @variables2;
	for( @variables) {
		if( /viper_location=(.+)/) {
			$location_name= $1
		} else {
			push @variables2, $_
		}
	}

	# No work if no viper_location= specified among variables
	return LDAP_SUCCESS unless $location_name;

	# If the location specification was found, replace variables with
	# whatever is left after taking viper_location= out of the list, and
	# relocate the entry.
	if( @variables!= @variables2) {
		if( @variables2) {
			$entry->replace( 'variables', [ @variables2]);
		} else {
			$entry->delete( 'variables');
		}

		$ret= $this->relocate( $entry, $location_name);
		return $ret unless $ret== LDAP_SUCCESS;
	}

	LDAP_SUCCESS
}

# Move entry from place to place on the filesystem.
# $loc should be one of configured relocation regexes.
sub relocate {
	my( $this, $entry, $loc)= @_;

	my $dn= $entry->dn;
	my $newdn= $dn;

	$loc||= 'Site';

	# NOTE: Delete is disabled in default configurations. (To enable, add
	# "Delete" under Choices: for the template/config-location templates).
	if( $loc eq 'Delete') {
		$this->delete( $dn);
		return LDAP_SUCCESS
	}

	# If the relocation rule is defined, go through the whole cycle.
	# If not, we'll re-save the entry to its existing place.
	# (Relocation rule is not defined for location=Host (since that's
	# effectively no relocation), but we still want to remove
	# the variable from the entry and save that.)
	if( exists( $this->{addrelocate}->{$loc})) {
		my( $a, $b)= @{$this->{addrelocate}->{$loc}};

		unless( $newdn=~ s/$a/$b/) {
			warn sprintf("***** Regex for %s does not apply (%s =~ s/%s/%s/), skipping relocation *****\n", $loc, $dn, $a, $b);
			return LDAP_SUCCESS
		}
	}

	$entry->dn( $newdn);
	$this->save( $newdn, $entry);
	$this->delete( $dn) if $newdn ne $dn;

	LDAP_SUCCESS
}


#
# Our vision of overlays
#

# Overlays have been put together in a single function for excellent
# efficiency, but here are their individual descriptions, in order
# of execution, soonest-first:

# File expansion overlay. Usage:
# $ file $ /path/to
# Path is always treated relative to $this->{directory} (data dir) 
# and any double dots are replaced by a single dot.

# Values expansion overlay. Usage:
# $ exp $ ENTRY_DN ATTRIBUTE VALX $
# If entry_dn ends with ",", tree suffix is appended to it so you don't have
# to write it manually each time.
# Attribute is attribute whose value you want to insert.
# Val_x is value number if there are multiple values, defaulting to first.

# Perl evaluation overlay. (Disabled by default).
# Receives a pointer to entry and one of
# its attributes which should be non-raw (non-binary). Loops over
# configured perleval regexes; if any configured [match, no-match] pair
# matches attribute name, its values are subjected to possible evaluation.
# Each value that contains string '\s?$\s?', it is split on it into components,
# and each occurence of $ perl $ sets next component for evaluation.
# In the end, all '$ perl $' components are removed, and new values
# are composed of the remaining values, some of which are result of 
# evaluation (if $ perl $ preceded them), and some of which are static.
# New values replace attribute value in the entry.

# Now before the all-in-one overlay sub, here's a small separate functionality
# chunk that first appends then entry with attributes from other entries
# according to 'searchappend' config directive.
sub run_appender {
	my( $this, $e)= @_;

	# Appender syntax can get hard to keep in mind all the time, so here's the
	# list of available ways to set it up, and the corresponding explanations:
	#
	# <attr> <value_regex> ... -> attr   <attrName>   [attrAttr]   [attrs]
	# <attr> <value_regex> ... -> append <regex_what> <regex_with> [attrs]
	#
	# Explanations:
	#
	# 0) <attr> <value_regex> is a list of attr/value pairs. All pairs must
	#    match on an entry to make it a candidate for appending.
	#
	# 1) 'attr' method: look up <attrName> attribute in each entry
	#    found. Its values are DNs which we should look up to append the
	#    original entry.
	#    Then: if there are no <attrAttr> values nor [attrs] list is given,
	#    append entry with all attributes from lookup DN.
	#    Otherwise, append only with attributes listed in [attrs] and
	#    <attrAttr> attribute.
	#
	# 2) 'append' method: similar to 1), but DN to look up is not read from 
	#    <attrName> in the entry but is derived in-place by doing
	#    $lookup_DN= ( $entry_DN=~ s/regex_what/regex_with/).
	#    Also, similarly, either all attributes are appended, or only those
	#    listed in [attrs].

	my( $ret, %ret);

	my( $id, $i, $ok, $k, $v, $r, @stack)= ( 0); # $id= 0
	for my $rule( @{ $this->{searchappend}}) {
		$id++;

		( $i, $ok, $k, $v, $r)= ( 0, 1, undef, undef, undef); # Clear vars
		$#stack= -1; # Clear stack

		# Phase 1: see if all append conditions match
		do {
			# XXX error ckin, make sure $i/$i+1 are valid
			( $k, $v)= ( $$rule[$i], $$rule[$i+1]);

			my @cond;

			if( $k eq 'dn') { @cond= $e->dn }
			else{ @cond= $e->get_value( $k) }

			my $local_ok= 0;
			for my $cond( @cond) {
				if( $cond=~ /$v/) {
					$local_ok= 1;
					last
				}
			} # FOR my $cond

			if( !$local_ok) {
				p "SEARCH APPEND #$id skipped ($k!~ /$v/)";
				$ok= 0;
			}

		} while( $i+= 2 and $$rule[$i] ne '->');

		next if !$ok; # if this rule doesn't match, search further

		# Phase 2: now we know all conditions matched, so go on
		p "SEARCH APPEND #$id matched '@$rule'";
		$i++; # Skip the '->' marker

		# Attrs specifically listed in cfg file are ALWAYS included from lookup
		# DN into the original entry, and are free of all suitability checks,
		# to satisfy admin who absolutely wants to add them.
		my @lookup_attrs;
		@lookup_attrs= @$rule[$i+3..$#$rule] if $$rule[$i+3];

		if( $$rule[$i] eq 'attr') {
			
			# List of DNs to lookup (usually contained in seeAlso attr.)
			my @dnattrs= $e->get_value( $$rule[$i+1]);

			# Attribute containing attrs from seeAlso to add (often 'seeAlsoAttr')
			push @lookup_attrs, $e->get_value( $$rule[$i+2]); # XXX undef/'' slips in?

			# If no attrs found through seeAlsoAttr spec, then assume all attrs
			# from lookup DN are expected to be added.
			my $add_entry_attrs;
			$add_entry_attrs= 1 if not @lookup_attrs;

			for my $dn( @dnattrs) {

				$this->normalize( \$dn);
				$ret= $this->dn2leaf( $dn, \%ret, qw/entry 1/);

				my $ae= $ret{entry};

				push @lookup_attrs, $ae->attributes if $add_entry_attrs;

				# "uniq" the array elements
				my %lookup_attrs= map { $_ => 1 } @lookup_attrs;
				@lookup_attrs= keys %lookup_attrs;

				# XXX Optimize this loop
				for my $a( @lookup_attrs) {

					# Consider only nonexistent args for appending
					next if $e->get_value( $a);

					# Determine if the attribute is allowed by schema, skip if not.
					# XXX MEMOIZE
					my $may= 0;
					my @can;
					for my $oc( $e->get_value( 'objectClass')) {
						push @can, $this->{schema}->may( $oc);
					}
					for( @can) {
						if( $_->{name} eq $a) { $may= 1; last }
					}
					next if not $may;

					# So now we know we can add it.

					my @v= $ae->get_value( $a);

					$e->add( $a, [ @v])

				} # FOR $a ( $dnattr->attrs)

			} # FOR $dn ( @dnattr)

		} elsif( $$rule[$i] eq 'append') {
			( my $dn= $e->dn)=~ s/$$rule[$i+1]/$$rule[$i+2]/;

			# XXX JOIN THE TWO LOOPS 

			# If no attrs found through seeAlsoAttr spec, then assume all attrs
			# from lookup DN are expected to be added.
			my $add_entry_attrs;
			$add_entry_attrs= 1 if not @lookup_attrs;

			$this->normalize( \$dn);
			$ret= $this->dn2leaf( $dn, \%ret, qw/entry 1/);

			my $ae= $ret{entry};

			push @lookup_attrs, $ae->attributes if $add_entry_attrs;

			# "uniq" the array elements
			my %lookup_attrs= map { $_ => 1 } @lookup_attrs;
			@lookup_attrs= keys %lookup_attrs;

			# Expand objectClasses list
			my @ocs= $e->get_value( 'objectClass');
			my @newocs= $ae->get_value( 'objectClass');
			for my $oc( @newocs) {
				if( not grep {/^$oc$/} @ocs) {
					$e->add( 'objectClass', $oc)
				}
			}

			# XXX Optimize this loop
			for my $a( @lookup_attrs) {

				# Consider only nonexistent args for appending
				next if $e->get_value( $a);

				# Determine if the attribute is allowed by schema, skip if not.
				# XXX MEMOIZE
				my $may= 0;
				my @can;
				for my $oc( $e->get_value( 'objectClass')) {
					push @can, $this->{schema}->may( $oc);
				}
				for( @can) {
					if( $_->{name} eq $a) { $may= 1; last }
				}
				next if not $may;

				# So now we know we can add it.

				my @v= $ae->get_value( $a);

				$e->add( $a, [ @v])

			} # FOR my $a

		} # IF $$rule[$i] eq 'attr|append'

	} # FOR my $rule

}

# Ok, here the all-in-one overlay sub. It's a bit nested so hang on
# in there. Each overlay's code is only a few lines in the innermost
# block.
sub run_overlays {
	my( $this, $e)= @_;

	# $e= entry , $a= attribute, $v= attr. value

	for my $a( $e->attributes) {
		next if $a =~ /$RAW/; # Skip attribute if raw/binary

		for my $ovl ( @OVERLAYS) {

			for my $cond( @{ $this->{$ovl}}) {
				if( $a =~ /$$cond[0]/ and $a !~ /$$cond[1]/ ){
					# Ok, so overlay is configured with at least one line in
					# slapd.conf and that line matches our attribute name.

					DEBUG_OVL and p "OVERLAY $ovl on '$a' due to rule @$cond";

					my @v= $e->get_value( $a);
					for my $v( @v) {
						if( index( $v, '$') != -1) {
							# Ok, there are at least two components in this 
							# attribute's value, so it makes sense for us to run.

							my @comps;
							my @splits= ( [] );
							# Fill @comps with components split on \s*\$\s*, but 
							# also remember the exact splitter that was used. (For
							# later re-construction of components that we did not
							# modify and for inserting appropriate space before/after
							# the processed components).
							while ( $v =~ /(\s*)\$(\s*)/) {
								my( $pre, $post)= (
									(defined $1 ? $1 : ''),
									(defined $2 ? $2 : ''),
								);
								my $c;
								( $c, $v )= split /$pre\$$post/, $v, 2;
								push @comps, $c;
								push @splits, [ $pre, $post]
							}
							push @comps, $v;

							# Now run; loop over all components and see if any has
							# the name of our overlay, and if yes, do whatever the
							# overlay's function is on the next component.
							# (i.e.  perl $ 3 + 4 ===> 7 )
							my $run= 0;
							for my $comp( @comps) {
								if( $run) {
									$run= 0;

									# OVERLAY FILEVAL
									if( $ovl eq 'file') {
										# We want to include file contents
										my( $file, $spec)= split /\s+/, $comp;
										$comp= $this->read_file( $file, $spec);
										chomp $comp;

									# OVERLAY EXPANDVAL
									} elsif( $ovl eq 'exp') {
										# Ok, we want to expand to some DN's attribute
										my @f= split /\s+/, $comp; # @f== (dn, attr, valx)
										my ( $dn, $attr, $vid, $ret, $ent);
										# If less than 3 args given, we want attr/vid in the
										# current entry
										if( @f< 3) { $ent= $e; ($attr, $vid)= (@f, 0) }
										else {
											($dn, $attr, $vid)= @f;
											if( $dn =~ /,$/) { $dn .= $this->{treesuffix} }
											( $ret,undef,undef,$ent)= $this->load( $dn, qw/entry 1/);
											return $ret unless $ret== LDAP_SUCCESS;
										}
										my @vals= $ent->get_value( $attr);
										$comp= $vals[$vid]

									# OVERLAY PERLEVAL
									} elsif( $ovl eq 'perl') {
										# XXX Eval error handling, sandbox
										$comp= eval $comp;
									}

								} elsif( $comp eq $ovl) {
									$run= 1 # Operate on the next component
								}
							}
							my $skip= 0;
							$v= '';
							# Now, after overlay has operated on the individual components,
							# put the thing back together into an attribute value, BUT
							# honoring original elements used for splitting components.
							for( my $i=0; $i < @comps; $i++) {
								my $comp= defined $comps[$i] ? $comps[$i] : '';
								if( $comp eq $ovl) {
									$v.= $splits[$i][0];
									$skip= 2
								} elsif( $skip== 2) {
									$v .= $comp;
									$skip--
								} elsif( $skip== 1) {
									$v.= $splits[$i][1] . $comp;
									$skip--
								} else {
									if( $i> 0) {
										$v.= $splits[$i][0] . '$' . $splits[$i][1];
									}
									$v.= $comp
								}

							} # FOR $comp

						} # IF '$' present (value has at least 2 components)

					} # FOR my $v

					$e->replace( $a, [ @v ]);
					last # As soon as regex matched and overlay ran, we're done with it.

				} # IF $cond matched

			} # FOR my $cond (condition)

		} # FOR my $ovl (overlay)

	} # FOR my $a (attribute)

}

#
# Yet to be ported over and coded properly
#

sub compare {
    print {*STDERR} "Here in compare, @_\n";
    my $this= shift;
    my( $dn, $avaStr)= @_;
    my $rc= 5;    # LDAP_COMPARE_FALSE

    $avaStr =~ s/=/: /m;

    if( $this->{$dn} =~ /$avaStr/im) {
        $rc= 6;    # LDAP_COMPARE_TRUE
    }

    return $rc;
}

sub modrdn {
    print {*STDERR} "Here in modrdn, @_\n";
    my $this= shift;

    my( $dn, $newdn, $delFlag)= @_;

    $this->{$newdn}= $this->{$dn};

    if( $delFlag) {
        delete $this->{$dn};
    }
    return 0;

}

1