1package 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
8use strict;
9require Exporter;
10use vars qw($DICTIONARY $FOLLOWING $GROUPS $MINLEN $MAXLEN $SKIPCHAR
11		$FOLLOWING_KEYBOARD @DICTIONARIES $BADCHARS
12		$VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
13
14@EXPORT_OK = qw($DICTIONARY $FOLLOWING $GROUPS $FOLLOWING_KEYBOARD $SKIPCHAR $BADCHARS
15	@DICTIONARIES $MINLEN $MAXLEN IsBadPassword IsBadPasswordForUNIX);
16%EXPORT_TAGS = ('all' => [@EXPORT_OK]);
17@ISA = qw(Exporter);
18
19$VERSION = '1.12';
20
21# Settings
22$DICTIONARY = 5;
23$FOLLOWING = 3;
24$FOLLOWING_KEYBOARD = 1;
25$GROUPS = 2;
26
27$MINLEN = 6;
28$MAXLEN = 8;
29$SKIPCHAR = 0;
30$BADCHARS = '\0-\x1F\x7F';
31
32@DICTIONARIES = qw(/usr/dict/web2 /usr/dict/words /usr/share/dict/words /usr/share/dict/linux.words);
33
34sub OpenDictionary {
35	foreach my $sym (@DICTIONARIES) {
36		return $sym if -r $sym;
37	}
38	return;
39}
40
41sub CheckDict {
42	return unless $DICTIONARY;
43	my $pass = shift;
44	my $dict = OpenDictionary();
45	return unless $dict;
46	open (DICT,"$dict") || return;
47        $pass = lc($pass);
48
49	while (my $dict_line  = <DICT>) {
50		chomp ($dict_line);
51		next if length($dict_line) < $DICTIONARY;
52		$dict_line = lc($dict_line);
53		if (index($pass,$dict_line)>-1) {
54			close(DICT);
55			return $dict_line;
56		}
57	}
58	close(DICT);
59	return;
60}
61
62sub CheckSort {
63	return unless $FOLLOWING;
64	my $pass = shift;
65	foreach (1 .. 2) {
66		my @letters = split(//, $pass);
67		my $diffs;
68		my $last = shift @letters;
69		foreach (@letters) {
70			$diffs .= chr((ord($_) - ord($last) + 256 + 65) % 256);
71			$last = $_;
72		}
73		my $len = $FOLLOWING - 1;
74		return 1 if $diffs =~ /([\@AB])\1{$len}/;
75		return unless $FOLLOWING_KEYBOARD;
76
77		my $mask = $pass;
78		$pass =~ tr/A-Z/a-z/;
79		$mask ^= $pass;
80		$pass =~ tr/qwertyuiopasdfghjklzxcvbnm/abcdefghijKLMNOPQRStuvwxyz/;
81		$pass ^= $mask;
82	}
83	return;
84}
85
86sub CheckTypes {
87	return undef unless $GROUPS;
88	my $pass = shift;
89	my @groups = qw(a-z A-Z 0-9 ^A-Za-z0-9);
90	my $count;
91	foreach (@groups) {
92		$count++ if $pass =~ /[$_]/;
93	}
94	$count < $GROUPS;
95}
96
97sub CheckCharset {
98	my $pass = shift;
99        return 0 if $SKIPCHAR;
100	$pass =~ /[$BADCHARS]/;
101}
102
103sub CheckLength {
104	my $pass = shift;
105	my $len = length($pass);
106	return 1 if ($MINLEN && $len < $MINLEN);
107	return 1 if ($MAXLEN && $len > $MAXLEN);
108	return;
109}
110
111sub IsBadPassword {
112	my $pass = shift;
113	if (CheckLength($pass)) {
114    if ($MAXLEN && $MINLEN) {
115      return "Not between $MINLEN and $MAXLEN characters";
116    }
117    elsif (!$MAXLEN) { return "Not $MINLEN characters or greater"; }
118    else { return "Not less than or equal to $MAXLEN characters"; }
119  }
120  return "contains bad characters" if CheckCharset($pass);
121	return "contains less than $GROUPS character groups"
122		if CheckTypes($pass);
123	return "contains over $FOLLOWING leading characters in sequence"
124		if CheckSort($pass);
125	my $dict = CheckDict($pass);
126	return "contains the dictionary word '$dict'" if $dict;
127	return;
128}
129
130sub IsBadPasswordForUNIX {
131	my ($user, $pass) = @_;
132	my $reason = IsBadPassword($pass);
133	return $reason if $reason;
134	my $tuser = $user;
135	$tuser =~ s/[^a-zA-Z]//g;
136	return "is based on the username" if ($pass =~ /$tuser/i);
137
138	my ($name,$passwd,$uid,$gid,
139       		$quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);
140	return unless $comment;
141	foreach ($comment =~ /([A-Z]+)/ig) {
142		return "is based on the finger information" if ($pass =~ /$_/i);
143	}
144	return;
145}
146
1471;
148__END__
149
150=head1 NAME
151
152Data::Password - Perl extension for assessing password quality.
153
154=head1 SYNOPSIS
155
156	use Data::Password qw(IsBadPassword);
157
158	print IsBadPassword("clearant");
159
160	# Bad password - contains the word 'clear', only lowercase
161
162	use Data::Password qw(:all);
163
164	$DICTIONARY = 0;
165
166	$GROUPS = 0;
167
168        $SKIPCHAR = 0;
169
170	print IsBadPassword("clearant");
171
172=head1 DESCRIPTION
173
174This module checks potential passwords for crackability.
175It checks that the password is in the appropriate length,
176that it has enough character groups, that it does not contain the same
177characters repeatedly or ascending or descending characters, or charcters
178close to each other in the keyboard.
179It will also attempt to search the ispell word file for existance
180of whole words.
181The module's policies can be modified by changing its variables.  (Check L<"VARIABLES">).
182For doing it, it is recommended to import the ':all' shortcut
183when requiring it:
184
185I<use Data::Password qw(:all);>
186
187=head1 FUNCTIONS
188
189=over 4
190
191=item 1
192
193IsBadPassword(password)
194
195Returns undef if the password is ok, or a textual description of the fault if any.
196
197=item 2
198
199IsBadPasswordForUNIX(user, password)
200
201Performs two additional checks: compares the password against the
202login name and the "comment" (ie, real name) found on the user file.
203
204=back
205
206=head1 VARIABLES
207
208=over 4
209
210=item 1
211
212$DICTIONARY
213
214Minimal length for dictionary words that are not allowed to appear in the password. Set to false to disable dictionary check.
215
216=item 2
217
218$FOLLOWING
219
220Maximal length of characters in a row to allow if the same or following.
221If $FOLLOWING_KEYBOARD is true (default), the module will also check
222for alphabetical keys following, according to the English keyboard
223layout.
224Set $FOLLOWING to false to bypass this check.
225
226=item 3
227
228$GROUPS
229
230Groups of characters are lowercase letters, uppercase letters, digits
231and the rest of the allowed characters. Set $GROUPS to the number
232of minimal character groups a password is required to have.
233Setting to false or to 1 will bypass the check.
234
235=item 4
236
237$MINLEN
238
239$MAXLEN
240
241Minimum and maximum length of a password. Both can be set to false.
242
243=item 5
244
245@DICTIONARIES
246
247Location where we are looking for dictionary files. You may want to
248set this variable if you are using not *NIX like operating system.
249
250=item 6
251
252$SKIPCHAR
253
254Set $SKIPCHAR to 1 to skip checking for bad characters.
255
256=item 7
257
258$BADCHARS
259
260Prohibit a specific character range. Excluded character range
261regualr experssion is expect. (You may use ^ to allow specific range)
262Default value is: '\0-\x1F\x7F'
263For ASCII only set value $BADCHARS = '^\x20-\x7F';
264Force numbers and upper case only $BADCHARS = '^A-Z1-9';
265
266=back
267
268=head1 FILES
269
270=over 4
271
272=item *
273
274/usr/dict/web2
275
276=item *
277
278/usr/dict/words
279
280=item *
281
282/etc/passwd
283
284=back
285
286=head1 SEE ALSO
287
288See L<Data::Password::BasicCheck> if you need only basic password checking.
289Other modules L<Data::Password::Common>, L<Data::Password::Check>,
290L<Data::Password::Meter>, L<Data::Password::Entropy>
291and L<String::Validator::Password>
292
293
294=head1 AUTHOR
295
296Ariel Brosh (RIP), January 2002.
297
298Oded S. Resnik, from April 2004.
299
300=head1 COPYRIGHT
301
302Copyright (c) 2001 - 2014  Raz Information Systems Ltd.
303L<http://www.raz.co.il/>
304
305This package is distributed under the same terms as Perl itself, see the
306Artistic License on Perl's home page.
307
308
309=cut
310