File Coverage

blib/lib/ClearPress/authenticator/ldap.pm
Criterion Covered Total %
statement 48 48 100.0
branch 16 16 100.0
condition 6 6 100.0
subroutine 10 10 100.0
pod 3 3 100.0
total 83 83 100.0


line stmt bran cond sub pod time code
1             # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2             # vim:ts=8:sw=2:et:sta:sts=2
3             #########
4             # Author: rmp
5             #
6             package ClearPress::authenticator::ldap;
7 1     1   815 use strict;
  1         4  
  1         35  
8 1     1   8 use warnings;
  1         3  
  1         39  
9 1     1   7 use base qw(ClearPress::authenticator);
  1         3  
  1         425  
10 1     1   498 use Readonly;
  1         4864  
  1         55  
11 1     1   6 use Carp;
  1         2  
  1         40  
12 1     1   199 use Net::LDAP;
  1         277  
  1         302  
13              
14             our $VERSION = q[476.4.2];
15              
16             Readonly::Scalar our $DEFAULT_SERVER => 'ldaps://ldap.local:636';
17             Readonly::Scalar our $DEFAULT_AD_DOMAIN => 'WORKGROUP';
18              
19             sub server {
20 8     8 1 21 my ($self, $srv) = @_;
21 8 100       16 if($srv) {
22 1         2 $self->{server} = $srv;
23             }
24              
25 8 100       17 if($self->{server}) {
26 2         8 return $self->{server};
27             }
28              
29 6         169 return $DEFAULT_SERVER;
30             }
31              
32             sub ad_domain {
33 5     5 1 13 my ($self, $domain) = @_;
34 5 100       12 if($domain) {
35 1         3 $self->{ad_domain} = $domain;
36             }
37              
38 5 100       9 if($self->{ad_domain}) {
39 2         7 return $self->{ad_domain};
40             }
41              
42 3         7 return $DEFAULT_AD_DOMAIN;
43             }
44              
45             sub _ldap {
46 5     5   497 my $self = shift;
47              
48 5 100       10 if(!$self->{_ldap}) {
49 4         8 $self->{_ldap} = Net::LDAP->new($self->server);
50             }
51              
52 5         34 return $self->{_ldap};
53             }
54              
55             sub authen_credentials {
56 6     6 1 182 my ($self, $ref) = @_;
57              
58 6 100 100     31 if(!$ref ||
      100        
59             !$ref->{username} ||
60             !$ref->{password} ) {
61 3         9 return;
62             }
63              
64 3         6 my $ldap = $self->_ldap;
65 3 100       8 if(!$ldap) {
66 1         2 croak qq[Failed to connect to @{[$self->server()]}. Is it available?];
  1         2  
67             }
68 2         5 my $ad_domain = $self->ad_domain;
69 2         7 my $fq_username = sprintf q[%s\%s], $ad_domain, $ref->{username};
70             my $auth_msg = $ldap->bind(
71             $fq_username,
72             'password' => $ref->{password},
73 2         6 );
74 2 100       33 if($auth_msg->code) {
75 1         5 carp $auth_msg->error;
76 1         129 return;
77             }
78              
79 1         8 return $ref;
80             }
81              
82             1;
83             __END__