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   831 use strict;
  1         2  
  1         32  
8 1     1   7 use warnings;
  1         2  
  1         35  
9 1     1   5 use base qw(ClearPress::authenticator);
  1         2  
  1         386  
10 1     1   579 use Readonly;
  1         7026  
  1         66  
11 1     1   9 use Carp;
  1         3  
  1         66  
12 1     1   428 use Net::LDAP;
  1         482  
  1         646  
13              
14             our $VERSION = q[477.1.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 33 my ($self, $srv) = @_;
21 8 100       26 if($srv) {
22 1         13 $self->{server} = $srv;
23             }
24              
25 8 100       25 if($self->{server}) {
26 2         26 return $self->{server};
27             }
28              
29 6         228 return $DEFAULT_SERVER;
30             }
31              
32             sub ad_domain {
33 5     5 1 24 my ($self, $domain) = @_;
34 5 100       18 if($domain) {
35 1         4 $self->{ad_domain} = $domain;
36             }
37              
38 5 100       16 if($self->{ad_domain}) {
39 2         11 return $self->{ad_domain};
40             }
41              
42 3         10 return $DEFAULT_AD_DOMAIN;
43             }
44              
45             sub _ldap {
46 5     5   851 my $self = shift;
47              
48 5 100       114 if(!$self->{_ldap}) {
49 4         13 $self->{_ldap} = Net::LDAP->new($self->server);
50             }
51              
52 5         65 return $self->{_ldap};
53             }
54              
55             sub authen_credentials {
56 6     6 1 273 my ($self, $ref) = @_;
57              
58 6 100 100     48 if(!$ref ||
      100        
59             !$ref->{username} ||
60             !$ref->{password} ) {
61 3         20 return;
62             }
63              
64 3         10 my $ldap = $self->_ldap;
65 3 100       10 if(!$ldap) {
66 1         3 croak qq[Failed to connect to @{[$self->server()]}. Is it available?];
  1         4  
67             }
68 2         9 my $ad_domain = $self->ad_domain;
69 2         13 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         11 );
74 2 100       56 if($auth_msg->code) {
75 1         6 carp $auth_msg->error;
76 1         289 return;
77             }
78              
79 1         15 return $ref;
80             }
81              
82             1;
83             __END__