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 |