File Coverage

blib/lib/Crypt/Passphrase.pm
Criterion Covered Total %
statement 88 104 84.6
branch 19 28 67.8
condition 2 4 50.0
subroutine 20 22 90.9
pod 5 6 83.3
total 134 164 81.7


line stmt bran cond sub pod time code
1             package Crypt::Passphrase;
2             $Crypt::Passphrase::VERSION = '0.015';
3 3     3   209635 use strict;
  3         52  
  3         89  
4 3     3   28 use warnings;
  3         6  
  3         71  
5              
6 3     3   14 use mro ();
  3         6  
  3         53  
7              
8 3     3   21 use Carp ();
  3         6  
  3         52  
9 3     3   18 use Scalar::Util ();
  3         6  
  3         62  
10 3     3   1863 use Encode ();
  3         32097  
  3         77  
11 3     3   2969 use Unicode::Normalize ();
  3         6817  
  3         285  
12              
13             our @CARP_NOT;
14             sub import {
15 12     12   222 my ($class, @args) = @_;
16 12         104349 for my $arg (@args) {
17 10         26 my $caller = caller;
18 10 100       43 if ($arg eq '-encoder') {
    100          
    50          
19 5         1425 require Crypt::Passphrase::Encoder;
20 3     3   23 no strict 'refs';
  3         7  
  3         99  
21 3     3   14 no warnings 'once';
  3         15  
  3         370  
22 5 100       113 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Encoder' unless $caller->isa('Crypt::Passphrase::Encoder');
  4         52  
23 5         17 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  5         147  
24             }
25             elsif ($arg eq '-validator') {
26 4         18 require Crypt::Passphrase::Validator;
27 3     3   21 no strict 'refs';
  3         6  
  3         118  
28 3     3   17 no warnings 'once';
  3         6  
  3         3132  
29 4 50       49 push @{"$caller\::ISA"}, 'Crypt::Passphrase::Validator' unless $caller->isa('Crypt::Passphrase::Validator');
  4         43  
30 4         15 push @{"$caller\::CARP_NOT"}, __PACKAGE__, mro::get_linear_isa($caller);
  4         153  
31             }
32             elsif ($arg eq '-integration') {
33 1         43 push @CARP_NOT, $caller;
34             }
35             else {
36 0         0 Carp::croak("Unknown import argument $arg");
37             }
38             }
39             }
40              
41             sub _load_extension {
42 9     9   19 my $short_name = shift;
43 9 50       58 my $module_name = $short_name =~ s/^(\+)?/$1 ? '' : 'Crypt::Passphrase::'/re;
  9         50  
44 9         58 my $file_name = "$module_name.pm" =~ s{::}{/}gr;
45 9         3654 require $file_name;
46 9         582 return $module_name;
47             }
48              
49             sub _load_encoder {
50 5     5   12 my $encoder = shift;
51 5 50       52 if (Scalar::Util::blessed($encoder)) {
    100          
52 0         0 return $encoder;
53             }
54             elsif (ref $encoder) {
55 1         3 my %encoder_conf = %{ $encoder };
  1         5  
56 1         4 my $encoder_module = _load_extension(delete $encoder_conf{module});
57 1         9 return $encoder_module->new(%encoder_conf);
58             }
59             else {
60 4         13 return _load_extension($encoder)->new;
61             }
62             }
63              
64             sub _load_validator {
65 4     4   10 my $validator = shift;
66 4 50       22 if (Scalar::Util::blessed($validator)) {
    50          
    50          
67 0         0 return $validator;
68             }
69             elsif (ref($validator) eq 'HASH') {
70 0         0 my %validator_conf = %{ $validator };
  0         0  
71 0         0 my $validator_module = _load_extension(delete $validator_conf{module});
72 0         0 return $validator_module->new(%validator_conf);
73             }
74             elsif (ref($validator) eq 'CODE') {
75 0         0 require Crypt::Passphrase::Fallback;
76 0         0 return Crypt::Passphrase::Fallback->new(callback => $validator);
77             }
78             else {
79 4         9 return _load_extension($validator)->new;
80             }
81             }
82              
83             my %valid = map { $_ => 1 } qw/C D KC KD/;
84             sub new {
85 4     4 1 610 my ($class, %args) = @_;
86 4 50       19 Carp::croak('No encoder given to Crypt::Passphrase->new') if not $args{encoder};
87 4         17 my $encoder = _load_encoder($args{encoder});
88 4         28 my @validators = map { _load_validator($_) } @{ $args{validators} };
  4         12  
  4         21  
89 4   50     44 my $normalization = $args{normalization} || 'C';
90 4 50       18 Carp::croak("Invalid normalization form $normalization") if not $valid{$normalization};
91              
92 4         29 my $self = bless {
93             encoder => $encoder,
94             validators => [ $encoder, @validators ],
95             normalization => $normalization,
96             }, $class;
97              
98 4         35 return $self;
99             }
100              
101             sub _normalize_password {
102 13     13   38 my ($self, $password) = @_;
103 13   50     75 my $normalized = Unicode::Normalize::normalize($self->{normalization}, $password // '');
104 13         306 return Encode::encode('utf-8-strict', $normalized);
105             }
106              
107             sub hash_password {
108 3     3 1 647 my ($self, $password) = @_;
109 3         10 my $normalized = $self->_normalize_password($password);
110 3         165 return $self->{encoder}->hash_password($normalized);
111             }
112              
113             sub needs_rehash {
114 8     8 1 1109 my ($self, $hash) = @_;
115 8         44 return $self->{encoder}->needs_rehash($hash);
116             }
117              
118             sub verify_password {
119 10     10 1 1283 my ($self, $password, $hash) = @_;
120              
121 10         22 for my $validator (@{ $self->{validators} }) {
  10         37  
122 20 100       75 if ($validator->accepts_hash($hash)) {
123 10         35 my $normalized = $self->_normalize_password($password);
124 10         451 return $validator->verify_password($normalized, $hash);
125             }
126             }
127              
128 0           return 0;
129             }
130              
131             sub curry_with_hash {
132 0     0 1   my ($self, $hash) = @_;
133 0           require Crypt::Passphrase::PassphraseHash;
134 0           return Crypt::Passphrase::PassphraseHash->new($self, $hash);
135             }
136              
137             sub curry_with_password {
138 0     0 0   my ($self, $password) = @_;
139 0           my $hash = $self->hash_password($password);
140 0           return $self->curry_with_hash($hash);
141             }
142              
143             1;
144              
145             # ABSTRACT: A module for managing passwords in a cryptographically agile manner
146              
147             __END__