diff options
| -rw-r--r-- | .gitignore | 4 | ||||
| -rw-r--r-- | Changes | 5 | ||||
| -rw-r--r-- | MANIFEST | 9 | ||||
| -rw-r--r-- | Makefile.PL | 18 | ||||
| -rw-r--r-- | README | 41 | ||||
| -rw-r--r-- | lib/DJabberd/Authen/LDAP.pm | 171 | ||||
| -rw-r--r-- | t/00-load.t | 9 | ||||
| -rw-r--r-- | t/boilerplate.t | 48 | ||||
| -rw-r--r-- | t/pod-coverage.t | 6 | ||||
| -rw-r--r-- | t/pod.t | 6 |
10 files changed, 317 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..10b5458 --- /dev/null +++ b/.gitignore | |||
| @@ -0,0 +1,4 @@ | |||
| 1 | META.yml | ||
| 2 | Makefile | ||
| 3 | /blib | ||
| 4 | /pm_to_blib | ||
| @@ -0,0 +1,5 @@ | |||
| 1 | Revision history for DJabberd-Authen-LDAP | ||
| 2 | |||
| 3 | 0.01 2007-07-26 | ||
| 4 | Initial Revision. Only supports rebinding | ||
| 5 | |||
diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..58085bd --- /dev/null +++ b/MANIFEST | |||
| @@ -0,0 +1,9 @@ | |||
| 1 | Changes | ||
| 2 | MANIFEST | ||
| 3 | Makefile.PL | ||
| 4 | README | ||
| 5 | lib/DJabberd/Authen/LDAP.pm | ||
| 6 | t/00-load.t | ||
| 7 | t/boilerplate.t | ||
| 8 | t/pod-coverage.t | ||
| 9 | t/pod.t | ||
diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..2f0ffed --- /dev/null +++ b/Makefile.PL | |||
| @@ -0,0 +1,18 @@ | |||
| 1 | use strict; | ||
| 2 | use warnings; | ||
| 3 | use ExtUtils::MakeMaker; | ||
| 4 | |||
| 5 | WriteMakefile( | ||
| 6 | NAME => 'DJabberd::Authen::LDAP', | ||
| 7 | AUTHOR => 'Edward Rudd <urkle@outoforder.cc>', | ||
| 8 | VERSION_FROM => 'lib/DJabberd/Authen/LDAP.pm', | ||
| 9 | ABSTRACT_FROM => 'lib/DJabberd/Authen/LDAP.pm', | ||
| 10 | PL_FILES => {}, | ||
| 11 | PREREQ_PM => { | ||
| 12 | 'Test::More' => 0, | ||
| 13 | 'DJabberd' => 0.83, | ||
| 14 | 'Net::LDAP' => 0.34 | ||
| 15 | }, | ||
| 16 | dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, | ||
| 17 | clean => { FILES => 'DJabberd-Authen-LDAP-*' }, | ||
| 18 | ); | ||
| @@ -0,0 +1,41 @@ | |||
| 1 | DJabberd-Authen-LDAP | ||
| 2 | |||
| 3 | This is an LDAP Authentication for the DJabberd XMPP Server. This module | ||
| 4 | depends on DJabberd of course (version 0.83 or newer) and Net::LDAP. | ||
| 5 | |||
| 6 | INSTALLATION | ||
| 7 | |||
| 8 | To install this module, run the following commands: | ||
| 9 | |||
| 10 | perl Makefile.PL | ||
| 11 | make | ||
| 12 | make test | ||
| 13 | make install | ||
| 14 | |||
| 15 | |||
| 16 | SUPPORT AND DOCUMENTATION | ||
| 17 | |||
| 18 | After installing, you can find documentation for this module with the perldoc command. | ||
| 19 | |||
| 20 | perldoc DJabberd::Authen::LDAP | ||
| 21 | |||
| 22 | You can also look for information at: | ||
| 23 | |||
| 24 | Search CPAN | ||
| 25 | http://search.cpan.org/dist/DJabberd-Authen-LDAP | ||
| 26 | |||
| 27 | CPAN Request Tracker: | ||
| 28 | http://rt.cpan.org/NoAuth/Bugs.html?Dist=DJabberd-Authen-LDAP | ||
| 29 | |||
| 30 | AnnoCPAN, annotated CPAN documentation: | ||
| 31 | http://annocpan.org/dist/DJabberd-Authen-LDAP | ||
| 32 | |||
| 33 | CPAN Ratings: | ||
| 34 | http://cpanratings.perl.org/d/DJabberd-Authen-LDAP | ||
| 35 | |||
| 36 | COPYRIGHT AND LICENCE | ||
| 37 | |||
| 38 | Copyright (C) 2007 Edward Rudd | ||
| 39 | |||
| 40 | This program is free software; you can redistribute it and/or modify it | ||
| 41 | under the same terms as Perl itself. | ||
diff --git a/lib/DJabberd/Authen/LDAP.pm b/lib/DJabberd/Authen/LDAP.pm new file mode 100644 index 0000000..9808fa8 --- /dev/null +++ b/lib/DJabberd/Authen/LDAP.pm | |||
| @@ -0,0 +1,171 @@ | |||
| 1 | package DJabberd::Authen::LDAP; | ||
| 2 | |||
| 3 | use warnings; | ||
| 4 | use strict; | ||
| 5 | use base 'DJabberd::Authen'; | ||
| 6 | |||
| 7 | use DJabberd::Log; | ||
| 8 | our $logger = DJabberd::Log->get_logger; | ||
| 9 | use Net::LDAP; | ||
| 10 | |||
| 11 | sub log { | ||
| 12 | $logger; | ||
| 13 | } | ||
| 14 | |||
| 15 | =head1 NAME | ||
| 16 | |||
| 17 | DJabberd::Authen::LDAP - An LDAP authentication module for DJabberd | ||
| 18 | |||
| 19 | =head1 VERSION | ||
| 20 | |||
| 21 | Version 0.01 | ||
| 22 | =cut | ||
| 23 | |||
| 24 | our $VERSION = '0.01'; | ||
| 25 | |||
| 26 | =head1 SYNOPSIS | ||
| 27 | |||
| 28 | <VHost mydomain.com> | ||
| 29 | |||
| 30 | [...] | ||
| 31 | |||
| 32 | <Plugin DJabberd::Authen::LDAP> | ||
| 33 | LDAPURI ldap://localhost/ | ||
| 34 | LDAPBindDN cn=reader | ||
| 35 | LDAPBindPW pass | ||
| 36 | LDAPBaseDN ou=people | ||
| 37 | LDAPFilter (&(inetAuthorizedServices=jabber)(uid=%u)) | ||
| 38 | LDAPMethod rebind | ||
| 39 | </Plugin> | ||
| 40 | </VHost> | ||
| 41 | |||
| 42 | LDAPURI , LDAPBaseDN, and LDAPFilter are required | ||
| 43 | Everything else is optional. | ||
| 44 | |||
| 45 | The Only LDAPMethod supported at the moment is rebind which performs a bind as LDAPBindDN | ||
| 46 | or does anonymous bind, then searches for the user using LDAPFilter and then will rebind | ||
| 47 | as the found DN to verify the password. | ||
| 48 | |||
| 49 | LDAPFilter is an LDAP filter with a %u that will be substituted with the incoming userid | ||
| 50 | |||
| 51 | =head1 AUTHOR | ||
| 52 | |||
| 53 | Edward Rudd, C<< <urkle at outoforder.cc> >> | ||
| 54 | |||
| 55 | =cut | ||
| 56 | |||
| 57 | sub set_config_ldapuri { | ||
| 58 | my ($self, $ldapuri) = @_; | ||
| 59 | if ( $ldapuri =~ /((?:ldap[si]?\:\/\/)?[\w\.%\d]+\/?)/ ) { | ||
| 60 | $self->{'ldap_uri'} = $ldapuri; | ||
| 61 | } | ||
| 62 | } | ||
| 63 | |||
| 64 | sub set_config_ldapbinddn { | ||
| 65 | my ($self, $ldapbinddn) = @_; | ||
| 66 | $self->{'ldap_binddn'} = $ldapbinddn; | ||
| 67 | } | ||
| 68 | |||
| 69 | sub set_config_ldapbindpw { | ||
| 70 | my ($self, $ldapbindpw) = @_; | ||
| 71 | $self->{'ldap_bindpw'} = $ldapbindpw; | ||
| 72 | } | ||
| 73 | |||
| 74 | sub set_config_ldapbasedn { | ||
| 75 | my ($self, $ldapbasedn) = @_; | ||
| 76 | $self->{'ldap_basedn'} = $ldapbasedn; | ||
| 77 | } | ||
| 78 | |||
| 79 | sub set_config_ldapfilter { | ||
| 80 | my ($self, $ldapfilter) = @_; | ||
| 81 | $self->{'ldap_filter'} = $ldapfilter; | ||
| 82 | } | ||
| 83 | |||
| 84 | sub set_config_ldapmethod { | ||
| 85 | my ($self, $ldapmethod) = @_; | ||
| 86 | if ( $ldapmethod =~ /^(?:rebind)$/ ) { | ||
| 87 | $self->{'ldap_method'} = $ldapmethod; | ||
| 88 | } else { | ||
| 89 | $self->{'ldap_method'} = 'unknown'; | ||
| 90 | } | ||
| 91 | } | ||
| 92 | |||
| 93 | sub finalize { | ||
| 94 | my $self = shift; | ||
| 95 | $logger->error_die("Invalid LDAP URI") unless $self->{ldap_uri}; | ||
| 96 | $logger->error_die("No LDAP BaseDN Specified") unless $self->{ldap_basedn}; | ||
| 97 | if (not defined $self->{'ldap_method'}) { $self->{'ldap_type'} = 'rebind'; } | ||
| 98 | for ($self->{ldap_type}) { | ||
| 99 | if (/^rebind$/) { | ||
| 100 | # check additional required params | ||
| 101 | $logger->error_die("Must specify filter with userid as %u") unless $self->{ldap_filter}; | ||
| 102 | } else { | ||
| 103 | $logger->error_die("Invalid LDAP Authentication Method"); | ||
| 104 | } | ||
| 105 | } | ||
| 106 | # Initialize ldap connection | ||
| 107 | $self->{'ldap_conn'} = Net::LDAP->new($self->{ldap_uri}) | ||
| 108 | or $logger->error_die("Could not connect to LDAP Server ".$self->{ldap_uri}); | ||
| 109 | } | ||
| 110 | |||
| 111 | sub can_retrieve_cleartext { 0 } | ||
| 112 | |||
| 113 | sub check_cleartext { | ||
| 114 | my ($self, $cb, %args) = @_; | ||
| 115 | my $username = $args{username}; | ||
| 116 | my $password = $args{password}; | ||
| 117 | my $conn = $args{conn}; | ||
| 118 | unless ($username =~ /^\w+$/) { | ||
| 119 | $cb->reject; | ||
| 120 | return; | ||
| 121 | } | ||
| 122 | |||
| 123 | my $ldap = $self->{'ldap_conn'}; | ||
| 124 | |||
| 125 | if (defined $self->{'ldap_binddn'}) { | ||
| 126 | if (not $ldap->bind($self->{'ldap_binddn'}, | ||
| 127 | password=>$self->{'ldap_bindpw'})) { | ||
| 128 | $logger->info("Could not bind to ldap server"); | ||
| 129 | $cb->decline; | ||
| 130 | } | ||
| 131 | } else { | ||
| 132 | $ldap->unbind; | ||
| 133 | } | ||
| 134 | |||
| 135 | my $filter = $self->{'ldap_filter'}; | ||
| 136 | $filter =~ s/%u/$username/; | ||
| 137 | $logger->info("Searching $filter on ".$self->{'ldap_basedn'}); | ||
| 138 | my $srch = $ldap->search( | ||
| 139 | base=>$self->{'ldap_basedn'}, | ||
| 140 | filter=>$filter, | ||
| 141 | attrs=>['dn']); | ||
| 142 | if ($srch->code || $srch->count != 1) { | ||
| 143 | $logger->info("Account $username not found."); | ||
| 144 | $cb->decline; | ||
| 145 | } else { | ||
| 146 | my $entry = $srch->entry(0); | ||
| 147 | my $DN = $entry->dn(); | ||
| 148 | undef($entry); | ||
| 149 | undef($srch); | ||
| 150 | |||
| 151 | my $res = $ldap->bind($DN,password=>$password); | ||
| 152 | |||
| 153 | if ($res->code == 0) { | ||
| 154 | $cb->accept; | ||
| 155 | } else { | ||
| 156 | $cb->reject; | ||
| 157 | } | ||
| 158 | } | ||
| 159 | } | ||
| 160 | |||
| 161 | =head1 COPYRIGHT & LICENSE | ||
| 162 | |||
| 163 | Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved. | ||
| 164 | Copyright 2007 Edward Rudd. All rights reserved. | ||
| 165 | |||
| 166 | This program is free software; you can redistribute it and/or modify it | ||
| 167 | under the same terms as Perl itself. | ||
| 168 | |||
| 169 | =cut | ||
| 170 | |||
| 171 | 1; | ||
diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..5ae63ed --- /dev/null +++ b/t/00-load.t | |||
| @@ -0,0 +1,9 @@ | |||
| 1 | #!perl -T | ||
| 2 | |||
| 3 | use Test::More tests => 1; | ||
| 4 | |||
| 5 | BEGIN { | ||
| 6 | use_ok( 'DJabberd::Authen::LDAP' ); | ||
| 7 | } | ||
| 8 | |||
| 9 | diag( "Testing DJabberd::Authen::LDAP $DJabberd::Authen::LDAP::VERSION, Perl $], $^X" ); | ||
diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 0000000..090be99 --- /dev/null +++ b/t/boilerplate.t | |||
| @@ -0,0 +1,48 @@ | |||
| 1 | #!perl -T | ||
| 2 | |||
| 3 | use strict; | ||
| 4 | use warnings; | ||
| 5 | use Test::More tests => 3; | ||
| 6 | |||
| 7 | sub not_in_file_ok { | ||
| 8 | my ($filename, %regex) = @_; | ||
| 9 | open my $fh, "<", $filename | ||
| 10 | or die "couldn't open $filename for reading: $!"; | ||
| 11 | |||
| 12 | my %violated; | ||
| 13 | |||
| 14 | while (my $line = <$fh>) { | ||
| 15 | while (my ($desc, $regex) = each %regex) { | ||
| 16 | if ($line =~ $regex) { | ||
| 17 | push @{$violated{$desc}||=[]}, $.; | ||
| 18 | } | ||
| 19 | } | ||
| 20 | } | ||
| 21 | |||
| 22 | if (%violated) { | ||
| 23 | fail("$filename contains boilerplate text"); | ||
| 24 | diag "$_ appears on lines @{$violated{$_}}" for keys %violated; | ||
| 25 | } else { | ||
| 26 | pass("$filename contains no boilerplate text"); | ||
| 27 | } | ||
| 28 | } | ||
| 29 | |||
| 30 | not_in_file_ok(README => | ||
| 31 | "The README is used..." => qr/The README is used/, | ||
| 32 | "'version information here'" => qr/to provide version information/, | ||
| 33 | ); | ||
| 34 | |||
| 35 | not_in_file_ok(Changes => | ||
| 36 | "placeholder date/time" => qr(Date/time) | ||
| 37 | ); | ||
| 38 | |||
| 39 | sub module_boilerplate_ok { | ||
| 40 | my ($module) = @_; | ||
| 41 | not_in_file_ok($module => | ||
| 42 | 'the great new $MODULENAME' => qr/ - The great new /, | ||
| 43 | 'boilerplate description' => qr/Quick summary of what the module/, | ||
| 44 | 'stub function definition' => qr/function[12]/, | ||
| 45 | ); | ||
| 46 | } | ||
| 47 | |||
| 48 | module_boilerplate_ok('lib/DJabberd/Authen/LDAP.pm'); | ||
diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..703f91d --- /dev/null +++ b/t/pod-coverage.t | |||
| @@ -0,0 +1,6 @@ | |||
| 1 | #!perl -T | ||
| 2 | |||
| 3 | use Test::More; | ||
| 4 | eval "use Test::Pod::Coverage 1.04"; | ||
| 5 | plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; | ||
| 6 | all_pod_coverage_ok(); | ||
| @@ -0,0 +1,6 @@ | |||
| 1 | #!perl -T | ||
| 2 | |||
| 3 | use Test::More; | ||
| 4 | eval "use Test::Pod 1.14"; | ||
| 5 | plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; | ||
| 6 | all_pod_files_ok(); | ||
