File Coverage

blib/lib/Crypt/Passphrase/Pepper/Base.pm
Criterion Covered Total %
statement 49 50 98.0
branch 11 16 68.7
condition 2 6 33.3
subroutine 11 11 100.0
pod 4 5 80.0
total 77 88 87.5


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