File Coverage

blib/lib/Data/Password/zxcvbn/Match/UserInput.pm
Criterion Covered Total %
statement 24 30 80.0
branch 4 10 40.0
condition 2 9 22.2
subroutine 5 6 83.3
pod 2 2 100.0
total 37 57 64.9


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