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   31460 use strict;
  2         5  
  2         92  
9             require Exporter;
10 2         1568 use vars qw($DICTIONARY $FOLLOWING $GROUPS $MINLEN $MAXLEN $SKIPCHAR
11             $FOLLOWING_KEYBOARD @DICTIONARIES
12 2     2   8 $VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
  2         3  
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.11';
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 16 foreach my $sym (@DICTIONARIES) {
34 12 50       167 return $sym if -r $sym;
35             }
36 0         0 return;
37             }
38              
39             sub CheckDict {
40 12 50   12 0 15 return unless $DICTIONARY;
41 12         12 my $pass = shift;
42 12         17 my $dict = OpenDictionary();
43 12 50       21 return unless $dict;
44 12 50       235 open (DICT,"$dict") || return;
45 12         24 $pass = lc($pass);
46              
47 12         119 while (my $dict_line = ) {
48 22         26 chomp ($dict_line);
49 22 50       35 next if length($dict_line) < $DICTIONARY;
50 22         36 $dict_line = lc($dict_line);
51 22 100       81 if (index($pass,$dict_line)>-1) {
52 2         13 close(DICT);
53 2         6 return $dict_line;
54             }
55             }
56 10         54 close(DICT);
57 10         17 return;
58             }
59              
60             sub CheckSort {
61 18 50   18 0 33 return unless $FOLLOWING;
62 18         19 my $pass = shift;
63 18         24 foreach (1 .. 2) {
64 32         92 my @letters = split(//, $pass);
65 32         29 my $diffs;
66 32         33 my $last = shift @letters;
67 32         34 foreach (@letters) {
68 198         240 $diffs .= chr((ord($_) - ord($last) + 256 + 65) % 256);
69 198         169 $last = $_;
70             }
71 32         32 my $len = $FOLLOWING - 1;
72 32 100       172 return 1 if $diffs =~ /([\@AB])\1{$len}/;
73 26 50       36 return unless $FOLLOWING_KEYBOARD;
74              
75 26         22 my $mask = $pass;
76 26         28 $pass =~ tr/A-Z/a-z/;
77 26         36 $mask ^= $pass;
78 26         17 $pass =~ tr/qwertyuiopasdfghjklzxcvbnm/abcdefghijKLMNOPQRStuvwxyz/;
79 26         65 $pass ^= $mask;
80             }
81 12         27 return;
82             }
83              
84             sub CheckTypes {
85 22 50   22 0 39 return undef unless $GROUPS;
86 22         20 my $pass = shift;
87 22         43 my @groups = qw(a-z A-Z 0-9 ^A-Za-z0-9);
88 22         18 my $count;
89 22         27 foreach (@groups) {
90 88 100       764 $count++ if $pass =~ /[$_]/;
91             }
92 22         60 $count < $GROUPS;
93             }
94              
95             sub CheckCharset {
96 23     23 0 21 my $pass = shift;
97 23 100       34 return 0 if $SKIPCHAR;
98 22         65 $pass =~ /[\0-\x1F\x7F]/;
99             }
100              
101             sub CheckLength {
102 25     25 0 24 my $pass = shift;
103 25         26 my $len = length($pass);
104 25 50 33     108 return 1 if ($MINLEN && $len < $MINLEN);
105 25 100 100     94 return 1 if ($MAXLEN && $len > $MAXLEN);
106 23         41 return;
107             }
108              
109             sub IsBadPassword {
110 25     25 0 5732 my $pass = shift;
111 25 100       55 if (CheckLength($pass)) {
112 2 50 33     16 if ($MAXLEN && $MINLEN) {
    0          
113 2         9 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       29 return "contains bad characters" if CheckCharset($pass);
119 22 100       40 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         19 my $dict = CheckDict($pass);
124 12 100       478 return "contains the dictionary word '$dict'" if $dict;
125 10         18 return;
126             }
127              
128             sub IsBadPasswordForUNIX {
129 11     11 0 5241 my ($user, $pass) = @_;
130 11         19 my $reason = IsBadPassword($pass);
131 11 100       23 return $reason if $reason;
132 4         4 my $tuser = $user;
133 4         8 $tuser =~ s/[^a-zA-Z]//g;
134 4 50       23 return "is based on the username" if ($pass =~ /$tuser/i);
135              
136 4         191 my ($name,$passwd,$uid,$gid,
137             $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
138 4 50       21 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__