File Coverage

blib/lib/Data/Password/zxcvbn/Match/Regex.pm
Criterion Covered Total %
statement 31 31 100.0
branch 6 8 75.0
condition 2 2 100.0
subroutine 7 7 100.0
pod 4 4 100.0
total 50 52 96.1


line stmt bran cond sub pod time code
1             package Data::Password::zxcvbn::Match::Regex;
2 3     3   9235 use Moo;
  3         9  
  3         22  
3             with 'Data::Password::zxcvbn::Match';
4 3     3   3193 use List::AllUtils qw(max);
  3         7  
  3         491  
5             our $VERSION = '1.1.1'; # VERSION
6             # ABSTRACT: match class for recognisable patterns in passwords
7              
8              
9             our %regexes_limited = ( ## no critic (ProhibitPackageVars)
10             recent_year => [qr{(19\d\d|200\d|201\d)},-1],
11             );
12             our %regexes = ( ## no critic (ProhibitPackageVars)
13 1     1   622 alpha_lower => [qr{(\p{Ll}+)},26],
  1         15  
  1         14  
14             alpha_upper => [qr{(\p{Lu}+)},26],
15             alpha => [qr{(\p{L}+)},52],
16             # Nd means "decimal number", let's ignore the other kind of numbers
17             digits => [qr{(\p{Nd}+)},10],
18             alphanumeric => [qr{( (?: (?: \p{L}+\p{Nd}+ )+\p{L}* ) | (?: (?: \p{Nd}+\p{L}+ )+\p{Nd}* ))},62],
19             # marks, punctuation, symbols
20             symbols => [qr{((?:\p{M}|\p{P}|\p{S})+)},33],
21             %regexes_limited,
22             );
23              
24             # this should be constrained to the keys of %regexes, but we can't do
25             # that because users can pass their own regexes to ->make
26             has regex_name => ( is => 'ro', default => 'alphanumeric' );
27              
28             has regexes => ( is => 'ro', default => sub { \%regexes } );
29              
30              
31             sub make {
32 1498     1498 1 85550 my ($class, $password, $opts) = @_;
33              
34 1498   100     9609 my $regexes = $opts->{regexes} || \%regexes_limited;
35             # the normal zxcvbn implementation only uses recent_year, we may
36             # want to have all of them
37 1498 100       6363 if ($regexes eq 'all') {
38 4         8 $regexes = \%regexes;
39             }
40              
41 1498         3366 my @matches;
42 1498         3610 for my $regex_name (keys %{$regexes}) {
  1498         5934  
43 1522         3900 my $regex = $regexes->{$regex_name}[0];
44             # reset the match position
45 1522         5472 pos($password)=0;
46 1522         13837 while ($password =~ m{$regex}gc) {
47 93         2824 push @matches, $class->new({
48             token => $1,
49             # @- and @+ hold the begin/end index of matches
50             i => $-[1], j => $+[1]-1,
51             regex_name => $regex_name,
52             regexes => $regexes,
53             });
54             }
55             }
56              
57 1498         10905 @matches = sort @matches;
58 1498         5888 return \@matches;
59             }
60              
61              
62             my $MIN_YEAR_SPACE = 20;
63             my $REFERENCE_YEAR = 2017;
64              
65             sub estimate_guesses {
66 84     84 1 1335 my ($self,$min_guesses) = @_;
67              
68 84         415 my $regex = $self->regex_name;
69 84 100       310 if ($regex eq 'recent_year') {
70 82         605 return max(
71             abs($self->token - $REFERENCE_YEAR),
72             $MIN_YEAR_SPACE,
73             );
74             }
75             else {
76 2         20 return $self->regexes->{$self->regex_name}[1] ** length($self->token);
77             }
78             }
79              
80              
81             sub feedback_warning {
82 7     7 1 31 my ($self) = @_;
83              
84 7 50       70 return $self->regex_name eq 'recent_year'
85             ? 'Recent years are easy to guess'
86             : undef
87             ;
88             }
89              
90             sub feedback_suggestions {
91 7     7 1 23 my ($self) = @_;
92              
93             return [
94 7 50       52 $self->regex_name eq 'recent_year'
95             ? ( 'Avoid recent years',
96             'Avoid years that are associated with you' )
97             : (),
98             ];
99             }
100              
101              
102             around fields_for_json => sub {
103             my ($orig,$self) = @_;
104             ( $self->$orig(), qw(regex_name) )
105             };
106              
107             1;
108              
109             __END__
110              
111             =pod
112              
113             =encoding UTF-8
114              
115             =head1 NAME
116              
117             Data::Password::zxcvbn::Match::Regex - match class for recognisable patterns in passwords
118              
119             =head1 VERSION
120              
121             version 1.1.1
122              
123             =head1 DESCRIPTION
124              
125             This class represents the guess that a certain substring of a password
126             can be guessed by enumerating small languages described by regular
127             expressions. By default, the only regex used is one that matches
128             recent years (yes, this is very similar to what L<<
129             C<Date>|Data::Password::zxcvbn::Match::Date >> does).
130              
131             =head1 ATTRIBUTES
132              
133             =head2 C<regexes>
134              
135             Hashref, the regular expressions that were tried to get this
136             match. The values are arrayrefs with 2 elements: the regex itself, and
137             the estimated number of guesses per character; for example:
138              
139             digits => [ qr[(\p{Nd}+)], 10 ],
140              
141             =head2 C<regex_name>
142              
143             The name of the regex that matched the token.
144              
145             =head1 METHODS
146              
147             =head2 C<make>
148              
149             my @matches = @{ Data::Password::zxcvbn::Match::Regex->make(
150             $password,
151             { # this is the default
152             regexes => \%Data::Password::zxcvbn::Match::Regex::regexes_limited,
153             },
154             ) };
155              
156             Scans the C<$password> for substrings that match regexes in
157             C<regexes>.
158              
159             By default, the only regex that's used is one that matches recent
160             years expressed as 4 digits. More patterns are available as
161             C<\%Data::Password::zxcvbn::Match::Regex::regexes> (which you can also
162             get if you say C<< regexes => 'all' >>), or you can pass in your own
163             hashref.
164              
165             =head2 C<estimate_guesses>
166              
167             For the C<recent_year> regex, the number of guesses is the number of
168             years between the value represented by the token and a reference year
169             (currently 2017).
170              
171             For all other regexes, the number of guesses is exponential on the
172             length of the token, using as base the second element of the matching
173             pattern (i.e. C<< $self->regexes->{$self->regex_name}[1] >>).
174              
175             =head2 C<feedback_warning>
176              
177             =head2 C<feedback_suggestions>
178              
179             This class suggests not using recent years. At the moment, there's no
180             feedback for other regexes.
181              
182             =head2 C<fields_for_json>
183              
184             The JSON serialisation for matches of this class will contain C<token
185             i j guesses guesses_log10 regex_name>.
186              
187             =head1 AUTHOR
188              
189             Gianni Ceccarelli <gianni.ceccarelli@broadbean.com>
190              
191             =head1 COPYRIGHT AND LICENSE
192              
193             This software is copyright (c) 2022 by BroadBean UK, a CareerBuilder Company.
194              
195             This is free software; you can redistribute it and/or modify it under
196             the same terms as the Perl 5 programming language system itself.
197              
198             =cut