line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Password::BasicCheck; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
28215
|
use 5.006; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
39
|
|
4
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
60
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '2.03'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Object parameters |
10
|
1
|
|
|
1
|
|
5
|
use constant MIN => 0 ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
264
|
|
11
|
1
|
|
|
1
|
|
6
|
use constant MAX => 1 ; |
|
1
|
|
|
|
|
16
|
|
|
1
|
|
|
|
|
43
|
|
12
|
1
|
|
|
1
|
|
5
|
use constant SYM => 2 ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Return values |
15
|
1
|
|
|
1
|
|
5
|
use constant OK => 0 ; # password ok |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
68
|
|
16
|
1
|
|
|
1
|
|
5
|
use constant SHORT => 1 ; # password is too short |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
17
|
1
|
|
|
1
|
|
4
|
use constant LONG => 2 ; # password is too long |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
18
|
1
|
|
|
1
|
|
4
|
use constant A1SYM => 3 ; # password must contain alphas, digits and symbols |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
19
|
1
|
|
|
1
|
|
11
|
use constant NOSYM => 4 ; # not enough different symbols in password |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
20
|
1
|
|
|
1
|
|
5
|
use constant ROT => 5 ; # password matches itself after some rotation |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
36
|
|
21
|
1
|
|
|
1
|
|
5
|
use constant PINFO => 6 ; # password matches personal information |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
80
|
|
22
|
1
|
|
|
1
|
|
12
|
use constant WEAK => 127 ; # password too weak (generic) |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Other constants |
26
|
1
|
|
|
1
|
|
5
|
use constant DEBUG => 0 ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
89
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub new { |
29
|
3
|
|
|
3
|
1
|
1342
|
my $class = shift ; |
30
|
|
|
|
|
|
|
|
31
|
3
|
50
|
|
|
|
13
|
die "Not an object method" if ref $class ; |
32
|
3
|
|
|
|
|
8
|
my ($minlen,$maxlen,$psym) = @_ ; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Avoid bothering about uninitialized values... |
35
|
1
|
|
|
1
|
|
5
|
no warnings ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1361
|
|
36
|
3
|
50
|
33
|
|
|
35
|
return undef unless $minlen =~ /^\d+$/ and $minlen >= 0 ; |
37
|
3
|
50
|
33
|
|
|
88
|
return undef unless $maxlen =~ /^\d+$/ and $maxlen >= $minlen ; |
38
|
3
|
100
|
|
|
|
14
|
$psym = 2/3 unless $psym > 0 ; |
39
|
|
|
|
|
|
|
|
40
|
3
|
|
|
|
|
22
|
return bless [$minlen,$maxlen,$psym],$class ; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
0
|
1
|
0
|
sub minlen { return $_[0]->[MIN] } |
44
|
0
|
|
|
0
|
1
|
0
|
sub maxlen { return $_[0]->[MAX] } |
45
|
0
|
|
|
0
|
1
|
0
|
sub psym { return $_[0]->[SYM] } |
46
|
81
|
|
|
81
|
|
83
|
sub _parms { return @{$_[0]} } |
|
81
|
|
|
|
|
223
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub check { |
49
|
18
|
|
|
18
|
1
|
10729
|
my $self = shift ; |
50
|
18
|
|
|
|
|
57
|
my ($password,@userinfo) = @_ ; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
die "Not a class method!" |
53
|
18
|
50
|
33
|
|
|
62
|
unless ref $self and eval { $self->isa('Data::Password::BasicCheck') } ; |
|
18
|
|
|
|
|
123
|
|
54
|
|
|
|
|
|
|
|
55
|
18
|
|
|
|
|
44
|
my ($minlen,$maxlen,$psym) = $self->_parms ; |
56
|
18
|
|
|
|
|
37
|
my $plen = length $password ; |
57
|
|
|
|
|
|
|
# Check length |
58
|
|
|
|
|
|
|
{ |
59
|
18
|
100
|
|
|
|
18
|
return SHORT if $plen < $minlen ; |
|
18
|
|
|
|
|
41
|
|
60
|
17
|
100
|
|
|
|
38
|
return LONG if $plen > $maxlen ; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
16
|
|
|
|
|
36
|
my $result = $self->_docheck(@_) ; |
64
|
16
|
100
|
|
|
|
47
|
return $result if $result eq OK ; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Try shorter segments... |
67
|
15
|
|
|
|
|
19
|
my $segments = $plen - $minlen ; |
68
|
15
|
50
|
|
|
|
37
|
return $result unless $segments > 1 ; |
69
|
15
|
|
|
|
|
36
|
foreach (my $i = 0 ; $i <= $segments; $i++) { |
70
|
47
|
|
|
|
|
71
|
my $segment = substr $password,$i,$minlen ; |
71
|
47
|
|
|
|
|
45
|
print STDERR "DEBUG: Trying $segment\n" if DEBUG ; |
72
|
47
|
|
|
|
|
132
|
$result = $self->_docheck($segment,@userinfo) ; |
73
|
47
|
100
|
|
|
|
164
|
return $result if $result eq OK ; |
74
|
|
|
|
|
|
|
} |
75
|
12
|
|
|
|
|
38
|
return WEAK ; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub _docheck { |
79
|
63
|
|
|
63
|
|
152
|
my ($self,$password,@userinfo) = @_ ; |
80
|
|
|
|
|
|
|
|
81
|
63
|
|
|
|
|
135
|
my ($minlen,$maxlen,$psym) = $self->_parms ; |
82
|
63
|
|
|
|
|
94
|
my $plen = length $password ; |
83
|
|
|
|
|
|
|
# Password contains alphas, digits and non-alpha-digits |
84
|
|
|
|
|
|
|
{ |
85
|
63
|
|
|
|
|
65
|
local $_ = $password ; |
|
63
|
|
|
|
|
86
|
|
86
|
63
|
100
|
100
|
|
|
685
|
return A1SYM |
|
|
|
100
|
|
|
|
|
87
|
|
|
|
|
|
|
unless /[a-z]/i and /\d/ and /[^a-z0-9]/i ; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Check unique characters |
91
|
|
|
|
|
|
|
{ |
92
|
22
|
|
|
|
|
165
|
my @chars = split //,$password ; |
|
22
|
|
|
|
|
93
|
|
93
|
22
|
|
|
|
|
30
|
my %unique ; |
94
|
22
|
|
|
|
|
34
|
foreach my $char (@chars) { |
95
|
137
|
|
|
|
|
480
|
$unique{$char}++; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
; |
98
|
22
|
100
|
|
|
|
148
|
return NOSYM |
99
|
|
|
|
|
|
|
unless scalar keys %unique >= sprintf "%.0f",$psym * $plen ; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# rotations of the password don't match it |
103
|
|
|
|
|
|
|
{ |
104
|
20
|
|
|
|
|
22
|
foreach my $rot (_rotations($password)) { |
|
20
|
|
|
|
|
40
|
|
105
|
101
|
50
|
|
|
|
205
|
return ROT |
106
|
|
|
|
|
|
|
if $rot eq $password ; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Check password against user data.Some of user data could be |
111
|
|
|
|
|
|
|
# composed, like "Alan Louis", or "Di Cioccio" or |
112
|
|
|
|
|
|
|
# "Los Angeles", so we have to treat each chunk separately. But we |
113
|
|
|
|
|
|
|
# should also check for passwords like "alanlouis", or "dicioccio" |
114
|
|
|
|
|
|
|
# or "losangeles". So we must add them, too. |
115
|
|
|
|
|
|
|
{ |
116
|
|
|
|
|
|
|
# Prepare password rotations; check reverse password and reverse |
117
|
|
|
|
|
|
|
# password rotations, too |
118
|
20
|
|
|
|
|
32
|
my $pclean = lc $password ; |
|
20
|
|
|
|
|
585
|
|
119
|
20
|
|
|
|
|
94
|
$pclean =~ s/[^a-z]//g ; |
120
|
20
|
|
|
|
|
35
|
my $rpclean = reverse $pclean ; |
121
|
20
|
|
|
|
|
39
|
my @prots = ($pclean, _rotations($pclean), |
122
|
|
|
|
|
|
|
$rpclean,_rotations($rpclean)) ; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Prepare personal information to match @prots against |
125
|
20
|
|
|
|
|
129
|
@userinfo = map lc,@userinfo ; |
126
|
20
|
|
|
|
|
103
|
my @chunks = split(/\s+/,join(" ",@userinfo)) ; |
127
|
20
|
|
|
|
|
39
|
foreach (@userinfo) { |
128
|
80
|
100
|
|
|
|
198
|
if (/\s/) { |
129
|
20
|
|
|
|
|
126
|
s/\s// ; |
130
|
20
|
|
|
|
|
58
|
push @chunks,$_ ; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
20
|
|
|
|
|
28
|
my $idx ; |
135
|
20
|
|
|
|
|
26
|
foreach my $chunk (@chunks) { |
136
|
61
|
|
|
|
|
87
|
my $chunklen = length $chunk ; |
137
|
61
|
|
|
|
|
69
|
foreach my $rot (@prots) { |
138
|
374
|
|
|
|
|
554
|
my $cutrot = substr $rot,0,$minlen ; |
139
|
374
|
100
|
|
|
|
613
|
$idx = $chunklen >= $minlen? |
140
|
|
|
|
|
|
|
index $chunk,$cutrot: |
141
|
|
|
|
|
|
|
index $cutrot,$chunk; |
142
|
374
|
100
|
|
|
|
1066
|
unless ($idx == -1) { |
143
|
16
|
|
|
|
|
78
|
return PINFO ; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
4
|
|
|
|
|
13
|
return OK ; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub _rotations { |
154
|
60
|
|
|
60
|
|
80
|
my $string = shift ; |
155
|
60
|
|
|
|
|
69
|
my $n = length $string ; |
156
|
60
|
|
|
|
|
55
|
my @result ; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# note: $i < $n, since the n-th permutation is the password again |
159
|
60
|
|
|
|
|
134
|
for (my $i = 1 ; $i < $n ; $i++) { |
160
|
215
|
|
|
|
|
340
|
$string = chop($string).$string ; |
161
|
215
|
|
|
|
|
528
|
push @result,$string ; |
162
|
|
|
|
|
|
|
} |
163
|
60
|
|
|
|
|
408
|
return @result ; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
1; |
167
|
|
|
|
|
|
|
__END__ |