package LISM::Storage::SOAP;

use strict;
use base qw(LISM::Storage);
use Net::LDAP::Constant qw(:all);
use Encode;
use Data::Dumper;
use SOAP::Lite
    on_fault => sub {
        my $soap = shift;
        my $res = shift;
        ref $res ? warn("SOAP FAULT: ".$res->faultstring."(".$res->faultcode.")")
                 : warn("TRANSPORT ERROR: ".$soap->transport->status);
        return new SOAP::SOM;
    };


=head1 NAME

LISM::Storage::SOAP - SOAP storage for LISM

=head1 DESCRIPTION

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

=head1 METHODS

=head2 init

Connect SOAP server.

=cut

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

    $self->SUPER::init();

    if (!defined($self->{soap})) {
        $self->{soap} = SOAP::Lite->new;
        if (defined($conf->{uri})) {
            $self->{soap}->uri($conf->{uri}[0]);
        }
        $self->{soap}->proxy($conf->{proxy}[0]);
    }

    if (!Encode::is_utf8($conf->{basedn}[0])) {
        $conf->{basedn}[0] = decode('utf8', $conf->{basedn}[0]);
    }

    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 SOAP server.

=cut

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

    $binddn =~ s/$self->{suffix}$/$conf->{basedn}[0]/i;

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

    my $res = $self->{soap}->bind(
        SOAP::Data->name('binddn' => $binddn),
        SOAP::Data->name('bindpw' => $passwd)
        );

    if (!ref $res) {
        $self->log(level => 'err', message => "Binding to SOAP server failed: ".$self->{soap}->transport->status);
    } elsif (!defined($res->result)) {
        $self->log(level => 'err', message => "Binding to SOAP server failed: ".$res->faultstring);
    }

    $rc = ${$res->result}[0];
    if (!$rc) {
        $self->{soap}->unbind(
            SOAP::Data->name('sessid' => ${$res->result}[2])
            );
    }

    $self->_freeConnect();

    return $rc;
}

=pod

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

Search SOAP data.

=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}$/i) {
        if ($scope != 1) {
            my $entry = $self->{contentrystr};
            if ($self->parseFilter($filter, $entry)) {
                push (@match_entries, $entry);
                if ($sizeLim > 0) {
                    $sizeLim--;
                }
            }
        }
    }
    $sizeLim = $sizeLim > 0 ? $sizeLim - @match_entries : $sizeLim;
    if ($sizeLim < 0) {
        return ($rc, @match_entries);
    }

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

    $filterStr = $self->_mb_conv($filterStr);

    $base =~ s/$self->{suffix}$/$conf->{basedn}[0]/i;
    $filterStr =~ s/$self->{suffix}(\)*)/$conf->{basedn}[0]$1/gi;

    my $res = $self->{soap}->search(
        SOAP::Data->name('sessid' => $self->{sessid}),
        SOAP::Data->name('base' => $base),
        SOAP::Data->name('scope' => $scope),
        SOAP::Data->name('deref' => $deref),
        SOAP::Data->name('sizeLim' => $sizeLim),
        SOAP::Data->name('timeLim' => $timeLim),
        SOAP::Data->name('filter' => $filterStr),
        SOAP::Data->name('attrOnly' => 0),
        SOAP::Data->name('attrs' => \@attrs)
    );

    if (!ref $res) {
        $self->log(level => 'err', message => "Searching SOAP server failed: ".$self->{soap}->transport->status);
        return (LDAP_OTHER, ());
    } elsif (!defined($res->result)) {
        $self->log(level => 'err', message => "Searching SOAP server failed: ".$res->faultstring);
        return (LDAP_OTHER, ());
    }

    $rc = ${$res->result}[0];
    if (!$rc) {
        for (my $i = 0; $i < @{${$res->result}[2]}; $i++) {
            my $entryStr = ${${$res->result}[2]}[$i];
            $entryStr = decode('utf8', $entryStr);

            $entryStr =~ s/$conf->{basedn}[0]$/$self->{suffix}/mi;
            if ($entryStr =~ /^dn: $self->{suffix}\n/i) {
                next;
            }

            if (!$self->_checkEntry($entryStr)) {
                next;
            }

            push(@match_entries, $entryStr);
        }
    }

    $self->_freeConnect();

    return ($rc , @match_entries);
}

=pod

=head2 modify($dn, @list)

Modify information by SOAP.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{basedn}[0]/i;

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

        for (my $i = 0; $i < @values; $i++) {
            $values[$i] =~ s/$self->{suffix}/$conf->{basedn}[0]/i;
            $values[$i] = encode('utf8', $values[$i]);
            if ($values[$i]) {
                # replace carriage return to linefeed
                $values[$i] =~ s/\r/$conf->{breakchar}/g;
            }
        }

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

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

    my $res = $self->{soap}->modify(
        SOAP::Data->name('sessid' => $self->{sessid}),
        SOAP::Data->name('dn' => $dn),
        SOAP::Data->name('modifyRequest')
              ->type('modifyRequest')
              ->value(\SOAP::Data->value(@changes))
        );

    if (!ref $res) {
        $self->log(level => 'err', message => "Modifying SOAP server failed: ".$self->{soap}->transport->status);
        return LDAP_OTHER;
    } elsif (!defined($res->result)) {
        $self->log(level => 'err', message => "Modifying SOAP server failed: ".$res->faultstring);
        return LDAP_OTHER;
    }

    $rc = ${$res->result}[0];

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 add($dn, $entryStr)

Add information by SOAP.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{basedn}[0]/i;
    $entryStr = encode('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;
        }

        $val =~ s/$self->{suffix}/$conf->{basedn}[0]/i;

        # replace carriage return to linefeed
        $val =~ s/\r/$conf->{breakchar}/g;

        push(@{$attrs{$key}}, $val);
    }

    my @attrs = ();
    foreach my $key (keys %attrs) {
        push(@attrs, SOAP::Data->name($key => $attrs{$key}));
    }

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

    my $res = $self->{soap}->add(
        SOAP::Data->name('sessid' => $self->{sessid}),
        SOAP::Data->name('dn' => $dn),
        SOAP::Data->name('addRequest')
              ->type('addRequest')
              ->value(\SOAP::Data->value(@attrs))
        );

    if (!ref $res) {
        $self->log(level => 'err', message => "Adding SOAP server failed: ".$self->{soap}->transport->status);
        return LDAP_OTHER;
    } elsif (!defined($res->result)) {
        $self->log(level => 'err', message => "Adding SOAP server failed: ".$res->faultstring);
        return LDAP_OTHER;
    }

    $rc = ${$res->result}[0];

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 delete($dn)

Delete data from SOAP server.

=cut

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

    $dn =~ s/$self->{suffix}$/$conf->{basedn}[0]/i;

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

    my $res = $self->{soap}->delete(
        SOAP::Data->name('sessid' => $self->{sessid}),
        SOAP::Data->name('dn' => $dn)
    );

    if (!ref $res) {
        $self->log(level => 'err', message => "Deleting SOAP server failed: ".$self->{soap}->transport->status);
        return LDAP_OTHER;
    } elsif (!defined($res->result)) {
        $self->log(level => 'err', message => "Deleting SOAP server failed: ".$res->faultstring);
        return LDAP_OTHER;
    }

    $rc = ${$res->result}[0];

    $self->_freeConnect();

    return $rc;
}


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

    if (defined($self->{sessid})) {
        $res = $self->{soap}->isauth($self->{sessid});
        if (ref $res && defined($res->result) && $res->result) {
            return 0;
        } else {
            $self->log(level => 'err', message => "Connection check failed");
            undef($self->{sessid});
        }
    }

    $res = $self->{soap}->bind($conf->{binddn}[0], $conf->{bindpw}[0]);
    if (!ref $res || !defined($res->result) || ${$res->result}[0]) {
        $self->log(level => 'alert', message => "Can't connect to $conf->{proxy}[0]");
        return -1;
    }

    $self->{sessid} = ${$res->result}[2];

    return 0;
}

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

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

    if (!defined($conf->{'proxy'})) {
        $self->log(level => 'alert', message => "proxy of SOAP doesn't exist");
        return 1;
    }

    return $rc;
}

sub _checkEntry
{
    my $self = shift;
    my ($entryStr) = @_;

    if ($entryStr !~ /^dn: .+\n.+/) {
        return 0;
    }

    return 1;
}

sub _mb_conv
{
    my $self = shift;
    my ($str) = @_;

    my @chars = ($str =~ /\\([0-9A-F]{2})/g);

    if (!@chars || @chars % 3) {
        return $str;
    }

    my $conv = pack("H*", join("", @chars));
    my $org = "\\\\".join("\\\\", @chars);
    $str =~ s/$org/$conv/;

    return $str;
}

=head1 SEE ALSO

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

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Kaoru Sekiguchi

=cut

1;
