File Coverage

blib/lib/Crypt/Passphrase/Pepper/Base.pm
Criterion Covered Total %
statement 43 44 97.7
branch 10 14 71.4
condition 2 6 33.3
subroutine 11 11 100.0
pod 5 5 100.0
total 71 80 88.7


line stmt bran cond sub pod time code
1             package Crypt::Passphrase::Pepper::Base;
2             $Crypt::Passphrase::Pepper::Base::VERSION = '0.014';
3 1     1   451 use strict;
  1         2  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         29  
5              
6 1     1   5 use Carp 'croak';
  1         2  
  1         57  
7 1     1   6 use Crypt::Passphrase -encoder, -integration;
  1         2  
  1         6  
8 1     1   443 use MIME::Base64 'encode_base64';
  1         587  
  1         673  
9              
10             sub new {
11 1     1 1 4 my ($class, %args) = @_;
12 1   33     4 my $inner = delete $args{inner} // croak('No inner encoder given to pepper');
13 1         17 my $encoder = Crypt::Passphrase::_load_encoder($inner);
14              
15 1 50       9 croak('No peppers given') if not defined $args{active};
16 1 50       5 croak("Invalid pepper name '$args{active}'") if $args{active} =~ /\W/;
17              
18 1         5 my $self = bless {
19             %args,
20             inner => $encoder,
21             }, $class;
22              
23 1         26 return $self;
24             }
25              
26             sub _to_inner {
27 4     4   7 my $hash = shift;
28 4 100       38 $hash =~ s/ (?<= \A \$) peppered-(\w+) \$ v=1 , alg=([^\$,]+) , id=([^\$,]+) /$1/x or return;
29 2         13 return ($hash, $2, $3);
30             }
31              
32             sub prehash_password;
33              
34             sub hash_password {
35 1     1 1 3 my ($self, $password) = @_;
36              
37 1         9 my $prehashed = $self->prehash_password($password, $self->{algorithm}, $self->{active});
38 1         9 my $wrapped = encode_base64($prehashed, '') =~ tr/=//dr;
39 1         4 my $hash = $self->{inner}->hash_password($wrapped);
40 1         39 return $hash =~ s/ (?<= \A \$) ([^\$]+) /peppered-$1\$v=1,alg=$self->{algorithm},id=$self->{active}/rx;
41             }
42              
43             sub crypt_subtypes {
44 1     1 1 2 my $self = shift;
45 1         3 return map { ("peppered-$_", $_) } $self->{inner}->crypt_subtypes;
  1         9  
46             }
47              
48             sub needs_rehash {
49 2     2 1 5 my ($self, $hash) = @_;
50 2 100       5 my ($primary, $type, $id) = _to_inner($hash) or return 1;
51 1   33     3 return "$type,$id" ne join(',', @{$self}{qw/algorithm active/}) || $self->{inner}->needs_rehash($primary);
52             }
53              
54             sub verify_password {
55 2     2 1 5 my ($self, $password, $hash) = @_;
56              
57 2 100       5 if (my ($primary, $type, $id) = _to_inner($hash)) {
    50          
58 1 50       3 my $prehashed = eval { $self->prehash_password($password, $type, $id) } or return !!0;
  1         13  
59 1         5 my $wrapped = encode_base64($prehashed, '') =~ tr/=//dr;
60 1         5 return $self->{inner}->verify_password($wrapped, $primary);
61             }
62             elsif ($self->{inner}->accepts_hash($hash)) {
63 1         4 return $self->{inner}->verify_password($password, $hash);
64             }
65             else {
66 0           return !!0;
67             }
68             }
69              
70             1;
71              
72             # ABSTRACT: A base class for pre-hashing pepper implementations
73              
74             __END__