package LISM::Storage;

use strict;
use Net::LDAP::Constant qw(:all);
use Digest::MD5;
use Digest::SHA1;
use MIME::Base64;
use POSIX;
use Encode;
use Sys::Syslog;
use Sys::Syslog qw(:macros);
use Data::Dumper;

our $maxLoopCount = 10;

=head1 NAME

LISM::Storage - an base class for LISM storage implementations

=head1 DESCRIPTION

This class is meant as an interface to access arbitrary storage.

=head1 CONSTRUCTOR

This is a plain constructor.

=cut

sub new
{
    my $class = shift;
    my ($suffix, $contentry) = @_;

    my $this = {};
    bless $this, $class;

    $this->{suffix} = $suffix;
    $this->{contentrystr} = $contentry;

    return $this;
}

=head1 METHODS

=head2 config($conf)

Set configuration data.

=cut

sub config
{
    my $self = shift;
    my ($conf) = @_;

    $self->{_config} = $conf;

    return 0;
}

=pod

=head2 init

Initailize the storage object.
Returns 0 if it complete successfully.

=cut

sub init
{
    my $self = shift;
    my $conf = $self->{_config};

    $conf->{numloglevel} = {debug => LOG_DEBUG,
                            info => LOG_INFO,
                            notice => LOG_NOTICE,
                            warning => LOG_WARNING,
                            error => LOG_ERR,
                            critical => LOG_CRIT,
                            alert => LOG_ALERT,
                            emergency => LOG_EMERG
                           };

    # check configuration
    if ($self->_checkConfig()) {
        $self->log(level => 'alert', message => "Configuration error");
        return -1;
    }

    return 0;
}

=pod

=head2 commit

This method is called when L<LISM> commit the update of storage.

=cut

sub commit
{
    die("must be overridden");
}

=pod

=head2 rollback

This method is called when L<LISM> rollback the update of storage.

=cut

sub rollback
{
    die("must be overridden");
}

=pod

=head2 bind

This method is called when L<LISM> do the bind operation.
Returns 0 if the authentication succeeds.

=cut

sub bind
{
    my $self = shift;
    my($binddn, $passwd) = @_;
    my $conf = $self->{_config};

    if ($self->_getConnect()) {
        return LDAP_SERVER_DOWN;
    }

    my ($rc, $obj, $pkey) = $self->_getObject($binddn);
    if ($rc) {
        return $rc;
    }

    DO: {
        my $entry;
        my $key;

        ($rc, $key, $entry) = $self->_baseSearch($obj, $pkey, $binddn, 0, 0, 1, 0, undef);
        if ($rc) {
            last DO;
        }
        my ($usrpwd) = ($entry =~ m#^(userpassword:.*)$#m);

        # hash the password
        my $hash = $self->_pwdFormat("userpassword: ".$self->hashPasswd($passwd, substr($usrpwd, 0, 2)));

        # validate the password
        if ($usrpwd ne $hash) {
            $rc = LDAP_INVALID_CREDENTIALS;
        }
    }

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 search

This method is called when L<LISM> do the search operation.
Returns 0 if it completes successfully.

=cut

sub search
{
    my $self = shift;
    my($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs ) = @_;
    my $conf = $self->{_config};
    my @match_entries = ();

    my $filter = Net::LDAP::Filter->new($filterStr);
    if (!defined($filter)) {
        return (LDAP_FILTER_ERROR, ());
    }

    if ($self->_getConnect()) {
        return (LDAP_SERVER_DOWN, ());
    }

    my ($rc, @objs) = $self->_searchObjects($base, $scope);
    if ($rc) {
        return ($rc, @match_entries);
    }

    # get entry of data container
    if ($base =~ /^$self->{suffix}$/) {
        if ($scope != 1) {
            my $entry = $self->{contentrystr};
            if ($self->parseFilter($filter, $entry)) {
                push (@match_entries, $entry);
                $sizeLim--;
            }
        } else {
            $scope = 0;
        }
    }

    foreach my $objinfo (@objs) {
        my ($obj, $pkey) = @{$objinfo};
        my $objbase = $base =~ /^$self->{suffix}$/ ? $obj->{suffix} : $base;
        my $entry;
        my $key;

        # search base entry
        ($rc, $key, $entry) = $self->_baseSearch($obj, $pkey, $objbase, $scope, $deref, $sizeLim, $timeLim, $filter);
        if ($entry) {
            push(@match_entries, $entry);
            $sizeLim = $sizeLim - $entry;
        }

        if ($rc) {
            last;
        }

        # search entries below base
        my @entries;
        my $keys;

        ($rc, $keys, @entries) = $self->_childSearch($obj, $key, $objbase, $scope, $deref, $sizeLim, $timeLim, $filter);
        push(@match_entries, @entries);
        $sizeLim = $sizeLim - @entries;

        if ($rc) {
            last;
        }
    }

    $self->_freeConnect();

    if ($rc && $rc != LDAP_SIZELIMIT_EXCEEDED) {
        @match_entries = ();
    }

    return ($rc, @match_entries);
}

=pod

=head2 compare

This method is called when L<LISM> do the compare operation.
Returns 6 if the compared value exist, 5 if it doesn't exist.

=cut

sub compare
{
    my $self = shift;
    my ($dn, $avaStr) = @_;

    my ($attr, $val) = split(/=/, $avaStr);

    if ($self->_getConnect()) {
        return LDAP_SERVER_DOWN;
    }

    my ($rc, $obj, $pkey) = $self->_getObject($dn);
    if ($rc) {
        return $rc;
    }

    DO: {
        my $entry;
        my $key;

        ($rc, $key, $entry) = $self->_baseSearch($obj, $pkey, $dn, 0, 0, 1, 0, undef);
        if ($rc) {
            last DO;
        }

        # compare the value
        $entry = encode('utf8', $entry);
        if ($entry =~ /^$attr: $val$/m) {
            $rc = LDAP_COMPARE_TRUE;
        } else {
            $rc = LDAP_COMPARE_FALSE;
        }
    }

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 modify

This method is called when L<LISM> do the modify operation.
Returns 0 if it completes successfully.

=cut

sub modify
{
    my $self = shift;
    my ($dn, @list) = @_;

    if ($self->_getConnect()) {
        return LDAP_SERVER_DOWN;
    }

    my ($rc, $obj, $pkey) = $self->_getObject($dn);
    if ($rc) {
        return $rc;
    }

    return $self->_objModify($obj, $pkey, $dn, @list);
}

=pod

=head2 add

This method is called when L<LISM> do the add operation.
Returns 0 if it completes successfully.

=cut

sub add
{
    my $self = shift;
    my ($dn, $entryStr) = @_;

    # check rdn's value
    my ($rdn, $rdn_val) = ($dn =~ /^([^=]+)=([^,]+),/);
    if ($entryStr !~ /^$rdn: $rdn_val$/mi) {
        return LDAP_NAMING_VIOLATION;
    }

    if ($self->_getConnect()) {
        return LDAP_SERVER_DOWN;
    }

    my ($rc, $obj, $pkey) = $self->_getObject($dn);
    if ($rc) {
        return $rc;
    }

    return $self->_objAdd($obj, $pkey, $dn, $entryStr);
}

=pod

=head2 modrdn

This method is called when L<LISM> do the modrdn operation.
Returns 0 if it completes successfully.

=cut

sub modrdn
{
    my $self = shift;
    my ($dn, $newrdn, $delFlag) = @_;
    my $rc;
    my $entry;

    my ($rdn_attr, $superior) = ($dn =~ /^([^=]*)=[^,]*,(.*)$/);

    ($rc, $entry) = $self->search($dn, 0, 0, 1, 0, "(objectClass=*)", 0, ());
    if ($rc) {
        return $rc;
    }

    my ($newval) = ($newrdn =~ /^$rdn_attr=(.*)$/i);
    $entry =~ s/^dn:.*\n//;
    $entry =~ s/^$rdn_attr: .*$/$rdn_attr: $newval/mi;
    my ($passwd) = ($entry =~ /^userpassword: (.*)$/mi);
    if ($passwd) {
        $passwd = $self->hashPasswd($passwd);
        $entry =~ s/^userpassword: .*$/userpassword: $passwd/mi;
    }

    $rc = $self->add("$newrdn,$superior", $entry);
    if ($rc) {
        return $rc;
    }

    if ($delFlag) {
        $rc = $self->delete($dn);
    }

    return $rc;
}

=pod

=head2 delete

This method is called when L<LISM> do the delete operation.
Returns 0 if it completes successfully.

=cut

sub delete
{
    my $self = shift;
    my ($dn) = @_;
    my $conf = $self->{_config};

    if ($self->_getConnect()) {
        return LDAP_SERVER_DOWN;
    }

    my ($rc, $obj, $pkey) = $self->_getObject($dn);
    if ($rc) {
        return $rc;
    }

    my $key;

    ($rc, $key) = $self->_baseSearch($obj, $pkey, $dn, 0, 0, 1, 0, undef);
    if ($rc) {
        return $rc;
    }

    my @children;
    my $keys;
    ($rc, $keys, @children) = $self->_childSearch($obj, $key, $dn, 1, 0, 1, 0, undef);
    if ($rc) {
        return $rc;
    } elsif (@children) {
        return LDAP_NOT_ALLOWED_ON_NONLEAF;
    }

    return $self->_objDelete($obj, $pkey, $dn);
}

=pod

=head2 log(level, message)

log message to syslog.

=cut

sub log
{
    my $self = shift;
    my $conf = $self->{_config};
    my %p = @_;

    openlog('LISM', 'pid', 'local4');
    setlogmask(Sys::Syslog::LOG_UPTO($conf->{numloglevel}{$conf->{sysloglevel}}));
    syslog($conf->{numloglevel}{$p{'level'}}, $p{'message'});
    closelog
}

=pod

=head2 hashPasswd($passwd, $salt)

hash the password if it isn't done.

=cut

sub hashPasswd
{
    my $self = shift;
    my ($passwd, $salt) = @_;
    my $conf = $self->{_config};

    my $hashpw;
    my ($htype, $otype) = split(/:/, $conf->{hash});

    my ($pwhtype) = ($passwd =~ /^\{([^\}]+)\}/);
    if ($pwhtype) {
        # already hashed password
        if ($pwhtype ne $htype) {
            return undef;
        }

        $passwd =~ s/^\{[^\}]+\}//;
        if ($otype =~ /^hex$/i && $htype =~ /^MD5|SHA$/i) {
            $passwd = unpack("H*", decode_base64($passwd));
        }

        return $passwd;
    }

    # hash the password
    if ($htype =~ /^CRYPT$/i) {
        my @chars = ('a'..'z', 'A'..'Z', '0'..'9');
        if (!$salt) {
            $salt .= $chars[int(rand($#chars + 1))] for (1..10);
        }
        $hashpw = crypt($passwd, $salt);
    } elsif ($htype =~ /^MD5$/i) {
        my $ctx = Digest::MD5->new;
        $ctx->add($passwd);
        if ($otype && $otype =~ /^hex$/i) {
            $hashpw = $ctx->hexdigest;
        } else {
            $hashpw = $ctx->b64digest.'==';
        }
    } elsif ($htype =~ /^SHA$/i) {
        my $ctx = Digest::SHA1->new;
        $ctx->add($passwd);
        if ($otype && $otype =~ /^hex$/i) {
            $hashpw = $ctx->hexdigest;
        } else {
            $hashpw = $ctx->b64digest.'=';
        }
    } else {
        $hashpw = $passwd;
    }

    return $hashpw;
}

=pod

=head2 parseFilter($filter, $entry)

parse filter and check entry matching.

=cut

sub parseFilter
{
    my $self = shift;
    my ($filter, $entry) = @_;

    if (!$filter) {
        return 1;
    }

    # get operand and arguments
    my ($op) = keys %{$filter};
    my $args = $filter->{$op};

    if ($op eq 'and') {
        return $self->parseFilter(@{$args}[0], $entry) & $self->parseFilter(@{$args}[1], $entry);
    } elsif ($op eq 'or') {
        return $self->parseFilter(@{$args}[0], $entry) | $self->parseFilter(@{$args}[1], $entry);
    } elsif ($op eq 'not'){
        return !($self->parseFilter($args, $entry));
    }

    if ($op =~ /^(equalityMatch|greaterOrEqual|lessOrEqual)/) {
        my $rc = 0;
        foreach my $line (split(/\n/, $entry)) {
            my ($attr, $val) = split(/: /, $line);
            if ($attr !~ /^$args->{attributeDesc}$/i) {
                next;
            }

            if ($op eq 'equalityMatch') {
                $rc = ($val =~ /^$args->{assertionValue}$/i);
            } elsif ($op eq 'greaterOrEqual') {
                $rc = ($val ge $args->{assertionValue});
            } elsif ($op eq 'lessOrEqual') {
                $rc = ($val le $args->{assertionValue});
            }

            if ($rc) {
                last;
            }
        }
        return $rc;
    } elsif ($op eq 'substrings') {
        return $entry =~ /^$args->{type}: $args->{substrings}[0]{initial}*$args->{substrings}[1]{final}$/mi;
    } elsif ($op eq 'present') {
        return $entry =~ /^$args: /mi;
    }
}

=pod

=head2 buildEntryStr($basedn, $conf)

get information of container entry.

=cut

sub buildEntryStr
{
    my $self = shift;
    my ($basedn, $conf) = @_;
    my $entry = '';

    if (!defined($conf->{rdn}) || !($conf->{rdn}[0] =~ /^[^=]+=[^,]+/)) {
        return $entry;
    }

    ($entry = $conf->{rdn}[0]."\n") =~ s/=/: /;
    if (defined($conf->{oc})) {
        foreach my $oc (@{$conf->{oc}}) {
            $entry = $entry."objectClass: $oc\n";
        }
    }
    if (defined($conf->{attr})) {
        foreach my $attr (keys %{$conf->{attr}}) {
            $entry = $entry."$attr: $conf->{attr}{$attr}->{content}\n";
        }
    }
    $entry = "dn: $conf->{rdn}[0],$basedn\n$entry";

    return $entry;
}


sub _checkConfig
{
    my $self = shift;
    my $conf = $self->{_config};

    if (defined($conf->{libload})) {
        foreach my $lib (@{$conf->{libload}}) {
            eval "do \'$lib\'";
            if ($@) {
                $self->log(level => 'alert', message => "storage do $lib: $@");
                return 1;
            }
        }
    }

    # multibyte character code
    if (defined($conf->{mbcode})) {
        if ($conf->{mbcode}[0] !~ /^(utf8|euc-jp|shiftjis)/) {
            $self->log(level => 'alert', message => "character code is invalid");
            return 1;
        }
    } else {
        $conf->{mbcode}[0] = 'utf8';
    }

    if (defined($conf->{object})) {
        $self->{object} = {};
        foreach my $oname (keys %{$conf->{object}}) {
            my $oconf = $conf->{object}{$oname};
            my $entry;

            if (!defined($oconf->{container})) {
                $self->log(level => 'alert', message => "$oname object container doesn't exist");
                return 1;
            }
            $self->{object}{$oname}->{conf} = $oconf;

            # set container
            if (defined($oconf->{container}[0]->{oname})) {
                my $poname = $oconf->{container}[0]->{oname}[0];
                $self->{object}{$oname}->{parent} = $poname;
                if (!defined($self->{object}{$poname}->{child})) {
                    $self->{object}{$poname}->{child} = [];
                }
                push(@{$self->{object}{$poname}->{child}}, $self->{object}{$oname});
            } elsif (!($entry = $self->buildEntryStr($self->{suffix}, $oconf->{container}[0]))) {
                $self->log(level => 'alert', message => "$oname object container entry is invalid");
                return 1;
            } else {
                my $crdn = lc($oconf->{container}[0]->{rdn}[0]);
                my $coname = $crdn.'_container';
                if (!defined($self->{object}{$coname})) {
                    $self->{object}{$coname}->{entrystr} = $entry;
                    # normalize suffix
                    $self->{object}{$coname}->{suffix} = lc("$crdn,".$self->{suffix});
                }
                # set child object
                if (!defined($self->{object}{$coname}->{child})) {
                    $self->{object}{$coname}->{child} = [];
                }
                push(@{$self->{object}{$coname}->{child}}, $self->{object}{$oname});
                $self->{object}{$oname}->{parent} = $coname;
            }

            if (defined($oconf->{entry})) {
                next;
            }

            # check id definition
            if (!defined($oconf->{id}) || !defined($oconf->{id}[0]->{column})) {
                $self->log(level => 'alert', message => "Id definition is invalid");
            }

            foreach my $attr (keys(%{$oconf->{attr}})) {
                # the attribute's name must be lowercase
                if ($attr =~ /[A-Z]/) {
                    $self->log(level => 'alert', message => "Attribute's name must be lowercase: $attr");
                    return 1;
                }

                # multibyte character code
                if (defined($oconf->{attr}{$attr}->{mbcode}) &&
                    !($oconf->{attr}{$attr}->{mbcode}[0] =~ /^(euc-jp|shiftjis)/)) {
                    $self->log(level => 'alert', message => "character code is invalid");
                    return 1;
                }
            }

            if (!defined($oconf->{rdn}) || !defined($oconf->{attr}{$oconf->{rdn}[0]})) {
                $self->log(level => 'alert', message => "rdn of $oname object is invalid");
                return 1;
            }
        }

        # check container's link
        foreach my $oname (keys %{$self->{object}}) {
            my $obj = $self->{object}{$oname};

            if (!defined($obj->{suffix}) || !defined($obj->{child})) {
                next;
            }

            if ($self->_getTreeLevel($obj, 0) < 0) {
                $self->log(level => 'alert', message => "depth of $oname subtree is too long");
                return 1;
            }
        }
    }

    return 0;
}

sub _getTreeLevel
{
    my $self = shift;
    my ($obj, $current) = @_;
    my $maxlevel = 0;

    $current++;
    if ($current > $maxLoopCount) {
        return -1;
    }

    if (!defined($obj->{child})) {
        return $current;
    }

    foreach my $child (@{$obj->{child}}) {
        if (defined($child->{conf}->{entry})) {
            my $entry;
            my ($suffix) = ($obj->{entrystr} =~ /^dn: (.*)\n/);
            if (!($entry = $self->buildEntryStr($suffix, $child->{conf}->{entry}[0]))) {
                $self->log(level => 'alert', message => "container entry is invalid");
                return -1;
            }
            $child->{entrystr} = $entry;
        }

        my $level = $self->_getTreeLevel($child, $current);
        if ($level < 0) {
            return -1;
        } elsif ($level > $maxlevel) {
            $maxlevel = $level;
        }
    }

    return $maxlevel;
}

sub _getConnect
{
    return 0;
}

sub _freeConnect
{
}

sub _getObject
{
    my $self = shift;
    my ($dn) = @_;
    my $conf = $self->{_config};
    my $obj = undef;

    if (!defined($self->{object})) {
        return (LDAP_UNWILLING_TO_PERFORM, $obj, undef);
    }

    foreach my $oname (keys %{$self->{object}}) {
        $obj = $self->{object}{$oname};

        if (defined($obj->{suffix}) && $dn =~ /$obj->{suffix}$/i) {
            if ($dn =~ /^$obj->{suffix}$/i) {
                return (LDAP_SUCCESS, $obj, undef);
            } else {
                last;
            }
        }
    }

    if (!$obj) {
        return (LDAP_NO_SUCH_OBJECT, $obj, undef);
    }

    my (@rdn_list) = split(/,/, ($dn =~ /^[^,]+,(.*),?$obj->{suffix}$/i)[0]);
    my @objs = ($obj);
    my $key;
    for (my $base = $obj->{suffix}; defined($obj->{child});
        @objs = @{$obj->{child}}, $base = pop(@rdn_list).','.$base) {
        my $rc;
        my $entry;

        for (my $i = 0; $i < @objs; $i++) {
            ($rc, $key, $entry) = $self->_baseSearch($objs[$i], $key, $base, 0, 0, 1, 0, undef);
            if ($entry) {
                $obj = $objs[$i];
                last;
            }
        }

        if (!$entry) {
            return (LDAP_NO_SUCH_OBJECT, $obj, undef);
        }
        if (!@rdn_list) {
            last;
        }
    }

    if (defined($obj->{child})) {
        foreach my $child (@{$obj->{child}}) {
            if ((defined($child->{conf}->{rdn}) && $dn =~ /^$child->{conf}->{rdn}[0]=/i) ||
                (defined($child->{entrystr}) && $child->{entrystr} =~ /^dn: $dn/i)) {
                return (LDAP_SUCCESS, $child, $key);
            }
        }
    }

    return (LDAP_NO_SUCH_OBJECT, $obj, undef);
}

sub _searchObjects
{
    my $self = shift;
    my ($base, $scope) = @_;
    my $conf = $self->{_config};
    my @objs = ();

    if (!defined($conf->{object})) {
        return (LDAP_NO_SUCH_OBJECT, @objs);
    }

    if ($base =~ /^$self->{suffix}$/) {
        if ($scope != 0) {
            foreach my $oname (keys %{$self->{object}}) {
                if (defined($self->{object}{$oname}->{suffix})) {
                    push(@objs, [$self->{object}{$oname}, undef]);
                }
            }
        }
    } else {
        my ($rc, $obj, $pkey) = $self->_getObject($base);
        if ($rc) {
            return ($rc, @objs);
        } else {
            push(@objs, [$obj, $pkey]);
        }
    }

    return (LDAP_SUCCESS, @objs);
}

sub _baseSearch
{
    my $self = shift;
    my ($obj, $pkey, $base, $scope, $deref, $sizeLim, $timeLim, $filter) = @_;

    if ($base !~ /$obj->{suffix}$/i) {
        return (LDAP_NO_SUCH_OBJECT, undef, undef);
    }

    if (defined($obj->{entrystr})) {
        my $entry = $obj->{entrystr};
        if ($entry !~ /^dn: $base\n/i) {
            return (LDAP_NO_SUCH_OBJECT, undef, undef);
        } elsif ($self->parseFilter($filter, $entry) && $scope != 1 && $sizeLim) {
            return (LDAP_SUCCESS, undef, $entry);
        } else {
            return (LDAP_SUCCESS, undef, undef);
        }
    }

    my ($rdn, $pdn) = ($base =~ /^([^,]+),(.*)$/);

    my $filterStr;
    if ($filter) {
        $filterStr = "(&($rdn)".$filter->as_string.")";
    } else {
        $filterStr = "($rdn)";
    }
    my $basefilter = Net::LDAP::Filter->new($filterStr);

    my ($rc, $keys, @entries) = $self->_objSearch($obj, $pkey, $pdn, -1, $basefilter);
    if ($rc) {
        return ($rc, undef, undef);
    }

    return ($rc, ${$keys}[0], $scope != 1 ? $entries[0] : undef);
}

sub _childSearch
{
    my $self = shift;
    my ($obj, $pkey, $base, $scope, $deref, $sizeLim, $timeLim, $filter) = @_;
    my @match_entries = ();
    my @match_keys = ();
    my $rc = LDAP_SUCCESS;

    if ($scope == 0 || !defined($obj->{child}) || !$pkey && !defined($obj->{entrystr})) {
        return ($rc, \@match_keys, ());
    }

    my @entries;
    my $keys;
    for (my $i = 0; $i < @{$obj->{child}}; $i++) {
        my @children = ();
        my $ckeys;

        if (defined($obj->{child}[$i]->{entrystr})) {
            my $entry = $obj->{child}[$i]->{entrystr};
            if ($self->parseFilter($filter, $entry) && $scope != 0 && $sizeLim) {
                push(@match_entries, $entry);
                push(@match_keys, undef);
            }
        } else {
            ($rc, $keys, @entries) = $self->_objSearch($obj->{child}[$i], $pkey, $base, $sizeLim, $filter);
            push(@match_entries, @entries);
            push(@match_keys, @{$keys});
        }

        if ($scope == 1 || !defined($obj->{child}[$i]->{child}) || $rc) {
            next;
        }
        $sizeLim = $sizeLim - @match_entries;

        if (defined($obj->{child}[$i]->{entrystr})) {
            push(@children, $obj->{child}[$i]->{entrystr});
            my @tmp_keys = (undef);
            $ckeys = \@tmp_keys;
        } else {
            ($rc, $ckeys, @children) = $self->_objSearch($obj->{child}[$i], $pkey, $base, -1, undef);
            if ($rc) {
                return ($rc, \@match_keys, @match_entries);
            }
        }

        for (my $j = 0; $j < @{$ckeys}; $j++) {
            my ($childdn) = ($children[$j] =~ /^dn: (.*)\n/);
            ($rc, $keys, @entries) = $self->_childSearch($obj->{child}[$i], ${$ckeys}[$j], $childdn, $scope, $deref, $sizeLim, $timeLim, $filter);
            if ($rc) {
                return ($rc, \@match_keys, @match_entries);
            }

            push(@match_entries, @entries);
            push(@match_keys, @{$keys});
            $sizeLim = $sizeLim - @entries;
        }
    }

    return ($rc, \@match_keys, @match_entries);
}

sub _objSearch
{
    return (LDAP_UNWILLING_TO_PERFORM, undef, ());
}

sub _objModify
{
    return LDAP_UNWILLING_TO_PERFORM;
}

sub _objAdd
{
    return LDAP_UNWILLING_TO_PERFORM;
}

sub _objDelete
{
    return LDAP_UNWILLING_TO_PERFORM;
}

sub _getParentDn
{
    my $self = shift;
    my ($obj, $key) = @_;
    my $conf = $self->{_config};

    if (defined($obj->{suffix})) {
        return $obj->{suffix};
    }

    if (!defined($obj->{parent})) {
        return undef;
    }

    my $pobj = $self->{object}{$obj->{parent}};
    if (defined($pobj->{suffix})) {
        return $pobj->{suffix};
    }

    my ($prdn, $pkey) = $self->_getParentRdn($obj, $key);
    if (!$prdn) {
        return undef;
    }

    my $ppdn = $self->_getParentDn($pobj, $pkey);
    if (!$ppdn) {
        return undef;
    }

    return "$prdn,$ppdn";
}

sub _getParentRdn
{
    return undef;
}

sub _getStaticValue
{
    my $self = shift;
    my ($static, $dn, $entryStr) = @_;
    my $value;

    # get static value
    if (defined($static->{value})) {
        if ($static->{value}[0]->{type} eq 'function') {
            eval "\$value = $static->{value}[0]->{content}";
        } else {
            $value = $static->{value}[0]->{content};
        }
    }

    return $value;
}

sub _pwdFormat
{
    my $self = shift;
    my ($entry) = @_;
    my $conf = $self->{_config};

    if ($entry =~ /^userpassword: (.*)$/mi) {
        my $passwd = $1;
        my ($htype, $otype) = split(/:/, $conf->{hash});

        if ($htype =~ /^CRYPT|MD5|SHA$/i) {
            if ($otype =~ /^hex$/i && $htype =~ /^MD5|SHA$/i) {
                $passwd = encode_base64(pack("H*", $passwd));
                chop $passwd;
            }
            $passwd = "{$htype}".$passwd;
        }

        $entry =~ s/^userpassword:.*$/userpassword: $passwd/mi;
    }

    return $entry;
}

=head1 SEE ALSO

L<LISM>

=head1 AUTHOR

Kaoru Sekiguchi, <sekiguchi.kaoru@secioss.co.jp>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Kaoru Sekiguchi

This library is free software; you can redistribute it and/or modify
it under the GNU LGPL.

=cut

1;
