File Coverage

blib/lib/Dancer2/Plugin/Auth/Extensible/Role/Provider.pm
Criterion Covered Total %
statement 14 14 100.0
branch 2 2 100.0
condition n/a
subroutine 4 4 100.0
pod 2 2 100.0
total 22 22 100.0


line stmt bran cond sub pod time code
1             package Dancer2::Plugin::Auth::Extensible::Role::Provider;
2              
3 11     11   41420 use Crypt::SaltedHash;
  11         36735  
  11         337  
4 11     11   81 use Moo::Role;
  11         25  
  11         90  
5             requires qw(authenticate_user);
6              
7             our $VERSION = '0.709';
8              
9             =head1 NAME
10              
11             Dancer2::Plugin::Auth::Extensible::Role::Provider - base role for authentication providers
12              
13             =head1 DESCRIPTION
14              
15             Base L<Moo::Role> for authentication providers.
16              
17             Also provides secure password matching which automatically handles crypted
18             passwords via Crypt::SaltedHash.
19              
20             =head1 ATTRIBUTES
21              
22             =head2 plugin
23              
24             The calling L<Dancer2::Plugin::Auth::Extensible> object.
25              
26             Required.
27              
28             =cut
29              
30             has plugin => (
31             is => 'ro',
32             required => 1,
33             weaken => 1,
34             );
35              
36             =head2 disable_roles
37              
38             Defaults to the value of L<Dancer2::Plugin::Auth::Extensible/disable_roles>.
39              
40             =cut
41              
42             has disable_roles => (
43             is => 'ro',
44             lazy => 1,
45             default => sub { $_[0]->plugin->disable_roles },
46             );
47              
48             =head2 encryption_algorithm
49              
50             The encryption_algorithm used by L</encrypt_password>.
51              
52             Defaults to 'SHA-512';
53              
54             =cut
55              
56             has encryption_algorithm => (
57             is => 'ro',
58             default => 'SHA-512',
59             );
60              
61             =head1 METHODS
62              
63             =head2 match_password $given, $correct
64              
65             Matches C<$given> password with the C<$correct> one.
66              
67             =cut
68              
69             sub match_password {
70 62     62 1 13495 my ( $self, $given, $correct ) = @_;
71              
72             # TODO: perhaps we should accept a configuration option to state whether
73             # passwords are crypted or not, rather than guessing by looking for the
74             # {...} tag at the start.
75             # I wanted to let it try straightforward comparison first, then try
76             # Crypt::SaltedHash->validate, but that has a weakness: if a list of hashed
77             # passwords got leaked, you could use the hashed password *as it is* to log
78             # in, rather than cracking it first. That's obviously Not Fucking Good.
79             # TODO: think about this more. This shit is important. I'm thinking a
80             # config option to indicate whether passwords are crypted - yes, no, auto
81             # (where auto would do the current guesswork, and yes/no would just do as
82             # told.)
83 62 100       325 if ( $correct =~ /^{.+}/ ) {
84              
85             # Looks like a crypted password starting with the scheme, so try to
86             # validate it with Crypt::SaltedHash:
87 26         248 return Crypt::SaltedHash->validate( $correct, $given );
88             }
89             else {
90             # Straightforward comparison, then:
91 36         151 return $given eq $correct;
92             }
93             }
94              
95             =head2 encrypt_password $password
96              
97             Encrypts password C<$password> with L</encryption_algorithm>
98             and returns the encrypted password.
99              
100             =cut
101              
102             sub encrypt_password {
103 14     14 1 2373 my ( $self, $password ) = @_;
104 14         145 my $crypt =
105             Crypt::SaltedHash->new( algorithm => $self->encryption_algorithm );
106 14         5187 $crypt->add($password);
107 14         250 $crypt->generate;
108             }
109              
110             =head1 METHODS IMPLEMENTED BY PROVIDER
111              
112             The following methods must be implemented by the consuming provider class.
113              
114             =head2 required methods
115              
116             =over
117              
118             =item * authenticate_user $username, $password
119              
120             If either of C<$username> or C<$password> are undefined then die.
121              
122             Return true on success.
123              
124             =back
125              
126             =head2 optional methods
127              
128             The following methods are optional and extend the functionality of the
129             provider.
130              
131             =over
132              
133             =item * get_user_details $username
134              
135             Die if C<$username> is undefined. Otherwise return a user object (if
136             appropriate) or a hash reference of user details.
137              
138             =item * get_user_roles $username
139              
140             Die if C<$username> is undefined. Otherwise return an array reference of
141             user roles.
142              
143             =item * create_user %user
144              
145             Create user with fields specified in C<%user>.
146              
147             Method should croak if C<username> key is empty or undefined. If a user with
148             the specified username already exists then we would normally expect the
149             method to die though this is of course dependent on the backend in use.
150              
151             The new user should be returned.
152              
153             =item * get_user_by_code $code
154              
155             Try to find a user which has C<pw_reset_code> field set to C<$code>.
156              
157             Returns the user on success.
158              
159             =item * set_user_details $username, %update
160              
161             Update user with C<$username> according to C<%update>.
162              
163             Passing an empty or undefined C<$username> should cause the method to die.
164              
165             The update user should be returned.
166              
167             =item * set_user_password $username, $password
168              
169             Set the password for the user specified by C<$username> to <$password>
170             encrypted using L</encrypt_password> or via whatever other method is
171             appropriate for the backend.
172              
173             =item * password_expired $user
174              
175             The C<$user> should be as returned from L</get_user_details>. The method
176             checks whether the user's password has expired and returns 1 if it has and
177             0 if it has not.
178              
179             =back
180              
181             =cut
182              
183             1;
184