| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Data::Password::zxcvbn::Match::Regex; |
|
2
|
3
|
|
|
3
|
|
9651
|
use Moo; |
|
|
3
|
|
|
|
|
10
|
|
|
|
3
|
|
|
|
|
19
|
|
|
3
|
|
|
|
|
|
|
with 'Data::Password::zxcvbn::Match'; |
|
4
|
3
|
|
|
3
|
|
3188
|
use List::AllUtils qw(max); |
|
|
3
|
|
|
|
|
9
|
|
|
|
3
|
|
|
|
|
472
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '1.1.0'; # 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
|
|
581
|
alpha_lower => [qr{(\p{Ll}+)},26], |
|
|
1
|
|
|
|
|
17
|
|
|
|
1
|
|
|
|
|
13
|
|
|
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
|
90158
|
my ($class, $password, $opts) = @_; |
|
33
|
|
|
|
|
|
|
|
|
34
|
1498
|
|
100
|
|
|
10308
|
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
|
|
|
|
6764
|
if ($regexes eq 'all') { |
|
38
|
4
|
|
|
|
|
10
|
$regexes = \%regexes; |
|
39
|
|
|
|
|
|
|
} |
|
40
|
|
|
|
|
|
|
|
|
41
|
1498
|
|
|
|
|
3977
|
my @matches; |
|
42
|
1498
|
|
|
|
|
2973
|
for my $regex_name (keys %{$regexes}) { |
|
|
1498
|
|
|
|
|
5698
|
|
|
43
|
1522
|
|
|
|
|
4093
|
my $regex = $regexes->{$regex_name}[0]; |
|
44
|
|
|
|
|
|
|
# reset the match position |
|
45
|
1522
|
|
|
|
|
5115
|
pos($password)=0; |
|
46
|
1522
|
|
|
|
|
13862
|
while ($password =~ m{$regex}gc) { |
|
47
|
93
|
|
|
|
|
2979
|
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
|
|
|
|
|
10304
|
@matches = sort @matches; |
|
58
|
1498
|
|
|
|
|
5918
|
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
|
1110
|
my ($self,$min_guesses) = @_; |
|
67
|
|
|
|
|
|
|
|
|
68
|
84
|
|
|
|
|
356
|
my $regex = $self->regex_name; |
|
69
|
84
|
100
|
|
|
|
321
|
if ($regex eq 'recent_year') { |
|
70
|
82
|
|
|
|
|
609
|
return max( |
|
71
|
|
|
|
|
|
|
abs($self->token - $REFERENCE_YEAR), |
|
72
|
|
|
|
|
|
|
$MIN_YEAR_SPACE, |
|
73
|
|
|
|
|
|
|
); |
|
74
|
|
|
|
|
|
|
} |
|
75
|
|
|
|
|
|
|
else { |
|
76
|
2
|
|
|
|
|
22
|
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
|
|
|
|
67
|
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
|
|
|
|
56
|
$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.0 |
|
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 |