File Coverage

blib/lib/Connector/Builtin/Authentication/PasswordScheme.pm
Criterion Covered Total %
statement 92 108 85.1
branch 25 34 73.5
condition 2 6 33.3
subroutine 12 13 92.3
pod 3 3 100.0
total 134 164 81.7


line stmt bran cond sub pod time code
1             # Connector::Builtin::Authentication::PasswordScheme
2             #
3             # Check passwords against a file with salted hashes and scheme prefix
4             #
5             package Connector::Builtin::Authentication::PasswordScheme;
6              
7 1     1   163531 use strict;
  1         13  
  1         31  
8 1     1   5 use warnings;
  1         3  
  1         25  
9 1     1   5 use English;
  1         2  
  1         6  
10 1     1   1070 use Data::Dumper;
  1         7410  
  1         66  
11              
12 1     1   503 use MIME::Base64;
  1         632  
  1         60  
13 1     1   1671 use Digest::SHA;
  1         3333  
  1         56  
14 1     1   8 use Digest::MD5;
  1         2  
  1         89  
15              
16 1     1   561 use Moose;
  1         477688  
  1         7  
17             extends 'Connector::Builtin';
18              
19             sub _build_config {
20 0     0   0 my $self = shift;
21              
22 0 0       0 if (! -r $self->{LOCATION}) {
23 0         0 confess("Cannot open input file " . $self->{LOCATION} . " for reading.");
24             }
25              
26 0         0 return 1;
27             }
28              
29             sub get {
30 10     10 1 31 my $self = shift;
31 10         18 my $arg = shift;
32 10         16 my $params = shift;
33              
34 10         55 my @path = $self->_build_path( $arg );
35 10         21 my $user = shift @path;
36              
37 10         22 my $password = $params->{password};
38              
39              
40 10 50       28 if (!$user) {
41 0         0 $self->log()->error('No username');
42 0         0 die "no username given";
43             }
44              
45 10 100       21 if (!$password) {
46 1         27 $self->log()->error('No password');
47 1         20 die "no password given";
48             }
49              
50              
51 9         240 $self->log()->debug('verify password for ' . $user );
52              
53 9 100       82 if ($user =~ /[^a-zA-Z0-9_\-\.\@]/) {
54 1         23 $self->log()->error('Invalid chars in username ('.$user.')');
55 1         10 return $self->_node_not_exists( $user );
56             }
57              
58 8         18 my $filename = $self->{LOCATION};
59              
60 8 50 33     508 if (! -r $filename || ! open FILE, "$filename") {
61 0         0 $self->log()->error('Can\'t open/read from file ' . $filename);
62 0         0 die 'Can\'t open/read from file ' . $filename;
63             }
64              
65 8         182 while (<FILE>) {
66 23 100       200 if (/^$user:/) {
67 6         21 chomp;
68 6         23 my @t = split(/:/, $_, 3);
69 6         177 $self->log()->trace('found line ' . Dumper @t);
70              
71             # This code is mainly a copy of OpenXPKI::Server::Authentication::Password
72             # but we do not support unsalted passwords
73             # digest specified in RFC 2307 userPassword notation?
74 6         372 my $encrypted;
75             my $scheme;
76 6 50       76 if ($t[1] =~ m{ \{ (\w+) \} (.+) }xms) {
77 6         23 $scheme = lc($1);
78 6         15 $encrypted = $2;
79             } else {
80 0         0 $self->log()->error('unparsable entry ' . $t[1]);
81 0         0 return 0;
82             }
83              
84 6         16 my ($computed_secret, $salt);
85 6         11 eval {
86 6 100       27 if ($scheme eq 'ssha') {
    100          
    50          
87 2         16 $salt = substr(decode_base64($encrypted), 20);
88 2         13 my $ctx = Digest::SHA->new();
89 2         55 $ctx->add($password);
90 2         6 $ctx->add($salt);
91 2         27 $computed_secret = encode_base64($ctx->digest() . $salt, '');
92             } elsif ($scheme eq 'smd5') {
93 1         6 $salt = substr(decode_base64($encrypted), 16);
94 1         6 my $ctx = Digest::MD5->new();
95 1         5 $ctx->add($password);
96 1         7 $ctx->add($salt);
97 1         9 $computed_secret = encode_base64($ctx->digest() . $salt, '');
98             } elsif ($scheme eq 'crypt') {
99 3         572 $computed_secret = crypt($password, $encrypted);
100             } else {
101 0         0 $self->log()->error('unsupported scheme' . $scheme);
102 0         0 return 0;
103             }
104             };
105              
106 6 50       21 $self->log()->debug('eval failed ' . $EVAL_ERROR->message()) if ($EVAL_ERROR);
107              
108 6 50       20 if (! defined $computed_secret) {
109 0         0 $self->log()->error('unable to compute secret using scheme ' . $scheme);
110 0         0 return 0;
111             }
112              
113             ##! 2: "ident user ::= $account and digest ::= $computed_secret"
114 6         17 $computed_secret =~ s{ =+ \z }{}xms;
115 6         16 $encrypted =~ s{ =+ \z }{}xms;
116              
117             ## compare passphrases
118 6 100       13 if ($computed_secret eq $encrypted) {
119 4         120 $self->log()->info('Password accepted for ' . $user);
120 4         49 return 1;
121             } else {
122 2         59 $self->log()->info('Password mismatch for ' . $user);
123 2         26 return 0;
124             }
125             }
126             }
127 2         17 return $self->_node_not_exists( $user );
128             }
129              
130             sub get_meta {
131 2     2 1 317 my $self = shift;
132              
133             # If we have no path, we tell the caller that we are a connector
134 2         7 my @path = $self->_build_path( shift );
135 2 100       7 if (scalar @path == 0) {
136 1         9 return { TYPE => "connector" };
137             }
138              
139 1         6 return {TYPE => "scalar" };
140             }
141              
142             sub exists {
143              
144 4     4 1 10 my $self = shift;
145              
146             # No path = connector root which always exists
147 4         13 my @path = $self->_build_path( shift );
148 4 100       13 if (scalar @path == 0) {
149 1         6 return 1;
150             }
151              
152 3         7 my $user = shift @path;
153              
154 3         7 my $filename = $self->{LOCATION};
155 3 50 33     192 if (! -r $filename || ! open FILE, "$filename") {
156 0         0 $self->log()->error('Can\'t open/read from file ' . $filename);
157 0         0 return 0;
158             }
159              
160 3         57 while (<FILE>) {
161 7 100       71 if (/^$user:/) {
162 2         18 return 1;
163             }
164             }
165 1         9 return 0;
166             }
167              
168 1     1   8690 no Moose;
  1         3  
  1         7  
169             __PACKAGE__->meta->make_immutable;
170              
171             1;
172             __END__
173              
174             =head1 Name
175              
176             Connector::Builtin::Authentication::PasswordScheme
177              
178             =head1 Description
179              
180             Lightweight connector to check passwords against a password file holding
181             username/password pairs where the password is encrypted using a salted hash.
182             Password notation follows RFC2307 ({scheme}saltedpassword) but we support
183             only salted schemes: smd5, ssha and crypt.
184              
185             =head2 Usage
186              
187             The username is the first component of the path, the password needs to be
188             passed in the extended parameters using the key password.
189              
190             Example:
191              
192             $connector->get('username', { password => 'mySecret' } );
193              
194             =head2 Return values
195              
196             1 if the password matches, 0 if the user is found but the password does not
197             match and undef if the user is not found.
198              
199             The connector will die if the password file is not readable or if one of
200             the parameters is missing.
201              
202             =head2 Limitations
203              
204             Usernames are limited to [a-zA-Z0-9_\-\.], invalid names are treated as not
205             found.
206