File Coverage

blib/lib/Data/Password/passwdqc.pm
Criterion Covered Total %
statement 28 28 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 37 37 100.0


line stmt bran cond sub pod time code
1             package Data::Password::passwdqc;
2              
3 6     6   111238 use strict;
  6         11  
  6         269  
4 6     6   32 use warnings;
  6         9  
  6         212  
5              
6 6     6   3666 use POSIX qw(INT_MAX);
  6         36439  
  6         40  
7 6     6   11063 use List::MoreUtils qw(none);
  6         66123  
  6         55  
8 6     6   3618 use Carp qw(croak);
  6         11  
  6         378  
9 6     6   4021 use Moose;
  6         2484231  
  6         50  
10 6     6   38980 use Moose::Util::TypeConstraints;
  6         15  
  6         61  
11 6     6   14613 use namespace::autoclean;
  6         7932  
  6         43  
12              
13             our $VERSION = '0.07';
14              
15             require XSLoader;
16             XSLoader::load('Data::Password::passwdqc', $VERSION);
17              
18              
19             subtype 'Data::Password::passwdqc::ArrayRefOfInts',
20             as 'ArrayRef[Int]',
21             where {
22             my @min = @{ $_ };
23             @min == 5 && none(sub { $_ > INT_MAX }, @min) && none (sub { $_ && $min[$_] > $min[$_ - 1] }, 0 .. $#min);
24             };
25              
26             coerce 'Data::Password::passwdqc::ArrayRefOfInts',
27             from 'ArrayRef[Int|Undef]',
28             via { [ map { defined() ? $_ : INT_MAX } @{ $_ } ] };
29              
30             enum 'Data::Password::passwdqc::OneOrZero', [ 1, 0 ];
31              
32             coerce 'Data::Password::passwdqc::OneOrZero',
33             from 'Bool',
34             via { $_ && 1 || 0 };
35              
36             has 'min' => (
37             is => 'rw',
38             isa => 'Data::Password::passwdqc::ArrayRefOfInts',
39             default => sub { [INT_MAX, 24, 11, 8, 7] },
40             trigger => sub { $_[0]->_clear_params },
41             coerce => 1,
42             );
43              
44             has 'max' => (
45             is => 'rw',
46             isa => subtype( 'Int' => where { $_ >= 8 && $_ <= INT_MAX } ),
47             default => 40,
48             trigger => sub { $_[0]->_clear_params },
49             );
50              
51             has 'passphrase_words' => (
52             is => 'rw',
53             isa => subtype( 'Int' => where { $_ <= INT_MAX } ),
54             default => 3,
55             trigger => sub { $_[0]->_clear_params },
56             );
57              
58             has 'match_length' => (
59             is => 'rw',
60             isa => subtype( 'Int' => where { $_ <= INT_MAX } ),
61             default => 4,
62             trigger => sub { $_[0]->_clear_params },
63             );
64              
65             has 'similar_deny' => (
66             is => 'rw',
67             isa => 'Data::Password::passwdqc::OneOrZero',
68             default => 1,
69             trigger => sub { $_[0]->_clear_params },
70             coerce => 1,
71             );
72              
73             has 'random_bits' => (
74             is => 'rw',
75             isa => subtype( 'Int' => where { $_ == 0 || $_ >= 24 && $_ <= 85 } ),
76             default => 47,
77             trigger => sub { $_[0]->_clear_params },
78             );
79              
80             has '_params' => (
81             is => 'rw',
82             clearer => '_clear_params',
83             lazy => 1,
84             builder => '_build_params',
85             init_arg => undef,
86             );
87              
88             has 'reason' => (
89             is => 'rw',
90             clearer => '_clear_reason',
91             init_arg => undef,
92             );
93              
94              
95             sub _build_params {
96 3     3   8 my $self = shift;
97            
98 3         5 my $params = pack 'i*', @{ $self->min }, $self->max,
  3         99  
99             $self->passphrase_words, $self->match_length,
100             $self->similar_deny, $self->random_bits;
101 3         77 return $params;
102             }
103              
104              
105             sub validate_password {
106             my $self = shift;
107             my ($new_pass, $old_pass) = @_;
108              
109             my $reason;
110             if (@_ > 1) {
111             $reason = password_check($self->_params, $new_pass, $old_pass);
112             } else {
113             $reason = password_check($self->_params, $new_pass);
114             }
115              
116             if ($reason) {
117             $self->reason($reason);
118             return !1;
119             }
120              
121             return !0;
122             }
123              
124             sub generate_password {
125             my $self = shift;
126              
127             my $pass = password_generate($self->_params);
128             croak 'Failed to generate password' unless defined $pass;
129              
130             return $pass;
131             }
132              
133             before [ qw(validate_password generate_password) ] => sub { $_[0]->_clear_reason };
134              
135             __PACKAGE__->meta->make_immutable;
136              
137             1;
138              
139             __END__
140              
141             =head1 NAME
142              
143             Data::Password::passwdqc - Check password strength and generate password using passwdqc
144              
145             =head1 SYNOPSIS
146              
147             use Data::Password::passwdqc;
148              
149             my $pwdqc = Data::Password::passwdqc->new;
150             print 'OK' if $pwdqc->validate_password('arrive+greece7glove');
151              
152             my $is_valid = $pwdqc->validate_password('new password', '0ld+pas$w0rd');
153             print 'Bad password: ' . $pwdqc->reason if not $is_valid;
154              
155             my $password = $pwdqc->generate_password;
156              
157             =head1 DESCRIPTION
158              
159             Data::Password::passwdqc provides an object oriented Perl interface to
160             Openwall Project's passwdqc. It allows you to check password strength
161             and also lets you generate quality controllable random password.
162              
163             =head1 ATTRIBUTES
164              
165             =over 4
166              
167             =item I<min [Int0, Int1, Int2, Int3, Int4]>
168              
169             Defaults to C<[undef, 24, 11, 8, 7]>.
170              
171             The minimum allowed password lengths for different kinds of passwords
172             and passphrases. C<undef> can be used to disallow passwords of a given
173             kind regardless of their length. Each subsequent number is required to
174             be no larger than the preceding one.
175              
176             Int0 is used for passwords consisting of characters from one character
177             class only. The character classes are: digits, lower-case letters,
178             upper-case letters, and other characters. There is also a special class
179             for non-ASCII characters, which could not be classified, but are assumed
180             to be non-digits.
181              
182             Int1 is used for passwords consisting of characters from two character
183             classes that do not meet the requirements for a passphrase.
184              
185             Int2 is used for passphrases. Note that besides meeting this length
186             requirement, a passphrase must also consist of a sufficient number of
187             words (see the C<passphrase_words> option below).
188              
189             Int3 and Int4 are used for passwords consisting of characters from three
190             and four character classes, respectively.
191              
192             When calculating the number of character classes, upper-case letters
193             used as the first character and digits used as the last character of a
194             password are not counted.
195              
196             In addition to being sufficiently long, passwords are required to contain
197             enough different characters for the character classes and the minimum
198             length they have been checked against.
199              
200             =item I<max Int>
201              
202             Defaults to 40.
203              
204             The maximum allowed password length. This can be used to prevent users
205             from setting passwords that may be too long for some system services.
206              
207             The value 8 is treated specially: with C<max=8>, passwords longer than 8
208             characters will not be rejected, but will be truncated to 8 characters for
209             the strength checks and the user will be warned. This is to be used with
210             the traditional DES-based password hashes, which truncate the password
211             at 8 characters.
212              
213             It is important that you do set C<max=8> if you are using the traditional
214             hashes, or some weak passwords will pass the checks.
215              
216             =item I<passphrase_words Int>
217              
218             Defaults to 3.
219              
220             The number of words required for a passphrase, or 0 to disable the
221             support for user-chosen passphrases.
222              
223             =item I<match_length Int>
224              
225             Defaults to 4.
226              
227             The length of common substring required to conclude that a password is at
228             least partially based on information found in a character string, or 0 to
229             disable the substring search. Note that the password will not be rejected
230             once a weak substring is found; it will instead be subjected to the
231             usual strength requirements with the weak substring partially discounted.
232              
233             The substring search is case-insensitive and is able to detect and remove
234             a common substring spelled backwards.
235              
236             =item I<random_bits Int>
237              
238             Defaults to 47.
239              
240             The size of randomly-generated passphrases in bits (24 to 85), or 0 to
241             disable this feature.
242              
243             =back
244              
245             =head1 METHODS
246              
247             =over 4
248              
249             =item B<validate_password>
250              
251             $is_valid = $pwdqc->validate_password('new password');
252             $is_valid = $pwdqc->validate_password('new password', 'old password');
253             print $pwdqc->reason if not $is_valid;
254              
255             Checks passphrase quality. Returns a true value on success. If the check
256             fails, it returns a false value and sets C<reason>.
257              
258             =item B<generate_password>
259              
260             my $password = $pwdqc->generate_password;
261              
262             Generates a random passphrase. Throws an exception if passphrase cannot
263             be generated.
264              
265             =back
266              
267             =head1 AUTHORS
268              
269             Sherwin Daganato E<lt>sherwin@daganato.comE<gt>
270              
271             The copy of passwdqc bundled with this module was written by Solar Designer and Dmitry V. Levin.
272              
273             =head1 LICENSE
274              
275             This library is free software; you can redistribute it and/or modify
276             it under the same terms as Perl itself.
277              
278             =head1 SEE ALSO
279              
280             L<http://www.openwall.com/passwdqc/>
281              
282             =cut