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   157843 use strict;
  1         13  
  1         31  
8 1     1   7 use warnings;
  1         2  
  1         28  
9 1     1   5 use English;
  1         2  
  1         9  
10 1     1   1100 use Data::Dumper;
  1         7077  
  1         61  
11              
12 1     1   529 use Moose;
  1         475097  
  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         15 my $arg = shift;
28 7         9 my $params = shift;
29              
30 7         27 my @path = $self->_build_path( $arg );
31 7         15 my $user = shift @path;
32              
33 7         15 my $password = $params->{password};
34              
35              
36 7 50       20 if (!$user) {
37 0         0 $self->log()->error('No username');
38 0         0 die "no username given";
39             }
40              
41 7 100       16 if (!$password) {
42 1         33 $self->log()->error('No password');
43 1         21 die "no password given";
44             }
45              
46              
47 6         154 $self->log()->debug('verify password for ' . $user );
48              
49 6 100       58 if ($user =~ /[^a-zA-Z0-9_\-\.\@]/) {
50 1         32 $self->log()->error('Invalid chars in username ('.$user.')');
51 1         10 return $self->_node_not_exists( $user );
52             }
53              
54 5         12 my $filename = $self->{LOCATION};
55              
56 5 50 33     310 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         108 while (<FILE>) {
62 8 100       134 if (/^$user:/) {
63 3         13 chomp;
64 3         13 my @t = split(/:/, $_, 3);
65 3         90 $self->log()->trace('found line ' . Dumper @t);
66             #if ($password eq $t[1]) {
67 3 50       173 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       648 if (crypt($password, $t[1]) eq $t[1]) {
73 2         68 $self->log()->info('Password accepted for ' . $user);
74 2         26 return 1;
75             } else {
76 1         29 $self->log()->info('Password mismatch for ' . $user);
77 1         12 return 0;
78             }
79             }
80             }
81 2         16 return $self->_node_not_exists( $user );
82             }
83              
84             sub get_meta {
85 2     2 1 431 my $self = shift;
86              
87             # If we have no path, we tell the caller that we are a connector
88 2         7 my @path = $self->_build_path( shift );
89 2 100       7 if (scalar @path == 0) {
90 1         14 return { TYPE => "connector" };
91             }
92 1         13 return {TYPE => "scalar" };
93             }
94              
95             sub exists {
96              
97 4     4 1 11 my $self = shift;
98              
99             # No path = connector root which always exists
100 4         15 my @path = $self->_build_path( shift );
101 4 100       11 if (scalar @path == 0) {
102 1         5 return 1;
103             }
104              
105 3         12 my $user = shift @path;
106              
107 3         10 my $filename = $self->{LOCATION};
108 3 50 33     182 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         56 while (<FILE>) {
114 4 100       55 if (/^$user:/) {
115 2         20 return 1;
116             }
117             }
118 1         9 return 0;
119             }
120              
121 1     1   8799 no Moose;
  1         3  
  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