package LISM::Handler::Rewrite;

use strict;
use base qw(LISM::Handler);
use Net::LDAP;
use Net::LDAP::Constant qw(:all);
use URI;
use Sys::Syslog;
use Sys::Syslog qw(:macros);
use Data::Dumper;

=head1 NAME

LISM::Handler::Rewrite - Handler to do script

=head1 DESCRIPTION

This class implements the L<LISM::Hanlder> interface to do script.

=head1 METHODS

=pod

=head2 pre_bind($binddnp)

Rewrite bind dn before bind operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$binddnp} !~ /$rule->{dn}/i) {
                next;
            }

            my $substitution = $rule->{substitution};
            $substitution =~ s/%0/${$binddnp}/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$binddnp});
            if (!$str) {
                $self->log(level => 'error', message => "bind rewrite \"${$binddnp}\" failed");
                return -1;
            }
            ${$binddnp} = $str;
        }
    }

    return 0;
}

=head2 pre_compare($dnp, $avaStrp)

Rewrite dn and attribute, value before compare operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$dnp} !~ /$rule->{dn}/i) {
                next;
            }

            my %rwcache;
            my $substitution = $rule->{substitution};
            $substitution =~ s/%0/${$dnp}\n${$avaStrp}/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$dnp}, \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "compare rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$dnp} = $str;

            $str = $self->_rewriteParse($rule->{match}, $substitution, ${$avaStrp}, \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "compcare rewrite \"${$dnp}\" failed");
                return -1;
             }
             ${$avaStrp} = $str;
        }
    }

    return 0;
}

=head2 pre_search($basep, $filterStrp)

Rewrite base dn and filter before search operation is done.

=cut

sub pre_search
{
    my $self = shift;
    my ($basep, $filterStrp) = @_;
    my $conf = $self->{_config};

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            my %rwcache;
            my $substitution = $rule->{substitution};

            $substitution =~ s/%0/${$basep}\n${$filterStrp}/;
            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$basep}, \%rwcache);
            if (!defined($str)) {
                $self->log(level => 'error', message => "search rewrite \"${$basep}\" failed");
                return -1;
            }
            ${$basep} = $str;

            $str = $self->_rewriteParse($rule->{match}, $substitution, ${$filterStrp}, \%rwcache);
            if (!defined($str)) {
                $self->log(level => 'error', message => "search rewrite \"${$basep}\" failed");
                return -1;
            }
            ${$filterStrp} = $str;
        }
    }

    return 0;
}

=head2 post_search($entriesp)

Rewrite base dn and filter after search operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'searchResult') {
            for (my $i = 0; $i < @{$entriesp}; $i++) {
                my %rwcache;
                my $rc = 0;
                my $substitution = $rule->{substitution};
                $substitution =~ s/%0/${$entriesp}[$i]/;

                my (@line) = split(/\n/, ${$entriesp}[$i]);
                my ($dn) = ($line[0] =~ /^dn: (.*)$/);
                if (defined($rule->{dn}) && $dn !~ /$rule->{dn}/i) {
                    next;
                }

                my $str = $self->_rewriteParse($rule->{match}, $substitution, $dn, \%rwcache);
                if (!$str) {
                    $self->log(level => 'error', message => "search result rewrite \"$dn\" failed");
                    next;
                }
                $line[0] = "dn: $str";

                my @replaced;
                for (my $j = 1; $j < @line; $j++) {
                    $line[$j] = $self->_rewriteParse($rule->{match}, $substitution, $line[$j], \%rwcache);
                    if (!defined($line[$j])) {
                        $self->log(level => 'error', message => "search result rewrite \"$dn\" failed");
                        $rc = -1;
                        last;
                    } elsif ($line[$j]) {
                        push(@replaced, $line[$j]);
                    }
                }
                if (!$rc) {
                    ${$entriesp}[$i] = "$line[0]\n".join("\n", $self->_unique(@replaced))."\n";
                }
            }
        }
    }

    return 0;
}

=pod

=head2 pre_modify($dnp, $listp)

Rewrite dn and attributes, values before modify operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$dnp} !~ /$rule->{dn}/i) {
                next;
            }

            my %rwcache;
            my $substitution = $rule->{substitution};
            my $modlist = "${$dnp}\n".join("\n", @{$listp});
            $substitution =~ s/%0/$modlist/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$dnp}, \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "modify rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$dnp} = $str;

            my @mod_list;
            while (@{$listp} > 0) {
                my $action = shift @{$listp};
                my $attr = shift @{$listp};
                my @values;
                my %replaced;

                $str = $self->_rewriteParse($rule->{match}, $substitution, "$action: $attr");
                ($attr) = ($str =~ /^[^:]+: (.*)$/);
                while (@{$listp} > 0 && ${$listp}[$0] !~ /ADD|DELETE|REPLACE/) {
                    push(@values, shift @{$listp});
                }

                if (@values) {
                    for (my $i =0; $i < @values; $i++) {
                        $str = $self->_rewriteParse($rule->{match}, $substitution, "$attr: ".$values[$i], \%rwcache);
                        if (!defined($str)) {
                            $self->log(level => 'error', message => "modify rewrite \"${$dnp}\" failed");
                            return -1;
                        } elsif ($str) {
                            foreach my $line (split(/\n/, $str)) {
                                my ($rwattr, $value) = split(/: */, $line);
                                if (!defined($replaced{$rwattr})) {
                                    @{$replaced{$rwattr}} = ();
                                }
                                push(@{$replaced{$rwattr}}, $value);
                            }
                        }
                    }
                    foreach my $rwattr (keys %replaced) {
                        push(@mod_list, ($action, $rwattr, @{$replaced{$rwattr}}));
                    }
                } else {
                    push(@mod_list, ($action, $attr));
                }
            }
            @{$listp} = @mod_list;
        }
    }

    return 0;
}

=pod

=head2 pre_add($dnp, $entryStrp)

Rewrite entry before add operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$dnp} !~ /$rule->{dn}/i) {
                next;
            }

            my %rwcache;
            my $substitution = $rule->{substitution};
            $substitution =~ s/%0/${$dnp}\n${$entryStrp}[0]/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$dnp}, \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "add rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$dnp} = $str;

            my (@line) = split(/\n/, ${$entryStrp}[0]);

            for (my $i = 0; $i < @line; $i++) {
                $line[$i] = $self->_rewriteParse($rule->{match}, $substitution, $line[$i], \%rwcache);
                if (!defined($line[$i])) {
                    $self->log(level => 'error', message => "add rewrite \"${$dnp}\" failed");
                    return -1;
                }
            }
            ${$entryStrp}[0] = join("\n", @line)."\n";
        }
    }

    return 0;
}

=head2 pre_modrdn($dnp, $argsp)

Rewrite dn and new rdn before modrdn operation is done.

=cut

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

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$dnp} !~ /$rule->{dn}/i) {
                next;
            }

            my %rwcache;
            my $substitution = $rule->{substitution};
            $substitution =~ s/%0/${$dnp}\n${$argsp}[0]/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$dnp}, \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "modrdn rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$dnp} = $str;

            $str = $self->_rewriteParse($rule->{match}, $substitution, ${$argsp}[0], \%rwcache);
            if (!$str) {
                $self->log(level => 'error', message => "modrdn rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$argsp}[0] = $str;
        }
    }

    return 0;
}

=pod

=head2 pre_delete($dnp)

Rewrite dn before delete operation is done.
    
=cut
    
sub pre_delete
{
    my $self = shift;
    my ($dnp) = @_;
    my $conf = $self->{_config};

    foreach my $rule (@{$conf->{rewrite}}) {
        if ($rule->{context} eq 'request') {
            if (defined($rule->{dn}) && ${$dnp} !~ /$rule->{dn}/i) {
                next;
            }

            my $substitution = $rule->{substitution};
            $substitution =~ s/%0/${$dnp}/;

            my $str = $self->_rewriteParse($rule->{match}, $substitution, ${$dnp});
            if (!$str) {
                $self->log(level => 'error', message => "delete rewrite \"${$dnp}\" failed");
                return -1;
            }
            ${$dnp} = $str;
        }
    }

    return 0;
}


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 => "rewrite do require $lib: $@");
                return 1;
            }
        }
    }

    if (defined($conf->{rewritemap})) {
        foreach my $map_name (keys %{$conf->{rewritemap}}) {
            if ($conf->{rewritemap}{$map_name}->{type} eq 'ldap') {
                if (!defined($self->{ldapmap})) {$self->{ldapmap} = {}};
                my $ldapmap = {};
                $ldapmap->{uri} = $conf->{rewritemap}{$map_name}->{attrs};
                my $uri = URI->new($ldapmap->{uri});
                $ldapmap->{base} = $uri->dn;
                ($ldapmap->{attr}) = $uri->attributes;
                my %extn = $uri->extensions;
                $ldapmap->{binddn} = $extn{binddn};
                $ldapmap->{bindpw} = $extn{bindpw};
                $ldapmap->{ldap} = undef;
                $self->{ldapmap}{$map_name} = $ldapmap;
            }
        }
    }

    return $rc;
}

sub _rewriteParse
{
    my $self = shift;
    my ($match, $substitution, $str, $rwcache) = @_;

    my @matches = ($str =~ /$match/gi);

    # replace variables
    for (my $i = 0; $i < @matches; $i++) {
        my $num = $i + 1;
        $substitution =~ s/%$num/$matches[$i]/g;
    }

    if ($str =~ /$match/i) {
        # do functions
        my @subs = ($substitution);
        my @rwmaps = ($substitution =~ /%{([^}]*)}/g);
        foreach my $rwmap (@rwmaps) {
            my @values;
            my $key = lc($rwmap);
            if (defined(${$rwcache}{$key})) {
                @values = @{${$rwcache}{$key}};
            } else {
                my ($map_name, $map_args) = ($rwmap =~ /^([^(]*)\((.*)\)$/);
                @values = $self->_rewriteMap($map_name, $map_args);
                if (!defined(@values)) {
                    return undef;
                }

                ${$rwcache}{$key} = \@values;
            }

            if (!$values[0]) {
                return $str;
            }

            $rwmap =~ s/([()])/\\$1/g;
            my @tmpsubs;
            foreach my $sub (@subs) {
                foreach my $value (@values) {
                    my $tmpsub = $sub;
                    $tmpsub =~ s/%{$rwmap}/$value/;
                    push(@tmpsubs, $tmpsub);
                }
            }
            undef(@subs);
            @subs = @tmpsubs;
        }

        my @strs;
        foreach my $sub (@subs) {
            my $tmpstr = $str;
            $tmpstr =~ s/$match/$sub/gi;
            push(@strs, $tmpstr);
        }
        $str = join("\n", @strs);
    }

    return $str;
}

sub _rewriteMap
{
    my $self = shift;
    my ($map_name, $map_args) = @_;
    my $conf = $self->{_config};
    my @values = ();

    if (defined($conf->{rewritemap}{$map_name})) {
        my $method = '_'.$conf->{rewritemap}{$map_name}->{type}.'Map';
        @values = $self->$method($map_name, $map_args);
    }

    return @values;
}

sub _ldapMap
{
    my $self = shift;
    my ($map_name, $map_args) = @_;
    my $ldapmap = $self->{ldapmap}{$map_name};
    my $base = $ldapmap->{base};
    my $scope = 'sub';
    my $filter = $map_args;
    my $msg;
    my $rc;
    my @values = ('');

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

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

    if ($map_args =~ /^\(?dn=/) {
        ($base) = ($map_args =~ /^\(?dn=(.*)\)?$/);
        $scope = 'base';
        $filter = 'objectClass=*';
    }

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

    $rc = $msg->code;
    if ($rc) {
        $self->log(level => 'error', message => "rewriteMap $map_name search by $map_args failed($rc)");
        if ($rc == LDAP_SERVER_DOWN) {
            $ldapmap->{ldap}->unbind();
            undef($ldapmap->{ldap});
        }

        return undef;
    }

    if ($msg->count) {
        my $entry = $msg->entry(0);
        if ($ldapmap->{attr} eq 'dn') {
            $values[0] = $entry->dn;
        } else {
            @values = $entry->get_value($ldapmap->{attr});
        }

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

    return @values;
}

sub _functionMap
{
    my $self = shift;
    my ($map_name, $map_args) = @_;
    my @values;

    eval "\@values = $map_name($map_args)";
    if ($@) {
        $self->log(level => 'error', message => "rewriteMap $map_name failed: $@");
        return undef;
    }

    return @values;
}

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