package LISM::Storage::LDAP;

use strict;
use base qw(LISM::Storage);
use Net::LDAP;
use Net::LDAP::Constant qw(:all);
use MIME::Base64;
use Encode;
use Sys::Syslog;
use Sys::Syslog qw(:macros);
use Data::Dumper;

=head1 NAME

LISM::Storage::LDAP - LDAP storage for LISM

=head1 DESCRIPTION

This class implements the L<LISM::Storage> interface for LDAP directory.

=head1 METHODS

=head2 init

Connect LDAP server.

=cut

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

    $self->SUPER::init();

    ($conf->{nc}) = ($conf->{uri}[0] =~ /^ldaps?:\/\/[^\/]+\/(.+)$/i);

    return 0;
}

=pod

=head2 commit

Do nothing.

=cut

sub commit
{
    return 0;
}

=pod

=head2 rollback

Do nothing.

=cut

sub rollback
{
    return 0;
}

=pod

=head2 bind($binddn, $passwd)

Bind to LDAP server.

=cut

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

    $binddn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $binddn = decode('utf8', $binddn);

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

    my $msg = $self->{bind}->bind($binddn, password => $passwd);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 search($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs)

Search LDAP information.

=cut

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

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

    # 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--;
            }
        }
    }
    $sizeLim = $sizeLim - @match_entries;

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

    # Attribute mapping
    foreach my $ldapmap (@{$conf->{ldapmap}}) {
        if ($ldapmap->{type} =~ /^objectclass$/i) {
            $filterStr =~ s/objectClass=$ldapmap->{local}[0]$/objectClass=$ldapmap->{foreign}[0]/mi;
        } else {
            $filterStr =~ s/\($ldapmap->{local}[0]=/\($ldapmap->{foreign}[0]=/mi;
        }
    }

    $base =~ s/$self->{suffix}$/$conf->{nc}/i;
    $base = decode('utf8', $base);
    $filterStr =~ s/$self->{suffix}(\)*)/$conf->{nc}$1/gi;
    $filterStr = encode('utf8', $filterStr);
    my $msg = $self->{ldap}->search(base => $base, scope => $scope, deref => $deref, sizeLimit => $sizeLim, timeLimit => $timeLim, filter => $filterStr);

    if (!$msg->code) {
        for (my $i = 0; $i < $msg->count; $i++) {
            my $entry = $msg->entry($i);
            my $dn = $entry->dn;

            $dn =~ s/$conf->{nc}$/$self->{suffix}/i;
            my $entryStr = "dn: $dn\n";
            if ($dn =~ /^$self->{suffix}$/i) {
                next;
            } else {
                foreach my $attr ($entry->attributes) {
                    foreach my $value ($entry->get_value($attr)) {
                        $value =~ s/$conf->{nc}$/$self->{suffix}/i;
                        $entryStr = $entryStr."$attr: $value\n";
                    }
                }
            }

            # Attribute mapping
            foreach my $ldapmap (@{$conf->{ldapmap}}) {
                if ($ldapmap->{type} =~ /^objectclass$/i) {
                    $entryStr =~ s/^objectClass: $ldapmap->{foreign}[0]$/objectClass: $ldapmap->{local}[0]/mi;
                } else {
                    $entryStr =~ s/^$ldapmap->{foreign}[0]:/$ldapmap->{local}[0]:/mi;
                }
            }

            $entryStr = decode('utf8', $entryStr);

            push(@match_entries, $entryStr);
        }
    }

    $self->_freeConnect($msg);

    return ($msg->code , @match_entries);
}

=pod

=head2 compare($dn, $avaStr)

Compare the value of attribute in LDAP information.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $dn = decode('utf8', $dn);

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

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

    # Attribute Mapping
    foreach my $ldapmap (@{$conf->{ldapmap}}) {
        if ($ldapmap->{type} =~ /^objectclass$/i) {
            if ($key =~ /^objectClass$/i) {
                $avaStr =~ s/^$ldapmap->{local}[0]$/$ldapmap->{foreign}[0]/i;
            }
        } else {
            if ($key =~ /^$ldapmap->{local}[0]$/i) {
                $key = $ldapmap->{foreign}[0];
            }
        }
    }

    my $msg = $self->{ldap}->compare($dn, attr => $key, value => $val);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 modify($dn, @list)

Modify LDAP information.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $dn = decode('utf8', $dn);

    my @changes;
    while ( @list > 0) {
        my $action = shift @list;
        my $key    = 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 ($key =~ /^modifyTimestamp$/i) {
            next;
        }

        if ($key eq 'entrycsn') {
            last;
        }

        # Attribute Mapping
        foreach my $ldapmap (@{$conf->{ldapmap}}) {
            if ($ldapmap->{type} =~ /^objectclass$/i) {
                if ($key =~ /^objectClass$/i) {
                    for (my $i = 0; $i < @values; $i++) {
                        $values[$i] =~ s/^$ldapmap->{local}[0]$/$ldapmap->{foreign}[0]/i;
                    }
                }
            } else {
                if ($key =~ /^$ldapmap->{local}[0]$/i) {
                    $key = $ldapmap->{foreign}[0];
                }
            }
        }

        for (my $i = 0; $i < @values; $i++) {
            $values[$i] =~ s/$self->{suffix}/$conf->{nc}/i;
            if ($values[$i]) {
                $values[$i] = decode('utf8', $values[$i]);
            }
        }

        if ($action eq "DELETE" && !$values[0]) {
            push(@changes, lc($action) => [$key => []]);
        } else {
            push(@changes, lc($action) => [$key => \@values]);
        }
    }

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

    my $msg = $self->{ldap}->modify($dn, changes => [@changes]);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 add($dn, $entryStr)

Add information in LDAP directory.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $dn = decode('utf8', $dn);
    $entryStr = decode('utf8', $entryStr);

    my %attrs;
    my @info = split(/\n/, $entryStr);
    foreach my $attr (@info) {
        my ($key, $val) = split(/: /, $attr);
        if ($key =~ /^(createTimestamp|modifyTimestamp)$/i) {
            next;
        }

        if ($key eq 'structuralObjectClass') {
            last;
        }

        # Attribute Mapping
        foreach my $ldapmap (@{$conf->{ldapmap}}) {
            if ($ldapmap->{type} =~ /^objectclass$/i) {
                if ($key =~ /^objectClass$/i) {
                    $val =~ s/^$ldapmap->{local}[0]$/$ldapmap->{foreign}[0]/i;
                }
            } else {
                if ($key =~ /^$ldapmap->{local}[0]$/i) {
                    $key = $ldapmap->{foreign}[0];
                }
            }
        }

        $val =~ s/$self->{suffix}/$conf->{nc}/i;
        push(@{$attrs{$key}}, $val);
    }

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

    my $msg = $self->{ldap}->add($dn, attrs => [%attrs]);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 modrdn($dn, $newrdn, $delFlag)

move information in LDAP directory.

=cut

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

    my $conf = $self->{_config};

    $dn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $dn = decode('utf8', $dn);
    $newrdn = decode('utf8', $newrdn);

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

    my $msg = $self->{ldap}->modrdn($dn, newrdn => $newrdn, deleteoldrdn => $delFlag);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 delete($dn)

Delete information from LDAP directory.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{nc}/i;
    $dn = decode('utf8', $dn);

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

    my $msg = $self->{ldap}->delete($dn);

    $self->_freeConnect($msg);

    return $msg->code;
}

=pod

=head2 hashPasswd($passwd, $salt)

add hash schema at the head of hashed password.

=cut

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

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

    my $hashpw = $self->SUPER::hashPasswd($passwd, $salt);

    if ($htype =~ /^AD$/i) {
        # encoding for Active Directory
        $hashpw = '';
        map {$hashpw .= "$_\000"} split(//, "\"$passwd\"");
    } elsif (defined($hashpw) && $htype =~ /^CRYPT|MD5|SHA$/i) {
        $hashpw = "{$htype}$hashpw";
    }

    return $hashpw;
}


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

    if (defined($self->{ldap}) && defined($self->{bind})) {
        return 0;
    }

    $self->{ldap} = Net::LDAP->new($conf->{uri}[0]);
    $self->{bind} = Net::LDAP->new($conf->{uri}[0]);

    if (!defined($self->{ldap}) || !defined($self->{bind})) {
        $self->log(level => 'alert', message => "Can't connect $conf->{uri}[0]");
        return -1;
    }

    my $msg = $self->{ldap}->bind($conf->{binddn}[0], password => $conf->{bindpw}[0]);
    if ($msg->code) {
        $self->log(level => 'alert', message => "Can't bind $conf->{uri}[0] by $conf->{binddn}[0]");
        return -1;
    }

    return 0;
}

sub _freeConnect
{
    my $self =shift;
    my ($msg) = @_;

    if ($msg->code == LDAP_SERVER_DOWN || $msg->code == -1) {
        $self->{ldap}->unbind();
        $self->{bind}->unbind();

        undef($self->{ldap});
        undef($self->{bind});
    }
}

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

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

    foreach my $ldapmap (@{$conf->{ldapmap}}) {
        if (!defined($ldapmap->{type})) {
            $ldapmap->{type} = 'attribute';
        }
    }

    return $rc;
}

=head1 SEE ALSO

L<LISM>,
L<LISM::Storage>

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