File Coverage

blib/lib/Data/Password/zxcvbn/Match.pm
Criterion Covered Total %
statement 27 28 96.4
branch 4 4 100.0
condition 3 3 100.0
subroutine 11 12 91.6
pod 6 6 100.0
total 51 53 96.2


line stmt bran cond sub pod time code
1             package Data::Password::zxcvbn::Match;
2 9     9   1477425 use Moo::Role;
  9         82  
  9         65  
3 9     9   6024 use Carp;
  9         49  
  9         636  
4 9     9   5195 use List::AllUtils qw(max);
  9         115903  
  9         1035  
5             use overload
6             '<=>' => \&compare,
7             'cmp' => \&compare,
8 0     0   0 bool => sub { 1 },
9 9     9   77 ;
  9         27  
  9         119  
10             our $VERSION = '1.1.0'; # VERSION
11             # ABSTRACT: role for match objects
12              
13              
14             has token => (is => 'ro', required => 1); # string
15             has [qw(i j)] => (is => 'ro', required => 1); # ints
16              
17              
18             sub compare {
19 31467     31467 1 53285 my ($self, $other) = @_;
20              
21 31467   100     128077 return $self->i <=> $other->i || $self->j <=> $other->j;
22             }
23              
24              
25             requires 'make';
26              
27              
28             has guesses => (is => 'lazy', builder => 'estimate_guesses');
29             requires 'estimate_guesses';
30              
31              
32             sub guesses_log10 {
33 1701     1701 1 28895 return log(shift->guesses)/log(10);
34             }
35              
36             my $MIN_SUBMATCH_GUESSES_SINGLE_CHAR = 10;
37             my $MIN_SUBMATCH_GUESSES_MULTI_CHAR = 50;
38              
39             # this is here only because ::BruteForce needs it
40             sub _min_guesses {
41 24797     24797   43462 my ($self) = @_;
42              
43 24797 100       78904 return length($self->token) == 1
44             ? $MIN_SUBMATCH_GUESSES_SINGLE_CHAR
45             : $MIN_SUBMATCH_GUESSES_MULTI_CHAR;
46             }
47              
48              
49             sub guesses_for_password {
50 7473     7473 1 15577 my ($self, $password) = @_;
51              
52 7473 100       25726 my $min_guesses = length($self->token) < length($password)
53             ? $self->_min_guesses()
54             : 1;
55 7473         144580 my $guesses = $self->guesses();
56 7473         31998 return max($min_guesses,$guesses);
57             }
58              
59              
60             sub get_feedback {
61 898     898 1 2917 my ($self, $is_sole_match) = @_;
62              
63             return {
64 898         4853 warning => $self->feedback_warning($is_sole_match),
65             suggestions => $self->feedback_suggestions($is_sole_match),
66             };
67             }
68              
69             requires 'feedback_warning', 'feedback_suggestions';
70              
71              
72 1620     1620 1 9324 sub fields_for_json { qw(token i j guesses guesses_log10) }
73             sub TO_JSON {
74 1620     1620 1 11545810 my ($self) = @_;
75             return {
76             class => ref($self),
77 1620         24046 map { $_ => $self->$_ } $self->fields_for_json,
  11013         88363  
78             };
79             }
80              
81             1;
82              
83             __END__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 NAME
90              
91             Data::Password::zxcvbn::Match - role for match objects
92              
93             =head1 VERSION
94              
95             version 1.1.0
96              
97             =head1 SYNOPSIS
98              
99             package My::Password::Match::Something;
100             use Moo;
101             with 'Data::Password::zxcvbn::Match';
102              
103             has some_info => (is=>'ro');
104              
105             sub make {
106             my ($class, $password) = @_;
107             return [ $class->new({
108             token => some_substring_of($password),
109             i => position_of_first_char($token,$password),
110             j => position_of_last_char($token,$password),
111             some_info => whatever_needed(),
112             }) ];
113             }
114              
115             sub estimate_guesses {
116             my ($self) = @_;
117             return $self->some_complexity_estimate();
118             }
119              
120             sub feedback_warning { 'this is a bad idea' }
121             sub feedback_suggestions { return [ 'do something else' ] }
122              
123             1;
124              
125             =head1 DESCRIPTION
126              
127             zxcvbn estimates the strength of a password by guessing which way a
128             generic password cracker would produce it, and then guessing after how
129             many tries it would produce it.
130              
131             This role provides the basic behaviour and interface for the classes
132             that implement that guessing.
133              
134             =head1 ATTRIBUTES
135              
136             =head2 C<token>
137              
138             Required string: the portion of the password that this object
139             matches. For example, if your class represents "sequences of digits",
140             an instance L<made|/make> from the password C<abc1234def> would have
141             C<< token => '1234' >>.
142              
143             =head2 C<i>, C<j>
144              
145             Required integers: the indices of the first and last character of
146             L</token> in the password. For the example above, we would have C<< i
147             => 3, j => 6 >>.
148              
149             =head2 C<guesses>
150              
151             The estimated number of attempts that a generic password cracker would
152             need to guess the particular L</token>. The value for this attribute
153             is generated on demand by calling L<< /C<estimate_guesses> >>.
154              
155             =head1 REQUIRED METHODS
156              
157             =head2 C<make>
158              
159             sub make {
160             my ($class, $password) = @_;
161             return [ $class->new(\%something), ... ];
162             }
163              
164             This factory method should return a I<sorted> arrayref of instances,
165             one for each substring of the C<$password> that could be generated /
166             guessed with the logic that your class represents.
167              
168             =head2 C<estimate_guesses>
169              
170             sub estimate_guesses {
171             my ($self) = @_;
172             return $self->some_complexity_estimate();
173             }
174              
175             This method should return an integer, representing an estimate of the
176             number of attempts that a generic password cracker would need to guess
177             the particular L</token> I<within the logic that your class
178             represents>. For example, if your class represents "sequences of
179             digits", you could hypothesise that the cracker would go in order from
180             1, so you'd write:
181              
182             sub estimate_guesses { return 0 + shift->token }
183              
184             =head2 C<feedback_warning>
185              
186             This method should return a string (possibly empty), or an arrayref
187             C<[$string,@values]> suitable for localisation. The returned value
188             should explain what's wrong, e.g. 'this is a top-10 common password'.
189              
190             =head2 C<feedback_suggestions>
191              
192             This method should return a possibly-empty array of suggestions to
193             help choose a less guessable password. e.g. 'Add another word or two';
194             again, elements can be strings or arrayrefs for localisation.
195              
196             =head1 METHODS
197              
198             =head2 C<compare>
199              
200             $match1 <=> $match2
201             $match1 cmp $match2
202              
203             The comparison operators are overloaded to sort by L<< /C<i> >> and
204             L<< /C<j> >>, so a sorted list of matches will cover the password from
205             left to right.
206              
207             =head2 C<guesses_log10>
208              
209             The logarithm in base 10 of L<< /C<guesses> >>.
210              
211             =head2 C<guesses_for_password>
212              
213             my $guesses = $match->guesses_for_password($password);
214              
215             This method will return the same value as L<< /C<guesses> >>, or some
216             minimum number of guesses, whichever is higher.
217              
218             This is to make sure that all match have a measurable impact on the
219             estimation of the total complexity.
220              
221             =head2 C<get_feedback>
222              
223             my %feedback = %{ $match->get_feedback($is_sole_match) };
224              
225             Returns a hashref, with verbal feedback to help choose better
226             passwords. The hash contains:
227              
228             =over 4
229              
230             =item *
231              
232             C<warning>
233              
234             string (or arrayref for localisation), produced by calling L<<
235             /C<feedback_warning> >>
236              
237             =item *
238              
239             C<suggestions>
240              
241             arrayref of strings (or arrayrefs for localisation), produced by
242             calling L<< /C<feedback_suggestions> >>.
243              
244             =back
245              
246             =head2 C<TO_JSON>
247              
248             =head2 C<fields_for_json>
249              
250             Matches can be serialised to JSON. The serialisation will be a
251             dictionary with all the fields returned by L<< /C<fields_for_json>
252             >>. By default, it will contain C<token i j guesses guesses_log10>.
253              
254             =head1 AUTHOR
255              
256             Gianni Ceccarelli <gianni.ceccarelli@broadbean.com>
257              
258             =head1 COPYRIGHT AND LICENSE
259              
260             This software is copyright (c) 2022 by BroadBean UK, a CareerBuilder Company.
261              
262             This is free software; you can redistribute it and/or modify it under
263             the same terms as the Perl 5 programming language system itself.
264              
265             =cut