File Coverage

blib/lib/Articulate/Authentication/Internal.pm
Criterion Covered Total %
statement 15 39 38.4
branch 0 6 0.0
condition 0 7 0.0
subroutine 5 11 45.4
pod 4 4 100.0
total 24 67 35.8


line stmt bran cond sub pod time code
1             package Articulate::Authentication::Internal;
2 4     4   3138 use strict;
  4         9  
  4         156  
3 4     4   21 use warnings;
  4         8  
  4         108  
4              
5 4     4   21 use Moo;
  4         6  
  4         25  
6              
7              
8 4     4   3382 use Digest::SHA;
  4         9543  
  4         227  
9 4     4   2073 use Time::HiRes; # overrides time()
  4         4372  
  4         21  
10              
11             =head1 NAME
12              
13             Articulate::Authentication::Internal
14              
15             =cut
16              
17             =head1 METHODS
18              
19             =cut
20              
21             =head3 authenticate
22              
23             $self->authenticate( $credentials );
24              
25             Accepts and returns the credentials if the C matches the C. Always returns the credentials passed in.
26              
27             =cut
28              
29             has extra_salt => (
30             is => 'rw',
31             default => "If you haven't already, try powdered vegetable bouillon"
32             );
33              
34             sub authenticate {
35 0     0 1   my $self = shift;
36 0           my $credentials = shift;
37 0   0       my $user_id = $credentials->fields->{user_id} // return;
38 0   0       my $password = $credentials->fields->{password} // return;
39              
40 0 0         if ( $self->verify_password ( $user_id, $password ) ) {
41 0           return $credentials->accept('Passwords match');
42             }
43             # if we ever need to know if the user does not exist, now is the time to ask,
44             # but we do not externally expose the difference between
45             # "user not found" and "password doesn't match"
46 0           return $credentials;
47             }
48              
49             sub _password_salt_and_hash {
50 0     0     my $self = shift;
51 0           return Digest::SHA::sha512_base64 (
52             $_[0] . $_[1] #:5.10 doesn't like shift . shift
53             );
54             }
55              
56             sub _generate_salt {
57             # pseudorandom salt
58 0     0     my $self = shift;
59 0           return Digest::SHA::sha512_base64 (
60             time . (
61             $self->extra_salt # don't allow the admin not to set a salt:
62             )
63             );
64             }
65              
66             =head3 verify_password
67              
68             $self->verify_password( $user_id, $password );
69              
70             Hashes the password provided with the user's salt and checks to see if the string matches the encrypted password in the user's meta.
71              
72             Returns the result of C.
73              
74             =cut
75              
76              
77             sub verify_password {
78 0     0 1   my ($self, $user_id, $plaintext_password) = @_;
79              
80 0           my $user_meta = $self->storage->get_meta ("/users/$user_id");
81 0           my $real_encrypted_password = $user_meta->{encrypted_password};
82 0           my $salt = $user_meta->{salt};
83              
84 0 0 0       return undef unless defined $real_encrypted_password and defined $plaintext_password;
85              
86             return (
87 0           $real_encrypted_password
88             eq
89             $self->_password_salt_and_hash ($plaintext_password, $salt)
90             );
91             }
92              
93             =head3 set_password
94              
95             $self->set_password( $user_id, $password );
96              
97             Creates a new pseudorandom salt and uses it to hash the password provided.
98              
99             Amends the C and C fields of the user's meta.
100              
101             =cut
102              
103             # note: currently this implicitly creates a user. Should set/patch create new content, or just edit it?
104             # maybe a create verb - but is is this going to be compatible with kvp stores? How will this work when you have content and meta and settings all to be created?
105             sub set_password {
106 0     0 1   my ($self, $user_id, $plaintext_password) = @_;
107 0 0         return undef unless $plaintext_password; # as empty passwords will only cause trouble.
108 0           my $new_salt = $self->_generate_salt;
109 0           $self->storage->patch_meta ( "/user/$user_id", {
110             encrypted_password => $self->_password_salt_and_hash ($plaintext_password, $new_salt),
111             salt => $new_salt
112             } );
113             }
114              
115             =head3 create_user
116              
117             $self->create_user( $user_id, $password );
118              
119             Creates a new user and sets the C and C fields of the user's meta.
120              
121             =cut
122              
123             sub create_user {
124 0     0 1   my ( $self, $user_id, $plaintext_password ) = @_;
125 0           $self->storage->create("/user/$user_id");
126 0           $self->storage->set_password( $user_id, $plaintext_password );
127             }
128              
129             1;