File Coverage

blib/lib/Connector/Builtin/Authentication/Password.pm
Criterion Covered Total %
statement 62 74 83.7
branch 18 24 75.0
condition 2 6 33.3
subroutine 9 10 90.0
pod 3 3 100.0
total 94 117 80.3


line stmt bran cond sub pod time code
1             # Connector::Builtin::Authentication::Password
2             #
3             # Check passwords against a unix style password file
4             #
5             package Connector::Builtin::Authentication::Password;
6              
7 1     1   132910 use strict;
  1         11  
  1         32  
8 1     1   5 use warnings;
  1         1  
  1         19  
9 1     1   4 use English;
  1         2  
  1         6  
10 1     1   1095 use Data::Dumper;
  1         6192  
  1         64  
11              
12 1     1   487 use Moose;
  1         400084  
  1         6  
13             extends 'Connector::Builtin';
14              
15             sub _build_config {
16 0     0   0 my $self = shift;
17              
18 0 0       0 if (! -r $self->{LOCATION}) {
19 0         0 confess("Cannot open input file " . $self->{LOCATION} . " for reading.");
20             }
21              
22 0         0 return 1;
23             }
24              
25             sub get {
26 7     7 1 21 my $self = shift;
27 7         12 my $arg = shift;
28 7         9 my $params = shift;
29              
30 7         25 my @path = $self->_build_path( $arg );
31 7         12 my $user = shift @path;
32              
33 7         14 my $password = $params->{password};
34              
35              
36 7 50       14 if (!$user) {
37 0         0 $self->log()->error('No username');
38 0         0 die "no username given";
39             }
40              
41 7 100       12 if (!$password) {
42 1         23 $self->log()->error('No password');
43 1         18 die "no password given";
44             }
45              
46              
47 6         128 $self->log()->debug('verify password for ' . $user );
48              
49 6 100       55 if ($user =~ /[^a-zA-Z0-9_\-\.\@]/) {
50 1         19 $self->log()->error('Invalid chars in username ('.$user.')');
51 1         18 return $self->_node_not_exists( $user );
52             }
53              
54 5         8 my $filename = $self->{LOCATION};
55              
56 5 50 33     344 if (! -r $filename || ! open FILE, "$filename") {
57 0         0 $self->log()->error('Can\'t open/read from file ' . $filename);
58 0         0 die 'Can\'t open/read from file ' . $filename;
59             }
60              
61 5         674 while (<FILE>) {
62 8 100       118 if (/^$user:/) {
63 3         20 chomp;
64 3         11 my @t = split(/:/, $_, 3);
65 3         91 $self->log()->trace('found line ' . Dumper @t);
66             #if ($password eq $t[1]) {
67 3 50       186 if (not defined $t[1]) {
68 0         0 $self->log()->info('Password value not defined for ' . $user);
69 0         0 return 0;
70             }
71              
72 3 100       572 if (crypt($password, $t[1]) eq $t[1]) {
73 2         58 $self->log()->info('Password accepted for ' . $user);
74 2         28 return 1;
75             } else {
76 1         30 $self->log()->info('Password mismatch for ' . $user);
77 1         12 return 0;
78             }
79             }
80             }
81 2         19 return $self->_node_not_exists( $user );
82             }
83              
84             sub get_meta {
85 2     2 1 405 my $self = shift;
86              
87             # If we have no path, we tell the caller that we are a connector
88 2         8 my @path = $self->_build_path( shift );
89 2 100       7 if (scalar @path == 0) {
90 1         7 return { TYPE => "connector" };
91             }
92 1         7 return {TYPE => "scalar" };
93             }
94              
95             sub exists {
96              
97 4     4 1 8 my $self = shift;
98              
99             # No path = connector root which always exists
100 4         12 my @path = $self->_build_path( shift );
101 4 100       10 if (scalar @path == 0) {
102 1         4 return 1;
103             }
104              
105 3         5 my $user = shift @path;
106              
107 3         7 my $filename = $self->{LOCATION};
108 3 50 33     190 if (! -r $filename || ! open FILE, "$filename") {
109 0         0 $self->log()->error('Can\'t open/read from file ' . $filename);
110 0         0 return 0;
111             }
112              
113 3         111 while (<FILE>) {
114 4 100       55 if (/^$user:/) {
115 2         13 return 1;
116             }
117             }
118 1         7 return 0;
119             }
120              
121 1     1   7599 no Moose;
  1         2  
  1         7  
122             __PACKAGE__->meta->make_immutable;
123              
124             1;
125             __END__
126              
127             =head1 Name
128              
129             Connector::Builtin::Authentication::Password
130              
131             =head1 Description
132              
133             Lightweight connector to check passwords against a unix style password file.
134             Path to the password file is taken from LOCATION.
135              
136             =head2 Usage
137              
138             The username is the first component of the path, the password needs to be
139             passed in the extended parameters using the key password.
140              
141             Example:
142              
143             $connector->get('username', { password => 'mySecret' } );
144              
145             =head2 Return values
146              
147             1 if the password matches, 0 if the user is found but the password does not
148             match and undef if the user is not found.
149              
150             The connector will die if the password file is not readable or if one of
151             the parameters is missing.
152              
153             =head2 Limitations
154              
155             Usernames are limited to [a-zA-Z0-9_\-\.], invalid names are treated as not
156             found.
157