diff options
author | Edward Rudd | 2010-02-15 12:25:06 -0500 |
---|---|---|
committer | Edward Rudd | 2010-02-15 12:26:17 -0500 |
commit | 20fd1b9f6f15f7864620ff91ff1eb257ad5ccb5a (patch) | |
tree | 8fac6793e5dec7630e056dc69b23da1f17ae84c0 |
import version 0.010.01
-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(); | ||