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 |