1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
package Data::Password::zxcvbn::Match::UserInput;
use Moo;
use mro;
extends 'Data::Password::zxcvbn::Match::Dictionary';
our $VERSION = '1.1.2'; # VERSION
# ABSTRACT: match class for words that match other user-supplied information
# a somewhat general word boundary: the spot between a letter
# (\p{L}) and a non-letter (\P{L}), or a digit (\d) and a non-digit
# (\D); we don't care about beginning or end of string, because we're
# going to use this only in a split
# this split on every transition:
my $WORD_BOUNDARY_SPLIT_MORE_RE = qr{
# letter followed by non-letter
(?: (?<=\p{L})(?=\P{L}) ) |
# non-letter followed by letter
(?: (?<=\P{L})(?=\p{L}) ) |
# digit followed by non-digit
(?: (?<=\d)(?=\D) ) |
# non-digit followed by digit
(?: (?<=\D)(?=\d) )
}x;
# this splits on alphanumeric / non-alphanumeric transitions only
my $WORD_BOUNDARY_SPLIT_LESS_RE = qr{
# alnum followed by non-alnum
(?: (?<=[\p{L}\d])(?=[^\p{L}\d]) ) |
# non-alnum followed by alnum
(?: (?<=[^\p{L}\d])(?=[\p{L}\d]) )
}x;
sub _split_to_hash {
my ($class, $value, $re) = @_;
if (my @words = grep {length} split $re, $value) {
# all words have rank 1, they're the first thing that a
# cracker would try
return (
map { lc($_) => 1 } @words, ## no critic(ProhibitUselessTopic)
);
}
return ();
}
sub make {
my ($class, $password, $opts) = @_;
my $user_input = $opts->{user_input};
return [] unless $user_input && %{$user_input};
# we build one "dictionary" per input field, so we can distinguish
# them when providing feedback
my %user_dicts;
for my $field (keys %{$user_input}) {
my $value = $user_input->{$field} or next;
$user_dicts{$field} = {
$class->_split_to_hash($value,$WORD_BOUNDARY_SPLIT_MORE_RE),
$class->_split_to_hash($value,$WORD_BOUNDARY_SPLIT_LESS_RE),
# also keep the whole value
lc($value) => 1,
};
}
return $class->next::method(
$password,
{
ranked_dictionaries => \%user_dicts,
l33t_table => $opts->{l33t_table},
},
);
}
sub feedback_warning {
my ($self, $is_sole_match) = @_;
if ($is_sole_match && !$self->l33t && !$self->reversed) {
return [
'The value of the [_1] field is easy to guess',
$self->dictionary_name,
];
}
elsif ($self->guesses_log10 <= 4) {
return [
'This is similar to the value of the [_1] field',
$self->dictionary_name,
];
}
return undef;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Data::Password::zxcvbn::Match::UserInput - match class for words that match other user-supplied information
=head1 VERSION
version 1.1.2
=head1 DESCRIPTION
This class represents the guess that a certain substring of a password
can be guessed by using other pieces of information related to the
user: their account name, real name, location, &c.
This is a subclass of L<< C<Data::Password::zxcvbn::Match::Dictionary>
>>.
=head1 METHODS
=head2 C<make>
my @matches = @{ Data::Password::zxcvbn::Match::UserInput->make(
$password,
{
user_input => \%user_input,
# this is the default
l33t_table => \%Data::Password::zxcvbn::Match::Dictionary::l33t_table,
},
) };
The C<%user_input> hash should be a simple hash mapping field names to
strings. It will be converted into a set of dictionaries, one per key,
containing words extracted from the strings. For example
{ name => 'Some One', address => '123 Place Street' }
will become:
{ name => { Some => 1, One => 1 },
address => { 123 => 1, Place => 1, Street => 1 } }
All words get rank 1 because they're obvious guesses from a cracker's
point of view.
The rest of the logic is the same as for L<<
C<Dictionary>|Data::Password::zxcvbn::Match::Dictionary/make >>.
=head2 C<feedback_warning>
The warnings for this class are very similar to those for
C<Dictionary>, but they explicitly mention the field name. Warnings
look like:
['The value of the [_1] field is easy to guess','address']
so your localisation library can translate the warning and the field
name separately.
=head1 AUTHOR
Gianni Ceccarelli <gianni.ceccarelli@broadbean.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2022 by BroadBean UK, a CareerBuilder Company.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
