9 files changed, 284 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..10b5458
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+META.yml
+Makefile
+/blib
+/pm_to_blib
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..c7abf7a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for DJabberd-VCard-LDAP
+
+0.01    2007-08-23
+        First version, released on an unsuspecting world.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..a00de9e
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,8 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/DJabberd/Plugin/VCard/LDAP.pm
+t/00-load.t
+t/boilerplate.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..38343ae
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'DJabberd::Plugin::VCard::LDAP',
+    AUTHOR              => 'Edward Rudd <urkle@outoforder.cc>',
+    VERSION_FROM        => 'lib/DJabberd/Plugin/VCard/LDAP.pm',
+    ABSTRACT_FROM       => 'lib/DJabberd/Plugin/VCard/LDAP.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+        'DJabberd' => '0.83',
+        'DJabberd::Plugin::VCard' => 0,
+        'Net::LDAP' => 0,
+    },
+    DISTNAME            => 'DJabberd-VCard-LDAP',
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..0c7aa40
--- /dev/null
+++ b/README
@@ -0,0 +1,26 @@
+DJabberd-VCard-LDAP
+
+Provides an LDAP VCard backend.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+    perldoc DJabberd::Plugin::VCard::LDAP
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Edward Rudd
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
diff --git a/lib/DJabberd/Plugin/VCard/LDAP.pm b/lib/DJabberd/Plugin/VCard/LDAP.pm
new file mode 100644
index 0000000..4606ea4
--- /dev/null
+++ b/lib/DJabberd/Plugin/VCard/LDAP.pm
@@ -0,0 +1,159 @@
+package DJabberd::Plugin::VCard::LDAP;
+
+use warnings;
+use strict;
+
+use base 'DJabberd::Plugin::VCard';
+
+use Net::LDAP;
+
+our $logger = DJabberd::Log->get_logger();
+
+=head1 NAME
+
+DJabberd::VCard::LDAP - LDAP VCard Provider for DJabberd
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+Provides an LDAP VCard backend for DJabberd
+
+    <Vhost mydomain.com>
+        <Plugin DJabberd::Plugin::VCard::LDAP>
+            LDAPURI             ldap://localhost/
+            LDAPBindDN          cn=reader
+            LDAPBindPW          pass
+            LDAPBaseDN          ou=people
+            LDAPFilter          (uid=%u)
+        </Plugin>
+    </VHost>
+
+LDAPURI , LDAPBaseDN, and LDAPFilter are required
+Everything else is optional.
+
+LDAPFilter is an LDAP filter with a %u that will be substituted with the incoming userid (w/o the domain)
+
+=cut
+
+sub set_config_ldapuri {
+    my ($self, $ldapuri) = @_;
+    if ( $ldapuri =~ /((?:ldap[si]?\:\/\/)?[\w\.%\d]+\/?)/ ) {
+        $self->{'ldap_uri'} = $ldapuri;
+    }
+}
+
+sub set_config_ldapbinddn {
+    my ($self, $ldapbinddn) = @_;
+    $self->{'ldap_binddn'} = $ldapbinddn;
+}
+
+sub set_config_ldapbindpw {
+    my ($self, $ldapbindpw) = @_;
+    $self->{'ldap_bindpw'} = $ldapbindpw;
+}
+
+sub set_config_ldapbasedn {
+    my ($self, $ldapbasedn) = @_;
+    $self->{'ldap_basedn'} = $ldapbasedn;
+}
+
+sub set_config_ldapfilter {
+    my ($self, $ldapfilter) = @_;
+    $self->{'ldap_filter'} = $ldapfilter;
+}
+
+sub finalize {
+    my $self = shift;
+    $logger->error_die("Invalid LDAP URI") unless $self->{ldap_uri};
+    $logger->error_die("No LDAP BaseDN Specified") unless $self->{ldap_basedn};
+    $logger->error_die("Must specify filter with userid as %u") unless $self->{ldap_filter};
+
+    # Initialize ldap connection
+    $self->{'ldap_conn'} = Net::LDAP->new($self->{ldap_uri})
+        or $logger->error_die("Could not connect to LDAP Server ".$self->{ldap_uri});
+
+    if (defined $self->{'ldap_binddn'}) {
+        if (not $self->{'ldap_conn'}->bind($self->{'ldap_binddn'},
+                password=>$self->{'ldap_bindpw'})) {
+            $logger->error_die("Could not bind to ldap server");
+        }
+    }
+
+    $self->SUPER::finalize;
+}
+
+sub _isdef {
+    my $arg = shift;
+    return $arg if defined $arg;
+    return '';
+}
+
+sub load_vcard {
+    my ($self, $user) = @_;
+
+    my $suser = $user;
+    $suser =~ s/^(.*)\@.*$/$1/;
+
+    my $filter = $self->{'ldap_filter'};
+    $filter =~ s/%u/$suser/;
+    $logger->info("Searching $filter on ".$self->{'ldap_basedn'});
+    my $srch = $self->{'ldap_conn'}->search(
+        base=>$self->{'ldap_basedn'},
+        filter=>$filter,
+        attrs=>['dn','sn','cn','givenName','mail','telephoneNumber','title','description','displayName']);
+    if ($srch->code || $srch->count < 1) {
+        $logger->info("Account $user not found.");
+        return;
+    } else {
+        my $entry = $srch->entry(0);
+        my $vCard = '<vCard xmlns="vcard-temp" version="3.0">'
+                .'<FN>'._isdef($entry->get_value('cn')).'</FN>'
+                .'<N>'
+                    .'<FAMILY>'._isdef($entry->get_value('sn')).'</FAMILY>'
+                    .'<GIVEN>'._isdef($entry->get_value('givenName')).'</GIVEN>'
+                .'</N>'
+                .'<TITLE>'._isdef($entry->get_value('title')).'</TITLE>'
+                .'<NICKNAME>'._isdef($entry->get_value('displayName')).'</NICKNAME>'
+                .'<TEL><HOME/><VOICE/><NUMBER>'._isdef($entry->get_value('telephoneNumber')).'</NUMBER></TEL>'
+                .'<EMAIL><INTERNET/><PREF/><USERID>'._isdef($entry->get_value('mail')).'</USERID></EMAIL>'
+                .'<JABBERID>'.$user.'</JABBERID>'
+                .'<DESC>'._isdef($entry->get_value('description')).'</DESC>'
+            .'</vCard>';
+        undef($entry);
+        undef($srch);
+        return $vCard;
+    }
+}
+
+
+sub store_vcard { 0 }
+
+=head1 AUTHOR
+
+Edward Rudd, C<< <urkle at outoforder.cc> >>
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc DJabberd::Plugin::VCard::LDAP
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Edward Rudd, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of DJabberd::Plugin::VCard::LDAP
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..e9cbf2c
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+        use_ok( 'DJabberd::Plugin::VCard::LDAP' );
+}
+
+diag( "Testing DJabberd::Plugin::VCard::LDAP $DJabberd::Plugin::VCard::LDAP::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..4db7dda
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,48 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open my $fh, "<", $filename
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+module_boilerplate_ok('lib/DJabberd/Plugin/VCard/LDAP.pm');
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..976d7cd
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();