#
#      TWiki LDAP Plugin
#
#      Written by Gerard Hickey <hickey@kernelrom.com>
#      Modified by Gerald Skerbitz <gsker@tcfreenet.org> to use extractNameValuePair() and provide for
#                  multiple attributes and multiple records.
#     Modified by PatrickNomblot - 26 Jun 2003 to add JPeg Photo
#     Modified by Gerald Skerbitz 24 Oct 2003 to fix bug with shortvs long fields
#     Modified by PatrickNomblot - 9 Dec 2003 to change JPeg Photo to not have IMG hradcoded
#     Modified by GeraldSkerbitz - 13 Jan 2004 to add utf coding 
#     Modified by GeraldSkerbitz and PatrickNomblot - 14 Jan 2004 to add CGI and fix default Filter
#     Modified by GeraldSkerbitz 02 Feb 2004 changed basedn to base everywhere.
#     Modified by GeraldSkerbitz 04 Feb 2004 Code contributed by PatrickNomblot to 
#                  accomodate multiple values per attribute
#     Modified by GeraldSkerbitz 05 Apr 2004 Added Order to sort output 
#     Modified by AndreasVoegele 26 Feb 2006 Upgrade to Cairo.  Uses Encode
#                  or Unicode::MapUTF8 instead of Unicode::String.
 
package TWiki::Plugins::LdapPlugin; 

use strict;
use Net::LDAP;
use File::Spec::Functions qw(catdir catfile);

use vars qw($VERSION $RELEASE $debug $pluginName);

# This should always be $Rev$ so that TWiki can determine the checked-in
# status of the plugin. It is used by the build automation tools, so
# you should leave it alone.
$VERSION = '$Rev$';

# This is a free-form string you can use to "name" your own plugin version.
# It is *not* used by the build automation tools, but is reported as part
# of the version number in PLUGINDESCRIPTIONS.
$RELEASE = 'Cairo';

# Name of this Plugin, only used in this module
$pluginName = 'LdapPlugin';

BEGIN {
    # 'Use locale' for internationalisation of Perl sorting and searching.
    if ($TWiki::useLocale) {
        require locale;
        import locale ();
    }
}

# If available, convert text with Encode, which is provided by Perl 5.8.
# Otherwise fall back to Unicode::MapUTF8 from CPAN.
my $UTF82SiteCharSet = eval {
    require Encode;
    sub {
        my $data = shift;
        Encode::from_to($data, 'utf-8', 'iso-8859-1');
        return $data;
    };
} || eval {
    require Unicode::MapUTF8;
    sub {
        return Unicode::MapUTF8::from_utf8({
            -string => shift,
            -charset => 'iso-8859-1'
        });
    };
} || die "Neither Encode nor Unicode::MapUTF8 found";

sub initPlugin {
    my($theTopic, $theWeb, $theUser, $theInstallWeb) = @_;

    # check for Plugins.pm versions
    if ($TWiki::Plugins::VERSION < 1.025) {
        TWiki::Func::writeWarning("Version mismatch between $pluginName and Plugins.pm");
        return 0;
    }

    # get plugin debug flag
    $debug = TWiki::Func::getPluginPreferencesFlag('DEBUG');

    # Plugin correctly initialized
    return 1;
}

sub _LDAP {
    my($theSession, $theParams, $theTopic, $theWeb) = @_;

    TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) start") if $debug;

    my $result = "";

    # host from setting or from parameter
    my $host = $theParams->{host}
        || TWiki::Func::getPluginPreferencesValue('HOST');

    if (!$host) {
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: no host specified") if $debug;
        return "<b>Error: no host specified for LDAP search</b>";
    }

    # filter from parameter or CgiQuery
    my $cgi = TWiki::Func::getCgiQuery();
    my $cgifilter = "";
    if ($cgi) 
    {
        $cgifilter = $cgi->param('ldapfilter');
        $cgifilter =~ s/^ +//;
        $cgifilter =~ s/^AND\(/&(/;
        $cgifilter =~ s/%(\d\d)/pack("H2",$1)/eg;
    }

    my $filter = $cgifilter || $theParams->{filter};
    if (!$filter) {
        # The word TOPIC in the filter is replaced with the topic.
        $filter = TWiki::Func::getPluginPreferencesValue('DEFAULTFILTER');
        my $topicreplace = TWiki::Func::wikiToUserName($theTopic);
        $filter =~ s/TOPIC/$topicreplace/;
    }
    
    if (!$filter) {
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: no filter specified") if $debug;
        return "<b>Error: no filter specified for LDAP search</b>";
    }

    # format from setting or parameter.  Field list extracted from format.
    my @fields = ();
    my $format = $theParams->{format}
        || TWiki::Func::getPluginPreferencesValue('FORMAT');
    if (!$format) {    
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: no fields specified") if $debug;
        return "<b>Error: no fields specified for LDAP search</b>";
    } else {
        # get attributes list from Format
        if ($format eq 'FIELDLIST') {
            @fields = ('FIELDLIST');
        } else {
            @fields = ($format =~ /\$(\w+)/g);
        }
    }

    # separator for multi-value attributes
    my $mvformat = $theParams->{mvformat}
        || TWiki::Func::getPluginPreferencesValue('MVFORMAT')
        || '<br/>';

    # fields to sort the search result on
    my $order = $theParams->{order}
        || TWiki::Func::getPluginPreferencesValue('ORDER');
    my @keyfields = ($order =~ /(\w+)/g);

    # header from setting or parameter
    my $header = $theParams->{header}
        || TWiki::Func::getPluginPreferencesValue('HEADER');

    # base from setting or parameter
    my $base = $theParams->{base}
        || TWiki::Func::getPluginPreferencesValue('BASE');

    # Special attribute : PHOTO --> need to store the content in a file
    my $jpegphoto = $theParams->{jpegPhoto}
        || TWiki::Func::getPluginPreferencesValue('JPEGPHOTO')
        || 'jpegPhoto';
    # jpegDefaultPhoto is the URL of a default photo if someone doesn't have one
    my $jpegdefaultphoto = $theParams->{jpegDefaultPhoto}
        || TWiki::Func::getPluginPreferencesValue('JPEGDEFAULTPHOTO')
        || '';
    my $jpegphotodir = catdir(TWiki::Func::getPubDir(), 'LdapPhotos');
    my $jpegphotourl = TWiki::Func::getPubUrlPath() . '/' . 'LdapPhotos' . '/';
    
    # Error message if LDAP request give no answer
    my $notfounderror = $theParams->{notfounderror}
        || TWiki::Func::getPluginPreferencesValue('NOTFOUNDERROR')
        || "LDAP search returned no records";

    if ($debug) {
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) HOST $host");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) BASE $base");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) FILTER $filter");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) HEADER $header");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) FORMAT $format");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) MVFORMAT $mvformat");
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) ORDER $order");
    }

    # Connect to the LDAP server.  Bail out with error if no connect.
    my $ldap = Net::LDAP->new($host);
    if (!$ldap) {
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: cannot connect to $host") if $debug;
        return "<b>Error: LDAP connect failed</b>";
    }

    my $mesg = undef;

    #$mesg = $ldap->start_tls(verify => 'none');
    #if ($mesg->code) {
    #    TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: STARTTLS failed") if $debug;
    #    return "<b>Error: LDAP STARTTLS failed</b>";
    #}

    $mesg = $ldap->bind(); # bind anonymously
    #$mesg = $ldap->bind('dn', password => 'secret');
    if ($mesg->code) {
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) error: cannot bind to $host") if $debug;
        return "<b>Error: LDAP bind failed</b>";
    }

    # do the actual LDAP lookup  (Should attrs be @fields?)
    $mesg = $ldap->search(base => $base,
                          scope => 'sub',
                          sizelimit => 0,
                          timelimit => 0,
                          filter => $filter,
                          attrs => \@fields);

    # If query succeeds, then print header here (if defined)
    my $max = $mesg->count();
    if ($max) { 
        $result = $header . " \n" if $header;
    } else {
        $ldap->unbind();
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) warning: no records found") if $debug;
        # return message saying no rows were found ....
        return $notfounderror;
    }

    # If $fields[0] = FIELDLIST then just return the list of fields for the entry found.
    if ($fields[0] eq 'FIELDLIST') {
        $result = "Fieldlist for $host : $base : $filter:\n";
        foreach my $x ($mesg->entry(0)->attributes) {
            $result .= "$x, ";
        }
        $ldap->unbind();
        TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) returns fieldlist") if $debug;
        return $result
    }

    # The fields must be sorted by length so that fields with longer
    # names are replaced first.  For example, $street must be replaced
    # before $st is replaced.
    my @fields_by_length = sort { length($b) <=> length($a) } @fields;

    my %rows = ();

    # Then print rows of query response
    for (my $i = 0; $i < $max; $i++) {
        my $row = $format;
        my %sortfield = ();
        my $entry = $mesg->entry($i);
        foreach my $x (@fields_by_length) {
            my $y;
            my @values = $entry->get_value($x);
            if (scalar @values) {
                $y = join($mvformat, @values);
                if ($x eq $jpegphoto) {
                    mkdir($jpegphotodir, 0775) unless -e $jpegphotodir;
                    my $file = ($entry->get_value('alias') || $theTopic) . '.jpg';
                    my $path = catfile($jpegphotodir, $file);
                    open(FILE, '>', $path);
                    binmode(FILE);
                    print FILE $y;
                    close(FILE);
                    $y = $jpegphotourl . $file;
                }
                $y = $UTF82SiteCharSet->($y);
            } else {
                $y = ' ';
                if ($x eq $jpegphoto) {
                    $y = $jpegdefaultphoto;
                }
            }
            $y =~ s/\n/ /g; # remove newlines from data (messes with format)
            $row =~ s/\$$x/$y/g; #replace $field with $y (the value)
            # Capture field value for sort
            if (scalar grep (/$x/, @keyfields)) {
                $sortfield{$x} = $y;
            }
        } 
        $rows{join("-", @sortfield{@keyfields})} .= $row . "\n";
    }

    $ldap->unbind();

    # build $result with %rows{sortfield}
    if ($TWiki::useLocale) {
        # Unfortunately, only LC_CTYPE is set in TWiki.pm.
        use POSIX qw(locale_h);
        my $old_locale = setlocale(LC_COLLATE);
        setlocale(LC_COLLATE, setlocale(LC_CTYPE));
        foreach my $key (sort keys %rows) {
            $result .= $rows{$key};
        }
        setlocale(LC_COLLATE, $old_locale);
    } else {
        foreach my $key (sort keys %rows) {
            $result .= $rows{$key};
        }
    }

    TWiki::Func::writeDebug("- ${pluginName}::_LDAP($theWeb.$theTopic) returns $max records") if $debug;

    return $result;
}

sub commonTagsHandler {
    # do not uncomment, use $_[0], $_[1]... instead
    ### my ( $text, $topic, $web ) = @_;

    TWiki::Func::writeDebug( "- ${pluginName}::commonTagsHandler( $_[2].$_[1] )" ) if $debug;

    if ($_[0] =~ /(?<!\<nop\>)%LDAP{(.*?)}%/) {
       my %params = TWiki::Func::extractParameters($1);
       $_[0] = _LDAP(undef, \%params, $_[1], $_[2]);
    }
}

1;