File Coverage

blib/lib/Digest/Bcrypt.pm
Criterion Covered Total %
statement 104 104 100.0
branch 38 42 90.4
condition 8 9 88.8
subroutine 20 20 100.0
pod 10 10 100.0
total 180 185 97.3


line stmt bran cond sub pod time code
1             package Digest::Bcrypt;
2 4     4   79369 use parent 'Digest::base';
  4         1310  
  4         24  
3              
4 4     4   248 use strict;
  4         8  
  4         73  
5 4     4   20 use warnings;
  4         5  
  4         119  
6             require bytes;
7              
8 4     4   19 use Carp ();
  4         8  
  4         71  
9 4     4   1892 use Crypt::Bcrypt qw(bcrypt bcrypt_check);
  4         9063  
  4         252  
10 4     4   32 use MIME::Base64 qw(decode_base64 encode_base64);
  4         7  
  4         157  
11 4     4   2937 use utf8;
  4         63  
  4         23  
12              
13             our $VERSION = '1.212';
14              
15             sub add {
16 22     22 1 4468 my $self = shift;
17 22         89 $self->{_buffer} .= join('', @_);
18 22         64 return $self;
19             }
20              
21             sub bcrypt_b64digest {
22 2     2 1 10 my $encoded = encode_base64(shift->digest, "");
23 2         9 $encoded =~ tr{A-Za-z0-9+/=}{./A-Za-z0-9}d;
24 2         15 return $encoded;
25             }
26              
27             sub clone {
28 2     2 1 5 my $self = shift;
29             return undef
30 2 50       4 unless my $clone = $self->new(
31             cost => $self->cost,
32             salt => $self->salt,
33             type => $self->type,
34             );
35 2         8 $clone->add($self->{_buffer});
36 2         4 return $clone;
37             }
38              
39             sub cost {
40 114     114 1 4480 my $self = shift;
41 114 100       415 return $self->{cost} unless @_;
42              
43 44         71 my $cost = shift;
44              
45             # allow and undefined value to clear it
46 44 100       109 unless (defined $cost) {
47 2         4 delete $self->{cost};
48 2         10 return $self;
49             }
50 42         124 $self->_check_cost($cost);
51              
52             # bcrypt requires 2 digit costs, it dies if it's a single digit.
53 41         235 $self->{cost} = sprintf("%02d", $cost);
54 41         81 return $self;
55             }
56              
57             sub digest {
58 16     16 1 47 my $self = shift;
59 16         58 $self->_check_cost;
60 15         49 $self->_check_salt;
61              
62 14 50       94 my $type = defined($self->{type}) ? $self->{type} : '2a';
63 14         41 my $hash = bcrypt($self->{_buffer}, $type, $self->cost, $self->salt);
64 12         50288 my $settings = $self->settings;
65 12         49 $self->reset;
66 12         76 return _de_base64(substr($hash, length($settings)));
67             }
68              
69             # new isn't actually implemented in the base class. eww.
70             sub new {
71 39     39 1 20545 my $class = shift;
72 39   66     208 my $self = bless {_buffer => '',}, ref $class || $class;
73 39 100       124 return $self unless @_;
74 28 100       78 my $params = @_ > 1 ? {@_} : {%{$_[0]}};
  16         86  
75 24 100       84 $self->cost($params->{cost}) if $params->{cost};
76 24 100       69 $self->salt($params->{salt}) if $params->{salt};
77 24 100       62 $self->settings($params->{settings}) if $params->{settings};
78 24 50       49 $self->type($params->{type}) if $params->{type};
79 24         94 return $self;
80             }
81              
82             sub reset {
83 22     22 1 10456 my $self = shift;
84 22         60 $self->{_buffer} = '';
85 22         55 delete $self->{cost};
86 22         40 delete $self->{salt};
87 22         42 delete $self->{type};
88 22         40 return $self;
89             }
90              
91             sub salt {
92 132     132 1 19127 my $self = shift;
93 132 100       568 return $self->{salt} unless @_;
94              
95 42         79 my $salt = shift;
96              
97             # allow and undefined value to clear it
98 42 100       96 unless (defined $salt) {
99 2         4 delete $self->{salt};
100 2         6 return $self;
101             }
102              
103             # all other values go through the check
104 40         131 $self->_check_salt($salt);
105 38         4435 $self->{salt} = $salt;
106 38         77 return $self;
107             }
108              
109             sub settings {
110 31     31 1 1534 my $self = shift;
111 31 100       146 unless (@_) {
112 20         172 my $cost = sprintf('%02d', $self->{cost});
113 20         67 my $salt_base64 = encode_base64($self->salt, "");
114 20         64 $salt_base64 =~ tr{A-Za-z0-9+/=}{./A-Za-z0-9}d;
115 20 100       76 my $type = defined($self->{type}) ? $self->{type} : '2a';
116 20         108 return "\$${type}\$${cost}\$${salt_base64}";
117             }
118 11         22 my $settings = shift;
119 11 100       466 Carp::croak "bad bcrypt settings"
120             unless $settings =~ m#\A\$(2[abxy])\$([0-9]{2})\$
121             ([./A-Za-z0-9]{22})#x;
122 8         32 my ($type, $cost, $salt_base64) = ($1, $2, $3);
123 8         19 $self->type($type);
124 8         19 $self->cost($cost);
125 8         19 $self->salt(_de_base64($salt_base64));
126 8         11 return $self;
127             }
128              
129             sub type {
130 10     10 1 19 my $self = shift;
131 10 100       23 return $self->{type} unless (@_);
132              
133 8         15 my $type = shift;
134 8 50       24 Carp::croak "bad bcrypt type" unless $type =~ /^2[abxy]$/;
135 8         17 $self->{type} = $type;
136 8         12 return $self;
137             }
138              
139             # Checks that the cost is a positive integerCroaks if it isn't
140             sub _check_cost {
141 58     58   113 my ($self, $cost) = @_;
142 58 100       142 $cost = defined $cost ? $cost : $self->cost;
143 58 100 100     493 if (!defined $cost || $cost !~ /^\d+$/) {
144 2         273 Carp::croak "Cost must be a positive integer";
145             }
146             }
147              
148             # Checks that the salt exactly 16 octets long. Croaks if it isn't
149             sub _check_salt {
150 55     55   112 my ($self, $salt) = @_;
151 55 100       143 $salt = defined $salt ? $salt : $self->salt;
152 55 100 100     305 unless ($salt && bytes::length($salt) == 16) {
153 3         305 Carp::croak "Salt must be exactly 16 octets long";
154             }
155             }
156              
157             sub _de_base64 {
158 20     20   87 my ($text) = @_;
159 20         42 $text =~ tr#./A-Za-z0-9#A-Za-z0-9+/#;
160 20         267 return decode_base64($text);
161             }
162              
163              
164             1;
165              
166             =encoding utf8
167              
168             =head1 NAME
169              
170             Digest::Bcrypt - Perl interface to the bcrypt digest algorithm
171              
172             =head1 SYNOPSIS
173              
174             #!/usr/bin/env perl
175             use strict;
176             use warnings;
177             use utf8;
178             use Digest; # via the Digest module (recommended)
179              
180             my $bcrypt = Digest->new('Bcrypt', cost => 12, salt => 'abcdefgh♥stuff');
181             # You can forego the cost and salt in favor of settings strings:
182             my $bcrypt = Digest->new('Bcrypt', settings => '$2a$20$GA.eY03tb02ea0DqbA.eG.');
183              
184             # $cost is an integer between 5 and 31
185             $bcrypt->cost(12);
186              
187             # $type is a selection between 2a, 2b, 2x, and 2y
188             $bcrypt->type('2b');
189              
190             # $salt must be exactly 16 octets long
191             $bcrypt->salt('abcdefgh♥stuff');
192             # OR, for good, random salts:
193             use Data::Entropy::Algorithms qw(rand_bits);
194             $bcrypt->salt(rand_bits(16*8)); # 16 octets
195              
196             # You can forego the cost and salt in favor of settings strings:
197             $bcrypt->settings('$2a$20$GA.eY03tb02ea0DqbA.eG.');
198              
199             # add some strings we want to make a secret of
200             $bcrypt->add('some stuff', 'here and', 'here');
201              
202             my $digest = $bcrypt->digest;
203             $digest = $bcrypt->hexdigest;
204             $digest = $bcrypt->b64digest;
205              
206             # bcrypt's own non-standard base64 dictionary
207             $digest = $bcrypt->bcrypt_b64digest;
208              
209             # Now, let's create a password hash and check it later:
210             use Data::Entropy::Algorithms qw(rand_bits);
211             my $bcrypt = Digest->new('Bcrypt', type => '2b', cost => 20, salt => rand_bits(16*8));
212             my $settings = $bcrypt->settings(); # save for later checks.
213             my $pass_hash = $bcrypt->add('Some secret password')->digest;
214              
215             # much later, we can check a password against our hash via:
216             my $bcrypt = Digest->new('Bcrypt', settings => $settings);
217             if ($bcrypt->add($value_from_user)->digest eq $known_pass_hash) {
218             say "Your password matched";
219             }
220             else {
221             say "Try again!";
222             }
223              
224             # Now that you've seen how cumbersome/silly that is,
225             # please use Crypt::Bcrypt instead of this module.
226              
227             =head1 NOTICE
228              
229             While maintenance for L will continue, there's no reason to use
230             L when L already exists. We strongly suggest
231             that you use L instead.
232              
233             This C interface is crufty and laborious to use when compared
234             to that of L.
235              
236             =head1 DESCRIPTION
237              
238             L provides a L-based interface to the
239             L library.
240              
241             Please note that you B set a C of exactly 16 octets in length,
242             and you B provide a C in the range C<1..31>.
243              
244             =head1 ATTRIBUTES
245              
246             L implements the following attributes.
247              
248             =head2 cost
249              
250             $bcrypt = $bcrypt->cost(20); # allows for method chaining
251             my $cost = $bcrypt->cost();
252              
253             An integer in the range C<5..31>, this is required.
254              
255             See L for a detailed description of C
256             in the context of the bcrypt algorithm.
257              
258             When called with no arguments, it will return the current cost.
259              
260             =head2 salt
261              
262             $bcrypt = $bcrypt->salt('abcdefgh♥stuff'); # allows for method chaining
263             my $salt = $bcrypt->salt();
264              
265             # OR, for good, random salts:
266             use Data::Entropy::Algorithms qw(rand_bits);
267             $bcrypt->salt(rand_bits(16*8)); # 16 octets
268              
269             Sets the value to be used as a salt. Bcrypt requires B 16 octets of salt.
270              
271             It is recommenced that you use a module like L to
272             provide a truly randomized salt.
273              
274             When called with no arguments, it will return the current salt.
275              
276             =head2 settings
277              
278             $bcrypt = $bcrypt->settings('$2a$20$GA.eY03tb02ea0DqbA.eG.'); # allows for method chaining
279             my $settings = $bcrypt->settings();
280              
281             A C string can be used to set the L and
282             L automatically. Setting the C will override any
283             current values in your C and C attributes.
284              
285             For details on the C string requirements, please see L.
286              
287             When called with no arguments, it will return the current settings string.
288              
289             =head2 type
290              
291             $bcrypt = $bcrypt->type('2b');
292             # method chaining on mutations
293             say $bcrypt->type(); # 2b
294              
295             This sets the subtype of bcrypt used. These subtypes are as defined in L.
296             The available types are:
297             C<2b> which is the current standard,
298             C<2a> which is older; it's the one used in L,
299             C<2y> which is considered equivalent to C<2b> and used in PHP.
300             C<2x> which is very broken and only needed to work with ancient PHP versions.
301              
302             =head1 METHODS
303              
304             L inherits all methods from L and implements/overrides
305             the following methods as well.
306              
307             =head2 new
308              
309             my $bcrypt = Digest->new('Bcrypt', %params);
310             my $bcrypt = Digest::Bcrypt->new(%params);
311             my $bcrypt = Digest->new('Bcrypt', \%params);
312             my $bcrypt = Digest::Bcrypt->new(\%params);
313              
314             Creates a new C object. It is recommended that you use the L
315             module in the first example rather than using L directly.
316              
317             Any of the L above can be passed in as a parameter.
318              
319             =head2 add
320              
321             $bcrypt->add("a"); $bcrypt->add("b"); $bcrypt->add("c");
322             $bcrypt->add("a")->add("b")->add("c");
323             $bcrypt->add("a", "b", "c");
324             $bcrypt->add("abc");
325              
326             Adds data to the message we are calculating the digest for. All the above
327             examples have the same effect.
328              
329             =head2 b64digest
330              
331             my $digest = $bcrypt->b64digest;
332              
333             Same as L, but will return the digest base64 encoded.
334              
335             The C of the returned string will be 31 and will only contain characters
336             from the ranges C<'0'..'9'>, C<'A'..'Z'>, C<'a'..'z'>, C<'+'>, and C<'/'>
337              
338             The base64 encoded string returned is not padded to be a multiple of 4 bytes long.
339              
340             =head2 bcrypt_b64digest
341              
342             my $digest = $bcrypt->bcrypt_b64digest;
343              
344             Same as L, but will return the digest base64 encoded using the alphabet
345             that is commonly used with bcrypt.
346              
347             The C of the returned string will be 31 and will only contain characters
348             from the ranges C<'0'..'9'>, C<'A'..'Z'>, C<'a'..'z'>, C<'+'>, and C<'.'>
349              
350             The base64 encoded string returned is not padded to be a multiple of 4 bytes long.
351              
352             I This is bcrypt's own non-standard base64 alphabet, It is B
353             compatible with the standard MIME base64 encoding.
354              
355             =head2 clone
356              
357             my $clone = $bcrypt->clone;
358              
359             Creates a clone of the C object, and returns it.
360              
361             =head2 digest
362              
363             my $digest = $bcrypt->digest;
364              
365             Returns the binary digest for the message. The returned string will be 23 bytes long.
366              
367             =head2 hexdigest
368              
369             my $digest = $bcrypt->hexdigest;
370              
371             Same as L, but will return the digest in hexadecimal form.
372              
373             The C of the returned string will be 46 and will only contain
374             characters from the ranges C<'0'..'9'> and C<'a'..'f'>.
375              
376             =head2 reset
377              
378             $bcrypt->reset;
379              
380             Resets the object to the same internal state it was in when it was constructed.
381              
382             =head1 SEE ALSO
383              
384             L, L, L
385              
386             =head1 AUTHOR
387              
388             James Aitken C
389              
390             =head1 CONTRIBUTORS
391              
392             =over
393              
394             =item *
395              
396             Chase Whitener C
397              
398             =back
399              
400             =head1 COPYRIGHT AND LICENSE
401              
402             This software is copyright (c) 2012 by James Aitken.
403              
404             This is free software; you can redistribute it and/or modify it under
405             the same terms as the Perl 5 programming language system itself.
406              
407             =cut