File Coverage

blib/lib/Authen/Simple/ActiveDirectory.pm
Criterion Covered Total %
statement 18 33 54.5
branch 0 12 0.0
condition n/a
subroutine 6 7 85.7
pod 1 1 100.0
total 25 53 47.1


line stmt bran cond sub pod time code
1             package Authen::Simple::ActiveDirectory;
2              
3 1     1   2125 use strict;
  1         2  
  1         36  
4 1     1   7 use warnings;
  1         2  
  1         32  
5 1     1   6 use base 'Authen::Simple::Adapter';
  1         2  
  1         105  
6              
7 1     1   5 use Net::LDAP qw[];
  1         2  
  1         17  
8 1     1   4 use Net::LDAP::Constant qw[LDAP_INVALID_CREDENTIALS];
  1         2  
  1         152  
9 1     1   7 use Params::Validate qw[];
  1         2  
  1         369  
10              
11             our $VERSION = 0.3;
12              
13             __PACKAGE__->options({
14             host => {
15             type => Params::Validate::SCALAR | Params::Validate::ARRAYREF,
16             default => 'localhost',
17             optional => 1
18             },
19             port => {
20             type => Params::Validate::SCALAR,
21             default => 389,
22             optional => 1
23             },
24             timeout => {
25             type => Params::Validate::SCALAR,
26             default => 60,
27             optional => 1
28             },
29             principal => {
30             type => Params::Validate::SCALAR,
31             optional => 0
32             }
33             });
34              
35             sub check {
36 0     0 1   my ( $self, $username, $password ) = @_;
37              
38 0           my $connection = Net::LDAP->new( $self->host,
39             port => $self->port,
40             timeout => $self->timeout
41             );
42              
43 0 0         unless ( defined $connection ) {
44              
45 0           my $host = $self->host;
46              
47 0 0         $self->log->error( qq/Failed to connect to '$host'. Reason: '$@'/ )
48             if $self->log;
49              
50 0           return 0;
51             }
52              
53 0           my $user = sprintf( '%s@%s', $username, $self->principal );
54 0           my $message = $connection->bind( $user, password => $password );
55              
56 0 0         if ( $message->is_error ) {
57              
58 0           my $error = $message->error;
59 0 0         my $level = $message->code == LDAP_INVALID_CREDENTIALS ? 'debug' : 'error';
60              
61 0 0         $self->log->$level( qq/Failed to authenticate user '$user'. Reason: '$error'/ )
62             if $self->log;
63              
64 0           return 0;
65             }
66              
67 0 0         $self->log->debug( qq/Successfully authenticated user '$user'./ )
68             if $self->log;
69              
70 0           return 1;
71             }
72              
73             1;
74              
75             __END__