File Coverage

blib/lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm
Criterion Covered Total %
statement 39 39 100.0
branch 16 18 88.8
condition 1 2 50.0
subroutine 9 9 100.0
pod 2 2 100.0
total 67 70 95.7


line stmt bran cond sub pod time code
1             package DBIx::Class::EncodedColumn::Crypt::Eksblowfish::Bcrypt;
2              
3 1     1   5 use strict;
  1         1  
  1         23  
4 1     1   3 use warnings;
  1         1  
  1         18  
5 1     1   4 use Crypt::Eksblowfish::Bcrypt ();
  1         1  
  1         16  
6 1     1   508 use Encode qw(is_utf8 encode_utf8);
  1         8213  
  1         332  
7              
8             our $VERSION = '0.00001';
9              
10             sub make_encode_sub {
11 2     2 1 5 my($class, $col, $args) = @_;
12 2 100       5 my $cost = exists $args->{cost} ? $args->{cost} : 8;
13 2 100       3 my $nul = exists $args->{key_nul} ? $args->{key_nul} : 1;
14              
15 2 50       9 die("Valid 'key_null' values are '1' and '0'. You used '${nul}'.")
16             unless $nul =~ /^[01]$/;
17 2 50       10 die("Valid 'cost' are 1 or 2 digit integers. You used '${cost}'.")
18             unless $cost =~ /^\d\d?$/;
19              
20 2 100       3 $nul = $nul ? 'a' : '';
21 2         7 $cost = sprintf("%02i", 0+$cost);
22              
23             # It must begin with "$2", optional "a", "$", two digits, "$"
24 2         4 my $settings_base = join('','$2',$nul,'$',$cost, '$');
25              
26             my $encoder = sub {
27 10     10   127 my ($plain_text, $settings_str) = @_;
28 10 100       52 if ( is_utf8($plain_text) ) {
29             # Bcrypt expects octets
30 2         10 $plain_text = encode_utf8($plain_text);
31             }
32 10 100       32 unless ( $settings_str ) {
33 5         13 my $salt = join('', map { chr(int(rand(256))) } 1 .. 16);
  80         114  
34 5         19 $salt = Crypt::Eksblowfish::Bcrypt::en_base64( $salt );
35 5         42 $settings_str = $settings_base.$salt;
36             }
37 10         30 return Crypt::Eksblowfish::Bcrypt::bcrypt($plain_text, $settings_str);
38 2         7 };
39              
40 2         8 return $encoder;
41             }
42              
43             sub make_check_sub {
44 2     2 1 3 my($class, $col, $args) = @_;
45              
46             #fast fast fast
47 2 100 50 4   182 return eval qq^ sub {
  4 100   3   64930  
  4         150  
  3         76  
  3         47729  
  3         88  
  2         32  
48             my \$col_v = \$_[0]->get_column('${col}');
49             return unless defined \$col_v;
50             \$_[0]->_column_encoders->{${col}}->(\$_[1], \$col_v) eq \$col_v;
51             } ^ || die($@);
52             }
53              
54             1;
55              
56             __END__;
57              
58             =head1 NAME
59              
60             DBIx::Class::EncodedColumn::Crypt::Eksblowfish::Bcrypt - Eksblowfish bcrypt backend
61              
62             =head1 SYNOPSYS
63              
64             #Eksblowfish bcrypt / cost of 8/ no key_nul / generate check method
65             __PACKAGE__->add_columns(
66             'password' => {
67             data_type => 'CHAR',
68             size => 59,
69             encode_column => 1,
70             encode_class => 'Crypt::Eksblowfish::Bcrypt',
71             encode_args => { key_nul => 0, cost => 8 },
72             encode_check_method => 'check_password',
73             }
74              
75             =head1 DESCRIPTION
76              
77             =head1 ACCEPTED ARGUMENTS
78              
79             =head2 key_nul => [01]
80              
81             Defaults to true.
82              
83             From the L<Crypt::Eksblowfish::Bcrypt> docs
84              
85             Boolean: whether to append a NUL to the password before using it as a key.
86             The algorithm as originally devised does not do this, but it was later
87             modified to do it. The version that does append NUL is to be preferred;
88             not doing so is supported only for backward compatibility.
89              
90             =head2 cost => \d\d?
91              
92             A single or double digit non-negative integer representing the cost of the
93             hash function. Defaults to 8.
94              
95             =head1 METHODS
96              
97             =head2 make_encode_sub $column_name, \%encode_args
98              
99             Returns a coderef that accepts a plaintext value and returns an encoded value
100              
101             =head2 make_check_sub $column_name, \%encode_args
102              
103             Returns a coderef that when given the row object and a plaintext value will
104             return a boolean if the plaintext matches the encoded value. This is typically
105             used for password authentication.
106              
107             =head1 SEE ALSO
108              
109             L<DBIx::Class::EncodedColumn::Digest>, L<DBIx::Class::EncodedColumn>,
110             L<Crypt::Eksblowfish::Bcrypt>
111              
112             =head1 AUTHOR
113              
114             Guillermo Roditi (groditi) <groditi@cpan.org>
115              
116             Based on the Vienna WoC ToDo manager code by Matt S trout (mst)
117              
118             =head1 LICENSE
119              
120             This module is free software; you can redistribute it and/or modify it under
121             the same terms as Perl itself.
122              
123             =cut