package LISM::Handler::Check;

use strict;
use base qw(LISM::Handler);
use POSIX qw(strftime);
use Encode;
use Net::LDAP::Constant qw(:all);
use Data::Dumper;

=head1 NAME

LISM::Handler::Check - Handler to set value

=head1 DESCRIPTION

This class implements the L<LISM::Hanlder> interface to set value.

=head1 METHODS

=pod

=head2 getOrder

Get order to do handler.

=cut

sub getOrder
{
    return 'sync';
}

=head2 post_search($entriesp)

Check search results.

=cut

sub post_search
{
    my $self = shift;
    my ($entriesp) = @_;
    my $conf = $self->{_config};
    my $fd;

    my $match = 0;
    foreach my $rule (@{$conf->{check}}) {
        if (!defined($rule->{op}) || (','.$rule->{op}.',') =~ /,search,/) {
            $match = 1;
            last;
        }
    }
    if (!$match) {
        return LDAP_SUCCESS;
    }

    if (defined($conf->{file})) {
        if ($conf->{file}[0] eq 'stdout') {
            $fd = *STDOUT;
        } elsif (!open($fd, ">> $conf->{file}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{file}[0]");
            return LDAP_OTHER;
        }
    } elsif (defined($conf->{command})) {
        if (!open($fd, "|$conf->{command}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{command}[0]");
            return LDAP_OTHER;
        }
    }

    for (my $i = 0; $i < @{$entriesp}; $i++) {
        $self->_checkValues(${$entriesp}[$i], 'search', $fd);
    }
    if (!defined($conf->{file}) || $conf->{file}[0] ne 'stdout') {
        close($fd);
    }

    return LDAP_SUCCESS;
}

=head2 pre_modify($dnp, $listp)

Check modify request.

=cut

sub pre_modify
{
    my $self = shift;
    my ($dnp, $listp, $oldentryp) = @_;
    my $conf = $self->{_config};
    my $fd;

    if (defined($conf->{file})) {
        if ($conf->{file}[0] eq 'stdout') {
            $fd = *STDOUT;
        } elsif (!open($fd, ">> $conf->{file}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{file}[0]");
            return LDAP_OTHER;
        }
    } elsif (defined($conf->{command})) {
        if (!open($fd, "|$conf->{command}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{command}[0]");
            return LDAP_OTHER;
        }
    }

    my $entryStr = "dn: ${$dnp}\n";
    my @list = @{$listp};
    while (@list > 0) {
        my $action = shift @list;
        my $attr = lc(shift @list);
        my @values;

        while (@list > 0 && $list[0] ne "ADD" && $list[0] ne "DELETE" && $list[0] ne "REPLACE") {
            push(@values, shift @list);
        }

        if ($action eq 'DELETE') {
            next;
        }

        foreach my $value (@values) {
            $entryStr .= "$attr: $value\n";
        }
    }

    my $rc = $self->_checkValues($entryStr, 'modify', $fd, 'pre', $oldentryp ? ${$oldentryp} : '');
    if (!defined($conf->{file}) || $conf->{file}[0] ne 'stdout') {
        close($fd);
    }

    return $rc;
}

=head2 pre_add($dnp, $entryStrp)

Check add request.

=cut

sub pre_add
{
    my $self = shift;
    my ($dnp, $entryStrp) = @_;
    my $conf = $self->{_config};
    my $fd;

    if (defined($conf->{file})) {
        if ($conf->{file}[0] eq 'stdout') {
            $fd = *STDOUT;
        } elsif (!open($fd, ">> $conf->{file}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{file}[0]");
            return LDAP_OTHER;
        }
    } elsif (defined($conf->{command})) {
        if (!open($fd, "|$conf->{command}[0]")) {
            $self->log(level => 'err', message => "Can't open $conf->{command}[0]");
            return LDAP_OTHER;
        }
    }

    my $rc = $self->_checkValues("dn: ${$dnp}\n${$entryStrp}[0]", 'add', $fd);
    if (!defined($conf->{file}) || $conf->{file}[0] ne 'stdout') {
        close($fd);
    }

    return $rc;
}

=head2 post_modify($dnp, $listp)

Check modify request.

=cut

sub post_modify
{
    my $self = shift;
    my ($dnp, $listp, $oldentryp) = @_;
    my $conf = $self->{_config};
    my $oldentry = defined($oldentryp) ? ${$oldentryp} : '';

    my $entryStr = "dn: ${$dnp}\n";
    my @list = @{$listp};
    while (@list > 0) {
        my $action = shift @list;
        my $attr = lc(shift @list);
        my @values;

        while (@list > 0 && $list[0] ne "ADD" && $list[0] ne "DELETE" && $list[0] ne "REPLACE") {
            push(@values, shift @list);
        }

        if ($action eq 'DELETE') {
            foreach my $value (@values) {
                $entryStr .= "$attr: $value\n";
            }
        } elsif ($action eq 'REPLACE') {
            foreach my $value ($oldentry =~ /^$attr: (.+)$/gmi) {
                my $tmpval = $value;
                $tmpval =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                if (!grep(/^$tmpval$/i, @values)) {
                    $entryStr .= "$attr: $value\n";
                }
            }
        }
    }

    return $self->_checkValues($entryStr, 'modify', undef, 'post', $oldentry);
}

=head2 post_add($dnp, $entryStrp)

Check add request.

=cut

sub post_add
{
    my $self = shift;
    my ($dnp, $entryStrp) = @_;
    my $conf = $self->{_config};

    return $self->_checkValues("dn: ${$dnp}\n${$entryStrp}[0]", 'add', undef, 'post');
}

=head2 post_delete($dnp)

Check delete request.

=cut

sub post_delete
{
    my $self = shift;
    my ($dnp, $null, $oldentryp) = @_;
    my $conf = $self->{_config};

    return $self->_checkValues("dn: ${$dnp}\n", 'delete', undef, 'post', $oldentryp ? ${$oldentryp} : '');
}

sub _checkValues
{
    my $self = shift;
    my ($entryStr, $func, $fd, $type, $oldentry) = @_;
    my $conf = $self->{_config};
    my $rc = LDAP_SUCCESS;

    my $timestamp = strftime("%Y/%m/%d %H:%M:%S", localtime(time));
    foreach my $rule (@{$conf->{check}}) {
        my ($dn) = ($entryStr =~ /^dn: (.*)\n/);
        if (defined($rule->{dn}) && $dn !~ /$rule->{dn}/i) {
            next;
        }
        if (defined($rule->{op}) && (','.$rule->{op}.',') !~ /,$func,/) {
            next;
        }
        if (defined($rule->{filter}) && !LISM::Storage->parseFilter($rule->{filterobj}, encode('utf8', $entryStr))) {
            next;
        }
        if (defined($rule->{entry})) {
            if (defined($rule->{entry}[0]->{maxentries}) && ($func eq 'add' || $func eq 'delete')) {
                my $mrc;
                if ($type eq 'post') {
                    $mrc = !$self->_updateCurrentEntries($rule->{entry}[0]->{maxentries}[0], $dn, $func);
                    if (!defined($mrc)) {
                        return LDAP_USER_CANCELED;
                    }
                } elsif ($func eq 'add') {
                    my $error;
                    ($mrc, $error) = $self->_checkMaxEntries($rule->{entry}[0]->{maxentries}[0], $dn);
                    if (!defined($mrc)) {
                        return LDAP_OTHER;
                    } elsif (!$mrc) {
                        print $fd encode('utf8', "$timestamp: Maximum number of entries exceeded($dn): $error\n");
                        return LDAP_ADMIN_LIMIT_EXCEEDED;
                    }
                }
            }
        }
        foreach my $attr (keys %{$rule->{attr}}) {
            my $cattr = $rule->{attr}{$attr};
            my @values = ($entryStr =~ /^$attr: (.+)$/gmi);
            if (defined($cattr->{maxentries})) {
                my $opts = $cattr->{maxentries}[0];
                my $mrc;
                if ($type eq 'post') {
                    my @delvals;
                    if ($func eq 'delete') {
                        @delvals = ($oldentry =~ /^$attr: (.+)$/gmi);
                    } else {
                        @delvals = ($entryStr =~ /^$attr: (.+)$/gmi);
                    }
                    ($mrc) = !$self->_updateCurrentEntries($opts, $dn, $func, $attr, $oldentry, @delvals);
                    if (!defined($mrc)) {
                        return LDAP_USER_CANCELED;
                    }
                } elsif ($func eq 'add' || $func eq 'modify') {
                    my $mentry;
                    my @addvals;
                    if ($func eq 'modify') {
                        $mentry = $oldentry;
                        foreach my $value (@values) {
                            if ($oldentry !~ /^$attr: $value$/mi) {
                                push(@addvals, $value);
                            }
                        }
                    } else {
                        $mentry = $entryStr;
                        @addvals = ($entryStr =~ /^$attr: (.+)$/gmi);
                    }
                    my $error;
                    ($mrc, $error) = $self->_checkMaxEntries($opts, $dn, $attr, $mentry, @addvals);
                    if (!defined($mrc)) {
                        return LDAP_OTHER;
                    } elsif (!$mrc) {
                        print $fd encode('utf8', "$timestamp: Maximum number of entries exceeded($dn): $error\n");
                        return LDAP_SIZELIMIT_EXCEEDED;
                    }
                }
            }
            if ($type eq 'post') {
                next;
            }
            if (defined($cattr->{required}) && $cattr->{required}[0] eq 'on' && !@values) {
                print $fd encode('utf8', "$timestamp: $attr in $dn is required value\n");
                $rc = LDAP_CONSTRAINT_VIOLATION;
            }
            foreach my $value (@values) {
                if (defined($cattr->{minlen}) && length($value) < $cattr->{minlen}[0]) {
                    print $fd encode('utf8', "$timestamp: $attr=$value in $dn is too short\n");
                    $rc = LDAP_CONSTRAINT_VIOLATION;
                }
                if (defined($cattr->{maxlen}) && length($value) > $cattr->{maxlen}[0]) {
                    print $fd encode('utf8', "$timestamp: $attr=$value in $dn is too long\n");
                    $rc = LDAP_CONSTRAINT_VIOLATION;
                }
                if (defined($cattr->{regexp}) && $value !~ /$cattr->{regexp}[0]/) {
                    print $fd encode('utf8', "$timestamp: $attr=$value in $dn is invalid: regular expression is $cattr->{regexp}[0]\n");
                    $rc = LDAP_CONSTRAINT_VIOLATION;
                }
                if (defined($cattr->{function})) {
                    my $ecode = 0;
                    eval "\$ecode = $cattr->{function}[0](\$value)";
                    if (!$ecode) {
                        print $fd encode('utf8', "$timestamp: $attr=$value in $dn is invalid: function is $cattr->{function}[0]($ecode)\n");
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                    }
                }
                if (defined($cattr->{lismexist})) {
                    my $opts = $cattr->{lismopts};
                    my $filter = "($opts->{attr}=$value)";
                    if (defined($opts->{filter})) {
                        $filter = "(&$filter$opts->{filter})";
                    }
                    my @vals = $self->_searchLism($opts, $filter);
                    if (!@vals || !$vals[0]) {
                        print $fd encode('utf8', "$timestamp: $attr=$value in $dn is invalid: value doesn't exist in data\n");
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                    }
                }
                if (defined($cattr->{lismunique})) {
                    my $opts = $cattr->{lismopts};
                    my $filter = "($opts->{attr}=$value)";
                    if (defined($opts->{filter})) {
                        $filter = "(&$filter$opts->{filter})";
                    }
                    my ($id) = ($dn =~ /^[^=]+=([^,]+),/);
                    $filter =~ s/\%i/$id/g;
                    my @vals = $self->_searchLism($opts, $filter);
                    if (@vals && $vals[0]) {
                        print $fd encode('utf8', "$timestamp: $attr=$value in $dn is invalid: value already exist in data\n");
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                    }
                }
            }
        }
    }

    return $rc;
}

sub _checkMaxEntries
{
    my $self = shift;
    my ($opts, $dn, $attr, $entryStr, @values) = @_;
    my $conf = $self->{_config};

    my ($base) = ($dn =~ /($opts->{dn})/i);
    if (!$base) {
        return 1;
    }

    my ($rc, @entries) = $self->{lism}->search($base, 0, 0, 0, 0, '(objectClass=*)', 0);
    if ($rc) {
        $self->log(level => 'err', message => "searching max number($base) failed($rc)");
        return undef;
    }

    if (@entries) {
        my $checkEntry = $entries[0];
        if ($attr) {
            my $idattr = defined($opts->{uid}) ? $opts->{uid} : $opts->{service};
            my @ids = ($entryStr =~ /^$idattr: (.+)$/gmi);
            undef($opts->{increment});
            $opts->{increment} = {};
            foreach my $value (@values) {
                if ($value =~ /^ *$/) {
                    next;
                }

                foreach my $id (@ids) {
                    my $maxattr = $opts->{max};
                    my $currentattr = $opts->{current};
                    $maxattr =~ s/\%a/$value/;
                    $maxattr =~ s/\%i/$id/;
                    $currentattr =~ s/\%a/$value/;
                    $currentattr =~ s/\%i/$id/;
                    my ($max) = ($checkEntry =~ /^$maxattr: (.*)$/mi);
                    my ($current) = ($checkEntry =~ /^$currentattr: (.*)$/mi);
                    if (!defined($max)) {
                        return 1;
                    }
                    my $service;
                    if (defined($opts->{uid})) {
                        $service = $value;
                    } else {
                        $service = $id;
                    }

                    my $filterStr = $opts->{check};
                    $filterStr =~ s/\%a/$value/g;
                    $filterStr =~ s/\%i/$id/g;
                    my ($idrc, @identries) = $self->{lism}->search($base, 2, 0, 0, 0, $filterStr, 0, $idattr);
                    if ($idrc) {
                        $self->log(level => 'err', message => "searching entries with $id failed($idrc)");
                        return undef;
                    }
                    if (!@identries) {
                        if (!defined($opts->{increment}->{$service})) {
                            $opts->{increment}->{$service} = 0;
                        }
                        $opts->{increment}->{$service}++;
                        if ($current + $opts->{increment}->{$service} > $max) {
                            return (0, "$maxattr=$max");
                        }
                    }
                }
            }
        } else {
            my ($max) = ($checkEntry =~ /^$opts->{max}: (.*)$/mi);
            my ($current) = ($checkEntry =~ /^$opts->{current}: (.*)$/mi);
            $current++;
            if (!defined($max)) {
                return 1;
            } elsif ($current > $max) {
                return (0, "$opts->{max}=$max");
            }
        }
    }

    return 1;
}

sub _updateCurrentEntries
{
    my $self = shift;
    my ($opts, $dn, $func, $attr, $entryStr, @delvals) = @_;
    my $conf = $self->{_config};

    my ($base) = ($dn =~ /($opts->{dn})/i);
    if (!$base) {
        return 1;
    }

    my ($rc, @entries) = $self->{lism}->search($base, 0, 0, 0, 0, '(objectClass=*)', 0);
    if ($rc) {
        $self->log(level => 'err', message => "searching max number($base) failed($rc)");
        return undef;
    }

    if (@entries) {
        my @list;
        my $checkEntry = $entries[0];
        if ($attr) {
            my %currentvals;
            if (($func eq 'add' || $func eq 'modify') && defined($opts->{increment})) {
                foreach my $service (keys %{$opts->{increment}}) {
                    my $currentattr = $opts->{current};
                    $currentattr =~ s/\%[ai]/$service/;
                    my ($current) = ($checkEntry =~ /^$currentattr: (.*)$/mi);
                    $currentvals{$service} = $current + ${$opts->{increment}}{$service};
                }
            }
            if (($func eq 'modify' || $func eq 'delete') && @delvals && $delvals[0] !~ /^ *$/) {
                my $idattr = defined($opts->{uid}) ? $opts->{uid} : $opts->{service};
                my @ids = ($entryStr =~ /^$idattr: (.+)$/gmi);
                foreach my $value (@delvals) {
                    foreach my $id (@ids) {
                        my $service;
                        if (defined($opts->{uid})) {
                            $service = $value;
                        } else {
                            $service = $id;
                        }
                        my $filterStr = $opts->{check};
                        $filterStr =~ s/\%a/$value/g;
                        $filterStr =~ s/\%i/$id/g;
                        my ($idrc, @identries) = $self->{lism}->search($base, 2, 0, 0, 0, $filterStr, 0, $idattr);
                        if ($idrc) {
                            $self->log(level => 'err', message => "searching entries with $id failed($idrc)");
                            return undef;
                        }
                        if (!@identries) {
                            if (defined($currentvals{$service})) {
                                $currentvals{$service}--;
                            } else {
                                my $currentattr = $opts->{current};
                                $currentattr =~ s/\%a/$value/;
                                $currentattr =~ s/\%i/$id/;
                                my ($current) = ($checkEntry =~ /^$currentattr: (.*)$/mi);
                                $currentvals{$service} = $current - 1;
                            }
                        }
                    }
                }
            }
            foreach my $service (keys %currentvals) {
                my $currentattr = $opts->{current};
                $currentattr =~ s/\%[ai]/$service/;
                push(@list, 'REPLACE', $currentattr, $currentvals{$service});
            }
        } else {
            my ($current) = ($checkEntry =~ /^$opts->{current}: (.*)$/mi);
            if ($func eq 'add') {
                $current++;
            } else {
                $current--;
            }
            @list = ('REPLACE', $opts->{current}, $current);
        }

        if (@list) {
            $rc = $self->{lism}->modify($base, @list);
            if ($rc) {
                $self->log(level => 'err', message => "modifying current number($base) failed($rc)");
                return undef;
            }
        }
    }

    return 1;
}

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

    if ($rc = $self->SUPER::_checkConfig()) {
        return $rc;
    }

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

    if (!defined($conf->{file}) && !defined($conf->{command})) {
        $self->log(level => 'alert', message => "Set file or command");
        return 1;
    }

    if (defined($conf->{check})) {
        foreach my $rule (@{$conf->{check}}) {
            if (defined($rule->{filter})) {
                $rule->{filterobj} = Net::LDAP::Filter->new($rule->{filter});
            }
            if (defined($rule->{entry}) && defined($rule->{entry}[0]->{maxentries})) {
                my $maxentries = $rule->{entry}[0]->{maxentries}[0];
                if (!defined($maxentries->{dn}) || !defined($maxentries->{max}) || !defined($maxentries->{current})) {
                    $self->log(level => 'alert', message => "Set dn,max,current in maxentries");
                    return 1;
                }
            }

            foreach my $cattr (keys %{$rule->{attr}}) {
                if (defined($rule->{attr}{$cattr}->{lismexist}) || defined($rule->{attr}{$cattr}->{lismunique})) {
                    if (defined($rule->{attr}{$cattr}->{lismopts})) {
                        next;
                    }
                    my ($name) = keys %{$rule->{attr}{$cattr}};
                    my $lismopts = {};
                    my ($base, $attr, $scope, $filter) = split(/\?/, $rule->{attr}{$cattr}->{$name}[0]);
                    $lismopts->{base} = $base;
                    $lismopts->{attr} = $attr;
                    if ($scope) {
                        $lismopts->{scope} = $scope;
                    }
                    if ($filter) {
                        $lismopts->{filter} = $filter;
                    }
                    $rule->{attr}{$cattr}->{lismopts} = $lismopts;
                } elsif (defined($rule->{attr}{$cattr}->{maxentries})) {
                    my $maxentries = $rule->{attr}{$cattr}->{maxentries}[0];
                    if (!defined($maxentries->{dn}) || !defined($maxentries->{max}) || !defined($maxentries->{current}) || !defined($maxentries->{check})) {
                        $self->log(level => 'alert', message => "Set dn,max,current,check in maxentries");
                        return 1;
                    }
                    $maxentries->{check} =~ s/&amp;/&/g;
                    if (!defined($maxentries->{uid}) && !defined($maxentries->{service})) {
                        $self->log(level => 'alert', message => "Set id or service in maxentries");
                        return 1;
                    }
                }
            }
        }
    }

    return $rc;
}

=head1 SEE ALSO

L<LISM>,
L<LISM::Handler>

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