File Coverage

blib/lib/Data/Password.pm
Criterion Covered Total %
statement 74 80 92.5
branch 34 50 68.0
condition 5 9 55.5
subroutine 10 10 100.0
pod 0 8 0.0
total 123 157 78.3


line stmt bran cond sub pod time code
1             package Data::Password;
2              
3             # Ariel Brosh (RIP), January 2002, for Raz Information Systems
4             # Oded S. Resnik, 3 April 2004, for Raz Information Systems
5              
6              
7              
8 2     2   41598 use strict;
  2         4  
  2         87  
9             require Exporter;
10 2         2183 use vars qw($DICTIONARY $FOLLOWING $GROUPS $MINLEN $MAXLEN $SKIPCHAR
11             $FOLLOWING_KEYBOARD @DICTIONARIES
12 2     2   8 $VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
  2         4  
13              
14             @EXPORT_OK = qw($DICTIONARY $FOLLOWING $GROUPS $FOLLOWING_KEYBOARD $SKIPCHAR
15             @DICTIONARIES $MINLEN $MAXLEN IsBadPassword IsBadPasswordForUNIX);
16             %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
17             @ISA = qw(Exporter);
18              
19             $VERSION = '1.10';
20              
21             $DICTIONARY = 5;
22             $FOLLOWING = 3;
23             $FOLLOWING_KEYBOARD = 1;
24             $GROUPS = 2;
25              
26             $MINLEN = 6;
27             $MAXLEN = 8;
28             $SKIPCHAR = 0;
29              
30             @DICTIONARIES = qw(/usr/dict/web2 /usr/dict/words /usr/share/dict/words /usr/share/dict/linux.words);
31              
32             sub OpenDictionary {
33 12     12 0 22 foreach my $sym (@DICTIONARIES) {
34 12 50       226 return $sym if -r $sym;
35             }
36 0         0 return;
37             }
38              
39             sub CheckDict {
40 12 50   12 0 23 return unless $DICTIONARY;
41 12         14 my $pass = shift;
42 12         20 my $dict = OpenDictionary();
43 12 50       29 return unless $dict;
44 12 50       369 open (DICT,"$dict") || return;
45 12         28 $pass = lc($pass);
46              
47 12         187 while (my $dict_line = ) {
48 22         28 chomp ($dict_line);
49 22 50       51 next if length($dict_line) < $DICTIONARY;
50 22         53 $dict_line = lc($dict_line);
51 22 100       121 if (index($pass,$dict_line)>-1) {
52 2         26 close(DICT);
53 2         7 return $dict_line;
54             }
55             }
56 10         101 close(DICT);
57 10         19 return;
58             }
59              
60             sub CheckSort {
61 18 50   18 0 35 return unless $FOLLOWING;
62 18         23 my $pass = shift;
63 18         35 foreach (1 .. 2) {
64 32         116 my @letters = split(//, $pass);
65 32         42 my $diffs;
66 32         40 my $last = shift @letters;
67 32         45 foreach (@letters) {
68 198         275 $diffs .= chr((ord($_) - ord($last) + 256 + 65) % 256);
69 198         261 $last = $_;
70             }
71 32         47 my $len = $FOLLOWING - 1;
72 32 100       205 return 1 if $diffs =~ /([\@AB])\1{$len}/;
73 26 50       50 return unless $FOLLOWING_KEYBOARD;
74              
75 26         29 my $mask = $pass;
76 26         39 $pass =~ tr/A-Z/a-z/;
77 26         41 $mask ^= $pass;
78 26         30 $pass =~ tr/qwertyuiopasdfghjklzxcvbnm/abcdefghijKLMNOPQRStuvwxyz/;
79 26         87 $pass ^= $mask;
80             }
81 12         29 return;
82             }
83              
84             sub CheckTypes {
85 22 50   22 0 47 return undef unless $GROUPS;
86 22         30 my $pass = shift;
87 22         57 my @groups = qw(a-z A-Z 0-9 ^A-Za-z0-9);
88 22         24 my $count;
89 22         42 foreach (@groups) {
90 88 100       1025 $count++ if $pass =~ /[$_]/;
91             }
92 22         87 $count < $GROUPS;
93             }
94              
95             sub CheckCharset {
96 23     23 0 27 my $pass = shift;
97 23 100       45 return 0 if $SKIPCHAR;
98 22         103 $pass =~ /[\0-\x1F\x7F]/;
99             }
100              
101             sub CheckLength {
102 25     25 0 33 my $pass = shift;
103 25         32 my $len = length($pass);
104 25 50 33     125 return 1 if ($MINLEN && $len < $MINLEN);
105 25 100 100     103 return 1 if ($MAXLEN && $len > $MAXLEN);
106 23         75 return;
107             }
108              
109             sub IsBadPassword {
110 25     25 0 7028 my $pass = shift;
111 25 100       62 if (CheckLength($pass)) {
112 2 50 33     14 if ($MAXLEN && $MINLEN) {
    0          
113 2         10 return "Not between $MINLEN and $MAXLEN characters";
114             }
115 0         0 elsif (!$MAXLEN) { return "Not $MINLEN characters or greater"; }
116 0         0 else { return "Not less than or equal to $MAXLEN characters"; }
117             }
118 23 100       39 return "contains bad characters" if CheckCharset($pass);
119 22 100       54 return "contains less than $GROUPS character groups"
120             if CheckTypes($pass);
121 18 100       33 return "contains over $FOLLOWING leading characters in sequence"
122             if CheckSort($pass);
123 12         26 my $dict = CheckDict($pass);
124 12 100       561 return "contains the dictionary word '$dict'" if $dict;
125 10         20 return;
126             }
127              
128             sub IsBadPasswordForUNIX {
129 11     11 0 6127 my ($user, $pass) = @_;
130 11         23 my $reason = IsBadPassword($pass);
131 11 100       26 return $reason if $reason;
132 4         5 my $tuser = $user;
133 4         8 $tuser =~ s/[^a-zA-Z]//g;
134 4 50       19 return "is based on the username" if ($pass =~ /$tuser/i);
135              
136 4         257 my ($name,$passwd,$uid,$gid,
137             $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
138 4 50       19 return unless $comment;
139 0           foreach ($comment =~ /([A-Z]+)/ig) {
140 0 0         return "is based on the finger information" if ($pass =~ /$_/i);
141             }
142 0           return;
143             }
144              
145             1;
146             __END__