[Bast-commits] r4001 - in trunk/DBIx-Class-EncodedColumn: .
lib/DBIx/Class lib/DBIx/Class/EncodedColumn
lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish t
t/lib/DigestTest/Schema
groditi at dev.catalyst.perl.org
groditi at dev.catalyst.perl.org
Thu Jan 31 22:53:58 GMT 2008
Author: groditi
Date: 2008-01-31 22:53:57 +0000 (Thu, 31 Jan 2008)
New Revision: 4001
Modified:
trunk/DBIx-Class-EncodedColumn/Changes
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm
trunk/DBIx-Class-EncodedColumn/t/02digest.t
trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
Log:
0.00001_02
Modified: trunk/DBIx-Class-EncodedColumn/Changes
===================================================================
--- trunk/DBIx-Class-EncodedColumn/Changes 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/Changes 2008-01-31 22:53:57 UTC (rev 4001)
@@ -1,2 +1,4 @@
+0.00001_01 2008-01-31
+ -salt additions & little fixes
0.00001_01 2008-01-29
- Initial release
Modified: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/Eksblowfish/Bcrypt.pm 2008-01-31 22:53:57 UTC (rev 4001)
@@ -4,10 +4,10 @@
use warnings;
use Crypt::Eksblowfish::Bcrypt ();
-our $VERSION = '0.00001_01';
+our $VERSION = '0.00001_02';
sub make_encode_sub {
- my($class, $args) = @_;
+ my($class, $col, $args) = @_;
my $cost = exists $args->{cost} ? $args->{cost} : 8;
my $nul = exists $args->{key_nul} ? $args->{key_nul} : 1;
@@ -23,10 +23,12 @@
my $settings_base = join('','$2',$nul,'$',$cost, '$');
my $encoder = sub {
- my ($plain_text) = @_;
- my $salt = join('', map { chr(int(rand(256))) } 1 .. 16);
- $salt = Crypt::Eksblowfish::Bcrypt::en_base64( $salt );
- my $settings_str = $settings_base.$salt;
+ my ($plain_text, $settings_str) = @_;
+ unless ( $settings_str ) {
+ my $salt = join('', map { chr(int(rand(256))) } 1 .. 16);
+ $salt = Crypt::Eksblowfish::Bcrypt::en_base64( $salt );
+ $settings_str = $settings_base.$salt;
+ }
return Crypt::Eksblowfish::Bcrypt::bcrypt($plain_text, $settings_str);
};
@@ -34,12 +36,13 @@
}
sub make_check_sub {
- my($class, $col) = @_;
- return sub {
- my ($self, $check) = @_;
- my $target = $self->get_column($col);
- $target eq Crypt::Eksblowfish::Bcrypt::bcrypt($check, $target);
- }
+ my($class, $col, $args) = @_;
+
+ #fast fast fast
+ return eval qq^ sub {
+ my \$col_v = \$_[0]->get_column('${col}');
+ \$_[0]->_column_encoders->{${col}}->(\$_[1], \$col_v) eq \$col_v;
+ } ^ || die($@);
}
1;
@@ -85,11 +88,11 @@
=head1 METHODS
-=head2 make_encode_sub \%args
+=head2 make_encode_sub $column_name, \%encode_args
Returns a coderef that accepts a plaintext value and returns an encoded value
-=head2 make_check_sub $column_name
+=head2 make_check_sub $column_name, \%encode_args
Returns a coderef that when given the row object and a plaintext value will
return a boolean if the plaintext matches the encoded value. This is typically
Modified: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Digest.pm 2008-01-31 22:53:57 UTC (rev 4001)
@@ -2,13 +2,36 @@
use strict;
use warnings;
+use Digest;
-our $VERSION = '0.00001_01';
+our $VERSION = '0.00001_02';
+my %digest_lengths =
+ (
+ 'MD2' => { base64 => 22, binary => 16, hex => 32 },
+ 'MD4' => { base64 => 22, binary => 16, hex => 32 },
+ 'MD5' => { base64 => 22, binary => 16, hex => 32 },
+
+ 'SHA-1' => { base64 => 27, binary => 20, hex => 40 },
+ 'SHA-256' => { base64 => 43, binary => 32, hex => 64 },
+ 'SHA-384' => { base64 => 64, binary => 48, hex => 96 },
+ 'SHA-512' => { base64 => 86, binary => 64, hex => 128 },
+
+ 'CRC-CCITT' => { base64 => 2, binary => 3, hex => 3 },
+ 'CRC-16' => { base64 => 6, binary => 5, hex => 4 },
+ 'CRC-32' => { base64 => 14, binary => 10, hex => 8 },
+
+ 'Adler-32' => { base64 => 6, binary => 4, hex => 8 },
+ 'Whirlpool' => { base64 => 86, binary => 64, hex => 128 },
+ 'Haval-256' => { base64 => 44, binary => 32, hex => 64 },
+ );
+my @salt_pool = ('A' .. 'Z', 'a' .. 'z', 0 .. 9, '+','/','=');
+
sub make_encode_sub {
- my($class, $args) = @_;
- my $for = exists $args->{format} ? $args->{format} : 'base64';
- my $alg = exists $args->{algorithm} ? $args->{algorithm} : 'SHA-256';
+ my($class, $col, $args) = @_;
+ my $for = $args->{format} ||= 'base64';
+ my $alg = $args->{algorithm} ||= 'SHA-256';
+ my $slen = $args->{salt_length} ||= 0;
die("Valid Digest formats are 'binary', 'hex' or 'base64'. You used '$for'.")
unless $for =~ /^(?:hex|base64|binary)$/;
@@ -17,20 +40,36 @@
my $format_method = $for eq 'binary' ? 'digest' :
($for eq 'hex' ? 'hexdigest' : 'b64digest');
+ #thanks Haval for breaking the standard. thanks!
+ $format_method = 'base64digest 'if ($alg eq 'Haval-256' && $for eq 'base64');
my $encoder = sub {
- $object->add(@_);
- return $object->$format_method;
+ my ($plain_text, $salt) = @_;
+ $salt ||= join('', map { $salt_pool[int(rand(65))] } 1 .. $slen);
+ $object->add($plain_text.$salt);
+ my $digest = $object->$format_method;
+ #print "${plain_text}\t ${salt}:\t${digest}${salt}\n" if $salt;
+ return $digest.$salt;
};
+ #in case i didn't prepopulate it
+ $digest_lengths{$alg}{$for} ||= length($encoder->('test1'));
return $encoder;
}
sub make_check_sub {
- my($class, $col) = @_;
- my $current = '$_[0]->get_column("'.$col.'")';
- my $check = '$_[0]->_column_encoders->{"'.$col.'"}->($_[1])';
- eval "sub { $current eq $check }";
+ my($class, $col, $args) = @_;
+
+ #this is the digest length
+ my $len = $digest_lengths{$args->{algorithm}}{$args->{format}};
+ die("Unable to find digest length") unless defined $len;
+
+ #fast fast fast
+ return eval qq^ sub {
+ my \$col_v = \$_[0]->get_column('${col}');
+ my \$salt = substr(\$col_v, ${len});
+ \$_[0]->_column_encoders->{${col}}->(\$_[1], \$salt) eq \$col_v;
+ } ^ || die($@);
}
1;
@@ -85,11 +124,11 @@
=head1 METHODS
-=head2 make_encode_sub \%args
+=head2 make_encode_sub $column_name, \%encode_args
Returns a coderef that accepts a plaintext value and returns an encoded value
-=head2 make_check_sub $column_name
+=head2 make_check_sub $column_name, \%encode_args
Returns a coderef that when given the row object and a plaintext value will
return a boolean if the plaintext matches the encoded value. This is typically
Modified: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn.pm 2008-01-31 22:53:57 UTC (rev 4001)
@@ -28,13 +28,13 @@
eval "require ${class};";
$self->throw_exception("Failed to use encode_class '${class}': $@") if $@;
- defined( my $encode_sub = eval{ $class->make_encode_sub($args) }) ||
+ defined( my $encode_sub = eval{ $class->make_encode_sub($column, $args) }) ||
$self->throw_exception("Failed to create encoder with class '$class': $@");
$self->_column_encoders->{$column} = $encode_sub;
if ( exists $info->{encode_check_method} && $info->{encode_check_method} ){
no strict 'refs';
- defined( my $check_sub = eval{ $class->make_check_sub($column) }) ||
+ defined( my $check_sub = eval{ $class->make_check_sub($column, $args) }) ||
$self->throw_exception("Failed to create checker with class '$class': $@");
*{$self->result_class.'::'.$info->{encode_check_method}} = $check_sub;
}
Modified: trunk/DBIx-Class-EncodedColumn/t/02digest.t
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/02digest.t 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/t/02digest.t 2008-01-31 22:53:57 UTC (rev 4001)
@@ -16,7 +16,7 @@
}
my $tests = 5;
-$tests += 19 if $sha_ok;
+$tests += 21 if $sha_ok;
$tests += 6 if $bcrypt_ok;
plan tests => $tests;
@@ -45,8 +45,10 @@
my %create_vals = (dummy_col => 'test1');
if( $sha_ok ){
- $create_vals{$_} = 'test1' for(qw/sha1_hex sha1_b64 sha256_hex sha256_b64/);
+ $create_vals{$_} = 'test1'
+ for(qw/sha1_hex sha1_b64 sha256_hex sha256_b64 sha256_b64_salted/);
}
+
if( $bcrypt_ok ){
$create_vals{$_} = 'test1' for(qw/bcrypt_1 bcrypt_2/);
}
@@ -75,10 +77,23 @@
is($row->sha1_b64, $checks->{'SHA-1'}{base64}{test1}, 'b64 sha1 on create');
is($row->sha256_hex, $checks->{'SHA-256'}{hex}{test1}, 'hex sha256 on create');
is($row->sha256b64, $checks->{'SHA-256'}{base64}{test1},'b64 sha256 on create');
+ is( length($row->sha256_b64_salted), 57, 'correct salted length');
+# my $salted_check = sub {
+# my $col_v = $_[0]->get_column('sha256_b64_salted');
+# my $target = substr($col_v, 0, 43);
+# my $salt = substr($col_v, 43);
+# my $maybe = $_[0]->_column_encoders->{'sha256_b64_salted'}->($_[1], $salt);
+# print STDERR "$_[1]\t${salt}\t${maybe}\n";
+# $maybe eq $col_v;
+# };
+
+ #die unless $salted_check->($row, 'test1');
+
can_ok($row, qw/check_sha1_hex check_sha1_b64/);
ok($row->check_sha1_hex('test1'),'Checking hex digest_check_method');
ok($row->check_sha1_b64('test1'),'Checking b64 digest_check_method');
+ ok($row->check_sha256_b64_salted('test1'), 'Checking salted digest_check_method');
$row->sha1_hex('test2');
is($row->sha1_hex, $checks->{'SHA-1'}{hex}{test2}, 'Checking accessor');
Modified: trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2008-01-31 19:59:21 UTC (rev 4000)
+++ trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2008-01-31 22:53:57 UTC (rev 4001)
@@ -65,6 +65,14 @@
encode_column => 1,
encode_class => 'Digest',
},
+ sha256_b64_salted => {
+ data_type => 'char',
+ size => 57,
+ encode_column => 1,
+ encode_class => 'Digest',
+ encode_check_method => 'check_sha256_b64_salted',
+ encode_args => {salt_length => 14}
+ },
);
}
More information about the Bast-commits
mailing list