line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package String::Validator::Password; |
2
|
|
|
|
|
|
|
|
3
|
11
|
|
|
11
|
|
353888
|
use 5.006; |
|
11
|
|
|
|
|
49
|
|
|
11
|
|
|
|
|
693
|
|
4
|
11
|
|
|
11
|
|
176
|
use strict; |
|
11
|
|
|
|
|
26
|
|
|
11
|
|
|
|
|
685
|
|
5
|
11
|
|
|
11
|
|
72
|
use warnings; |
|
11
|
|
|
|
|
28
|
|
|
11
|
|
|
|
|
445
|
|
6
|
11
|
|
|
11
|
|
63
|
no warnings qw(uninitialized) ; |
|
11
|
|
|
|
|
21
|
|
|
11
|
|
|
|
|
1752
|
|
7
|
11
|
|
|
11
|
|
14489
|
use String::Validator::Common ; |
|
11
|
|
|
|
|
17561
|
|
|
11
|
|
|
|
|
1166
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.94'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=pod |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
String::Validator::Password - Check a string against a number of common password rules. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Version 0.94 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
String::Validator::Password is part of the String Validator Collection. It will |
24
|
|
|
|
|
|
|
check a string against any number of password validation rules, and optionally |
25
|
|
|
|
|
|
|
against a second string (as in password confirmation box on a webform). The |
26
|
|
|
|
|
|
|
primary Negative method returns 0 if the password passes all tests, or a string |
27
|
|
|
|
|
|
|
describing the errors if it fails. The Positive Method returns 1 if the string |
28
|
|
|
|
|
|
|
passes and 0 if it fails. The ErrString method returns the errors from the last |
29
|
|
|
|
|
|
|
string processed. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 String::Validator Methods and Usage |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Provides and conforms to all of the standard String::Validator methods, please see |
34
|
|
|
|
|
|
|
String::Validator for general documentation. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 Methods Specific to String::Validator::Password |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head2 Parameters to New |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head3 Require or Deny Classes of Character |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
SVP knows about four classes of character -- B (Upper Case), B (Lower Case), |
43
|
|
|
|
|
|
|
B (Digits), and B (Everything Else). Types can be required or denied. |
44
|
|
|
|
|
|
|
Thus these 8 arguments |
45
|
|
|
|
|
|
|
B, B, B, B, B, |
46
|
|
|
|
|
|
|
B, B, B, all of which take a numeric argument, and all of |
47
|
|
|
|
|
|
|
which default to 0 if omitted. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
When requiring and denying classes of characters the values of 0 and 1 work as expected, |
50
|
|
|
|
|
|
|
where 0 means not to check this condition at all and 1 means to accept or reject based on |
51
|
|
|
|
|
|
|
the presence of just 1 instance of the type. However, when used to set an amount, require |
52
|
|
|
|
|
|
|
is interpreted as require at least X of this type, while deny is deny if X or more |
53
|
|
|
|
|
|
|
are encountered. require_lc => 2 will result in a string with 2 or more lowercase characters |
54
|
|
|
|
|
|
|
passing the test. deny_lc => 2 will result in a string with 2 lowercase characters being |
55
|
|
|
|
|
|
|
rejected, but would pass a string with 1 lowercase character. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head3 Minimum number of Classes of Character |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
B is used to specify the number of different character types required, |
60
|
|
|
|
|
|
|
default is 2. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head3 Minimum and Maximum Length |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
B and B determine the respective minimum and maximum length |
65
|
|
|
|
|
|
|
password to accept. Defaults are 6 and 64. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 Examples |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
To create a new instance, with all of the default values: |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $Validator = String::Validator::Password->new() ; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Specify all of the default values: |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $Validator = String::Validator::Password->new( |
76
|
|
|
|
|
|
|
require_lc => 0, |
77
|
|
|
|
|
|
|
require_uc => 0, |
78
|
|
|
|
|
|
|
require_punct => 0, |
79
|
|
|
|
|
|
|
require_num => 0, |
80
|
|
|
|
|
|
|
deny_lc => 0, |
81
|
|
|
|
|
|
|
deny_uc => 0, |
82
|
|
|
|
|
|
|
deny_punct => 0, |
83
|
|
|
|
|
|
|
deny_num => 0, |
84
|
|
|
|
|
|
|
min_types => 2, |
85
|
|
|
|
|
|
|
min_len => 6, |
86
|
|
|
|
|
|
|
max_len => 64, |
87
|
|
|
|
|
|
|
) ; |
88
|
|
|
|
|
|
|
) ; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Normally you would only specify values that were not the default. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $Validator = String::Validator::Password->new( |
93
|
|
|
|
|
|
|
require_lc => 2, |
94
|
|
|
|
|
|
|
require_uc => 2, |
95
|
|
|
|
|
|
|
min_types => 3, |
96
|
|
|
|
|
|
|
min_len => 8, |
97
|
|
|
|
|
|
|
max_len => 18, |
98
|
|
|
|
|
|
|
) ; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Then to check a password you might write something like this: |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
if( $Validator->IsNot_Valid( $password1, $passwordconfirm ) ) { |
103
|
|
|
|
|
|
|
die $Validator->errstr() ; } |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub new { |
108
|
23
|
|
|
23
|
1
|
7096
|
my $class = shift ; |
109
|
23
|
|
|
|
|
103
|
my $self = { @_ } ; |
110
|
11
|
|
|
11
|
|
90
|
use base ( 'String::Validator::Common' ) ; |
|
11
|
|
|
|
|
25
|
|
|
11
|
|
|
|
|
9067
|
|
111
|
23
|
100
|
|
|
|
115
|
unless ( defined $self->{ require_lc } ) { $self->{ require_lc } = 0 }; |
|
21
|
|
|
|
|
70
|
|
112
|
23
|
100
|
|
|
|
93
|
unless ( defined $self->{ require_uc } ) { $self->{ require_uc } = 0 }; |
|
21
|
|
|
|
|
74
|
|
113
|
23
|
50
|
|
|
|
105
|
unless ( defined $self->{ require_nums } ) { $self->{ require_nums } = 0 }; |
|
23
|
|
|
|
|
139
|
|
114
|
23
|
100
|
|
|
|
87
|
unless ( defined $self->{ require_punct } ) { $self->{ require_punct } = 0 }; |
|
21
|
|
|
|
|
56
|
|
115
|
23
|
100
|
|
|
|
92
|
unless ( defined $self->{ deny_punct } ) { $self->{ deny_punct } = 0 }; |
|
21
|
|
|
|
|
50
|
|
116
|
23
|
100
|
|
|
|
107
|
unless ( defined $self->{ deny_lc } ) { $self->{ deny_lc } = 0 }; |
|
21
|
|
|
|
|
146
|
|
117
|
23
|
100
|
|
|
|
85
|
unless ( defined $self->{ deny_uc } ) { $self->{ deny_uc } = 0 }; |
|
22
|
|
|
|
|
57
|
|
118
|
23
|
50
|
|
|
|
95
|
unless ( defined $self->{ deny_nums } ) { $self->{ deny_nums } = 0 }; |
|
23
|
|
|
|
|
58
|
|
119
|
23
|
100
|
|
|
|
77
|
unless ( defined $self->{ min_types } ) { $self->{ min_types } = 2 }; |
|
7
|
|
|
|
|
22
|
|
120
|
23
|
100
|
|
|
|
72
|
unless ( defined $self->{ min_len } ) { $self->{ min_len } = 6 }; |
|
13
|
|
|
|
|
117
|
|
121
|
23
|
100
|
|
|
|
82
|
unless ( defined $self->{ max_len } ) { $self->{ max_len } = 64 }; |
|
20
|
|
|
|
|
44
|
|
122
|
|
|
|
|
|
|
# Not implemented right now. |
123
|
|
|
|
|
|
|
# unless ( defined $self->{ dictionary } ) { $self->{ dictionary } = [ 'default' ] } |
124
|
|
|
|
|
|
|
# unless ( defined $self->{ custom_allow } ) { $self->{ custom_allow } = 0 } |
125
|
|
|
|
|
|
|
# unless ( defined $self->{ custom_deny } ) { $self->{ custom_deny } = 0 } |
126
|
23
|
|
|
|
|
52
|
$self->{ string } = '' ; |
127
|
23
|
|
|
|
|
51
|
$self->{ error } = 0 ; |
128
|
23
|
|
|
|
|
52
|
$self->{errstring} = '' ; |
129
|
23
|
|
|
|
|
67
|
bless $self, $class ; |
130
|
23
|
|
|
|
|
83
|
return $self ; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Does all the checks and returns the |
134
|
|
|
|
|
|
|
# number of errors found. Used by the |
135
|
|
|
|
|
|
|
# Is/IsNot_Valid. May be invoked directly. |
136
|
|
|
|
|
|
|
sub Check{ |
137
|
106
|
|
|
106
|
1
|
13810
|
my ( $self, $string1, $string2 ) = @_ ; |
138
|
106
|
50
|
|
|
|
409
|
if ( $self->CheckCommon( $string1, $string2 ) == 99 ) { |
139
|
0
|
|
|
|
|
0
|
return $self->{ error } } |
140
|
|
|
|
|
|
|
# The match operator cannot be directly used to count matches. |
141
|
|
|
|
|
|
|
# substitution does count replacements, and by removing all other |
142
|
|
|
|
|
|
|
# other character classes what is left over is "punct". |
143
|
106
|
|
|
|
|
3286
|
$string2 = $string1 ; # make sure string is in string2. |
144
|
106
|
|
100
|
|
|
1324
|
$self->{num_lc} = $string2 =~ s/[a-z]//g || 0; |
145
|
106
|
|
100
|
|
|
655
|
$self->{num_uc} = $string2 =~ s/[A-Z]//g || 0 ; |
146
|
106
|
|
100
|
|
|
706
|
$self->{num_num} = $string2 =~ s/\d//g || 0; |
147
|
106
|
|
|
|
|
241
|
$self->{num_punct} = length $string2; #What is left is punct. |
148
|
106
|
|
|
|
|
191
|
$self->{ types_found } = 0; |
149
|
106
|
|
|
|
|
216
|
for ( qw / num_lc num_uc num_num num_punct / ) { |
150
|
424
|
100
|
|
|
|
1217
|
if ( $self->{ $_ } ) { $self->{ types_found }++ } } |
|
269
|
|
|
|
|
563
|
|
151
|
106
|
100
|
|
|
|
347
|
if ( $self->{types_found} < $self->{ min_types } ) { |
152
|
8
|
|
|
|
|
765
|
$self->IncreaseErr( |
153
|
|
|
|
|
|
|
"$self->{types_found} types were found, $self->{min_types} required.") ; } |
154
|
106
|
|
|
|
|
298
|
foreach my $type ( qw /lc num uc punct/ ) { |
155
|
424
|
|
|
|
|
1047
|
my $required = 'require_' . $type ; |
156
|
424
|
|
|
|
|
738
|
my $denied = 'deny_' . $type ; |
157
|
424
|
|
|
|
|
548
|
my $num = 'num_' . $type ; |
158
|
424
|
100
|
|
|
|
1121
|
unless ( $self->{ $required } <= $self->{ $num } ) { |
159
|
19
|
|
|
|
|
95
|
$self->IncreaseErr( |
160
|
|
|
|
|
|
|
"At least $self->{ $required } of $type is required.") } |
161
|
|
|
|
|
|
|
# If denied is 0, all strings are >= 0 not just those where |
162
|
|
|
|
|
|
|
# type is present. So don't check if denied is false (0). |
163
|
424
|
100
|
|
|
|
1988
|
if ( $self->{ $denied } == 1 ) { |
|
|
100
|
|
|
|
|
|
164
|
16
|
100
|
|
|
|
48
|
if ( $self->{ $num } ) |
165
|
8
|
|
|
|
|
34
|
{ $self->IncreaseErr( "$type is prohibited.") } } |
166
|
|
|
|
|
|
|
elsif ( $self->{ $denied } > 1 ) { |
167
|
8
|
100
|
|
|
|
37
|
if ( $self->{ $denied } <= $self->{ $num } ) { |
168
|
4
|
|
|
|
|
30
|
$self->IncreaseErr( "$type is limited to fewer than " . $self->{ $denied } ) |
169
|
|
|
|
|
|
|
} } |
170
|
|
|
|
|
|
|
} #foreach ( lc num uc punct ). |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# if ( length($string1) < $self->{min_len} ) { |
173
|
|
|
|
|
|
|
# $self->IncreaseErr( "Password Length of " . length( $string1 ) . |
174
|
|
|
|
|
|
|
# " Does not meet requirement: Min Length " . $self->{min_len} . "." ) ; |
175
|
|
|
|
|
|
|
# } |
176
|
|
|
|
|
|
|
# if ( length($string1) > $self->{max_len} ) { |
177
|
|
|
|
|
|
|
# $self->IncreaseErr( "Password Length of " . length( $string1 ) . |
178
|
|
|
|
|
|
|
# " Does not meet requirement: Max Length " . $self->{max_len} . "." ) ; |
179
|
|
|
|
|
|
|
# } |
180
|
106
|
|
|
|
|
1607
|
return $self->{ error } ; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 TO DO |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Provide support for custom regexes, custom allow/deny lists, and checking against weak |
186
|
|
|
|
|
|
|
password dictionaries. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 AUTHOR |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
John Karr, C<< >> |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 BUGS |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
195
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
196
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 SUPPORT |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
perldoc Validator |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
You can also look for information at: |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=over 4 |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
L |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
L |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item * CPAN Ratings |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
L |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=item * Search CPAN |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
L |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=back |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Copyright 2012 John Karr. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
236
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
237
|
|
|
|
|
|
|
the Free Software Foundation; version 3 or at your option |
238
|
|
|
|
|
|
|
any later version. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
241
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
242
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
243
|
|
|
|
|
|
|
GNU General Public License for more details. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
A copy of the GNU General Public License is available in the source tree; |
246
|
|
|
|
|
|
|
if not, write to the Free Software Foundation, Inc., |
247
|
|
|
|
|
|
|
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=cut |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
1; # End of Validator |