package LISM::Handler;

use strict;
use URI;
use Net::LDAP;
use Net::LDAP::Constant qw(:all);
use POSIX;
use Encode;
use Data::Dumper;
if ($^O ne 'MSWin32') {
    eval "use Sys::Syslog";
}

=head1 NAME

LISM::Handler - an base class for LISM handler implementations

=head1 DESCRIPTION

This class is meant as an interface of handler called when the LDAP operation is done.

=head1 CONSTRUCTOR

This is a plain constructor.

=cut

sub new
{
    my $class = shift;

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

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

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

    return 0;
}

=pod

=head2 getOrder

Get order to do handler.

=cut

sub getOrder
{
    return 'middle';
}

=pod

=head2 getOrder

Get order to do handler.

=cut

sub useprevious()
{
    my $self = shift;
    my $conf = $self->{_config};

    return defined($conf->{useprevious}) && $conf->{useprevious} == 'on' ? 1 : 0;
}

=pod

=head2 pre_bind

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

=cut

sub pre_bind
{
    return 0;
}

=pod

=head2 post_bind

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

=cut

sub post_bind
{
    return 0;
}

=pod

=head2 pre_compare

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

=cut

sub pre_compare
{
    return 0;
}

=pod

=head2 post_compare

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

=cut

sub post_compare
{
    return 0;
}

=pod

=head2 pre_search

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

=cut

sub pre_search
{
    return 0;
}

=pod

=head2 post_search

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

=cut

sub post_search
{
    return 0;
}

=pod

=head2 pre_modify

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

=cut

sub pre_modify
{
    return 0;
}

=pod

=head2 post_modify

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

=cut

sub post_modify
{
    return 0;
}

=pod

=head2 pre_add

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

=cut

sub pre_add
{
    return 0;
}

=head2 post_add

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

=cut

sub post_add
{
    return 0;
}

=pod

=head2 pre_modrdn

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

=cut

sub pre_modrdn
{
    return 0;
}

=pod

=head2 post_modrdn

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

=cut

sub post_modrdn
{
    return 0;
}

=pod

=head2 pre_delete

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

=cut

sub pre_delete
{
    return 0;
}

=pod

=head2 post_delete

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

=cut

sub post_delete
{
    return 0;
}

=pod

=head2 log(level, message)

log message to syslog.

=cut

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

    if (Encode::is_utf8($p{'message'})) {
        $p{'message'} = encode('utf8', $p{'message'});
    }
    $p{'message'} = uc($p{'level'}).' ['.ref($self).'] '.$p{'message'};

    if ($^O ne 'MSWin32') {
        openlog('LISM', 'pid', 'local4');
        setlogmask(Sys::Syslog::LOG_UPTO(Sys::Syslog::xlate($conf->{sysloglevel})));
        syslog($p{'level'}, $p{'message'});
        closelog();
    } else {
        print STDERR strftime("%Y %m %d %H:%M:%S", localtime(time))." $p{'message'}\n";
    }
}

sub _checkConfig
{
    return 0;
}

sub _parseLdapUri
{
    my $self = shift;
    my ($ldapopts, $ldapuri) = @_;

    $ldapopts->{uri} = $ldapuri;
    my $uri = URI->new($ldapopts->{uri});
    $ldapopts->{base} = $uri->dn;
    ($ldapopts->{attr}) = $uri->attributes;
    my %extn = $uri->extensions;
    $ldapopts->{binddn} = $extn{binddn};
    $ldapopts->{bindpw} = $extn{bindpw};

    return 0;
}

sub _searchLdap
{
    my $self = shift;
    my ($ldapopts, $filter) = @_;
    my $base = $ldapopts->{base};
    my $scope = 'sub';
    my $attr;
    my $msg;
    my $rc;
    my @values = ('');

    if (defined($ldapopts->{ldap})) {
        my $cmsg = $ldapopts->{ldap}->bind($ldapopts->{binddn}, password => $ldapopts->{bindpw});
        if ($cmsg->code) {
            $self->log(level => 'err', message => "LDAP connection check failed in handler");
            $ldapopts->{ldap}->unbind();
            undef($ldapopts->{ldap});
        }
    }

    if (!$ldapopts->{ldap}) {
        $ldapopts->{ldap} = Net::LDAP->new($ldapopts->{uri});
        if (!defined($ldapopts->{ldap})) {
            $self->log(level => 'err', message => "Can't connect $ldapopts->{uri}");
            return undef;
        }

        $msg = $ldapopts->{ldap}->bind($ldapopts->{binddn}, password => $ldapopts->{bindpw});
        $rc = $msg->code;
        if ($rc) {
            $self->log(level => 'err', message => "bind by $ldapopts->{binddn}failed($rc)");
            return undef;
        }
    }

    $filter =~ s/^["']//;
    $filter =~ s/["']$//;
    if ($filter =~ /^\(?dn=/) {
        ($base) = ($filter =~ /^\(?dn=(.*)\)?$/);
        $scope = 'base';
        $filter = 'objectClass=*';
    }
    if ($ldapopts->{attr} eq 'parentrdn') {
        $attr = 'dn';
    } else {
        $attr = $ldapopts->{attr};
    }

    $msg = $ldapopts->{ldap}->search(base => $base, scope => $scope, filter => $filter, attrs => [$attr]);

    $rc = $msg->code;
    if ($rc) {
        $self->log(level => 'err', message => "ldap search by $filter failed($rc)");
        if ($rc == LDAP_SERVER_DOWN) {
            $ldapopts->{ldap}->unbind();
            undef($ldapopts->{ldap});
        }

        return undef;
    }

    if ($msg->count) {
        my $entry = $msg->entry(0);
        if ($ldapopts->{attr} eq 'dn') {
            $values[0] = $entry->dn;
        } elsif ($ldapopts->{attr} eq 'parentrdn') {
            @values = ($entry->dn =~ /^[^,]+,([^,]+)/);
        } else {
            @values = $entry->get_value($ldapopts->{attr});
        }

        if (!defined($values[0])) {
            @values = ('');
        }
    }

    return @values;
}

sub _searchLism
{
    my $self = shift;
    my ($lismopts, $filter) = @_;
    my $base = $lismopts->{base};
    my $scope = 2;
    my $attr;
    my @values = ();

    if (defined($lismopts->{scope})) {
        if ($lismopts->{scope} eq 'base') {
            $scope = 0;
        } elsif ($lismopts->{scope} eq 'one') {
            $scope = 1;
        }
    }

    $filter =~ s/^["']//;
    $filter =~ s/["']$//;
    if ($filter =~ /^\(?dn=/) {
        ($base) = ($filter =~ /^\(?dn=(.*)\)?$/);
        $scope = 0;
        $filter = '(objectClass=*)';
    }
    if ($lismopts->{attr} eq 'parentrdn') {
        $attr = 'dn';
    } else {
        $attr = $lismopts->{attr};
    }

    my ($rc, @entries) = $self->{lism}->search($base, $scope, 0, 0, 0, encode('utf8', $filter), 0, $attr);
    if ($rc) {
        $self->log(level => 'err', message => "lism search by $filter failed($rc)");

        return undef;
    }

    if (@entries) {
        my $num = 1;
        foreach my $entryStr (@entries) {
            if (defined($lismopts->{sizelimit}) && $num > $lismopts->{sizelimit}) {
                last;
            }

            my @tmpvals;
            if ($lismopts->{attr} eq 'dn') {
                @tmpvals = ($entryStr =~ /^[^\n]+/);
            } elsif ($lismopts->{attr} eq 'parentrdn') {
                @tmpvals = ($entryStr =~ /^[^,]+,([^,]+)/);
            } else {
                @tmpvals = ($entryStr =~ /^$lismopts->{attr}: (.*)$/gmi);
            }

            if (@tmpvals && defined($tmpvals[0]) && $tmpvals[0] !~ /^ *$/) {
                push(@values, @tmpvals);
            }
            $num++;
        }
    }

    if (!@values || !defined($values[0])) {
        @values = ('');
    }

    return @values;
}

sub _unique
{
    my $self = shift;
    my @array = @_;
    my @uarray = ();
    my %hash;

    for (my $i = 0; $i < @array; $i++) {
        if (!defined($hash{$array[$i]})) {
            $hash{$array[$i]} = 1;
            push(@uarray, $array[$i]);
        }
    }

    return @uarray;
}

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

    if (!defined($conf->{lock})) {
        return 0;
    }

    if (!open($self->{lock}, "> $conf->{lock}[0]")) {
        return 1;
    }

    flock($self->{lock}, 2);

    return 0;
}

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

    if (!defined($conf->{lock}) || !defined($self->{lock})) {
        return 0;
    }

    close($self->{lock});
    undef($self->{lock});

    return 0;
}

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