[Bast-commits] r4276 - in trunk/DBIx-Class-EncodedColumn: .
lib/DBIx/Class/EncodedColumn/Crypt t t/lib/DigestTest/Schema
jshirley at dev.catalyst.perl.org
jshirley at dev.catalyst.perl.org
Sat Apr 19 00:25:24 BST 2008
Author: jshirley
Date: 2008-04-19 00:25:23 +0100 (Sat, 19 Apr 2008)
New Revision: 4276
Added:
trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/OpenPGP.pm
trunk/DBIx-Class-EncodedColumn/t/pubring.gpg
trunk/DBIx-Class-EncodedColumn/t/secring.gpg
Modified:
trunk/DBIx-Class-EncodedColumn/Makefile.PL
trunk/DBIx-Class-EncodedColumn/t/02digest.t
trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
Log:
Adding Crypt::OpenPGP into the EncodedColumn mix
Modified: trunk/DBIx-Class-EncodedColumn/Makefile.PL
===================================================================
--- trunk/DBIx-Class-EncodedColumn/Makefile.PL 2008-04-18 22:22:41 UTC (rev 4275)
+++ trunk/DBIx-Class-EncodedColumn/Makefile.PL 2008-04-18 23:25:23 UTC (rev 4276)
@@ -19,10 +19,24 @@
build_requires 'File::Spec';
#recommended modules
-recommends 'Digest' => '1.11';
-recommends 'Digest::MD5';
-recommends 'Digest::SHA';
-recommends 'Crypt::Eksblowfish::Bcrypt';
+feature 'Digest::MD5 Support?',
+ -default => 1,
+ 'Digest',
+ 'Digest::MD5';
+feature 'Digest::SHA Support?',
+ -default => 1,
+ 'Digest',
+ 'Digest::SHA';
+
+feature 'Blowfish Support?',
+ -default => 1,
+ 'Crypt::Eksblowfish::Bcrypt';
+
+feature 'Crypt::OpenPGP (gpg) Support?',
+ -default => 1,
+ 'Crypt::OpenPGP',
+ 'Crypt::CAST5_PP';
+
auto_install;
WriteAll;
Added: trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/OpenPGP.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/OpenPGP.pm (rev 0)
+++ trunk/DBIx-Class-EncodedColumn/lib/DBIx/Class/EncodedColumn/Crypt/OpenPGP.pm 2008-04-18 23:25:23 UTC (rev 4276)
@@ -0,0 +1,150 @@
+package DBIx::Class::EncodedColumn::Crypt::OpenPGP;
+
+use strict;
+use warnings;
+
+use Carp;
+use Crypt::OpenPGP;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+DBIx::Class::EncodedColumn::Crypt::OpenPGP - Encrypt columns using Crypt::OpenPGP
+
+=head1 SYNOPSIS
+
+ __PACKAGE__->add_columns(
+ 'secret_data' => {
+ data_type => 'TEXT',
+ encode_column => 1,
+ encode_class => 'Crypt::OpenPGP',
+ encode_args => {
+ recipient => '7BEF6294',
+ },
+ digest_check_method => 'decrypt_data',
+ };
+
+ my $row = $schema->resultset('EncryptedClass')
+ ->create({ secret_data => 'This is secret' });
+
+ is(
+ $row->decrypt_data('Private Key Passphrase'),
+ 'This is secret',
+ 'PGP/GPG Encryption works!'
+ );
+
+=head1 DESCRIPTION
+
+This is a conduit to working with L<Crypt::OpenPGP>, so that you can encrypt
+data in your database using gpg. Currently this module only handles encrypting
+but it may add signing of columns in the future
+
+=head1 CONFIGURATION
+
+In the column definition, specify the C<encode_args> hash as listed in the
+synopsis. The C<recipient> is required if doing key exchange encryption, or
+if you want to use symmetric key encryption using a passphrase you can
+specify a C<passphrase> option:
+
+ encode_args => { passphrase => "Shared Secret" }
+
+If you have a separate path to your public and private key ring file, or if you
+have alternative L<Crypt::OpenPGP> configuration, you can specify the
+constructor args using the C<pgp_args> configuration key:
+
+ encode_args => {
+ pgp_args => {
+ SecRing => "$FindBin::Bin/var/secring.gpg",
+ PubRing => "$FindBin::Bin/var/pubring.gpg",
+ }
+ }
+
+The included tests cover good usage, and it is advised to briefly browse through
+them.
+
+Also, remember to keep your private keys secure!
+
+=cut
+
+sub make_encode_sub {
+ my ( $class, $col, $args ) = @_;
+
+ my ( $method, $method_arg );
+
+ my $armour = defined $args->{armour} ? $args->{armour} : 0;
+ if ( defined $args->{passphrase} ) {
+ $method = 'Passphrase';
+ $method_arg = $args->{passphrase};
+ } elsif ( defined $args->{recipient} ) {
+ $method = 'Recipients';
+ $method_arg = $args->{recipient};
+ }
+
+ my $pgp = _get_pgp_obj_from_args($args);
+
+ my $encoder = sub {
+ my ( $plain_text, $settings ) = @_;
+ my $val = $pgp->encrypt(
+ Data => $plain_text,
+ $method => $method_arg,
+ Armour => $armour
+ );
+ croak "Unable to encrypt $col; check $method parameter (is $method_arg) (and that the key is known)" unless $val;
+ return $val;
+ };
+ return $encoder;
+}
+
+sub make_check_sub {
+ my ( $class, $col, $args ) = @_;
+
+ my $pgp = _get_pgp_obj_from_args($args);
+
+ return sub {
+ my ( $self, $passphrase ) = @_;
+ my $text = $self->get_column($col);
+ my @res;
+ if ( defined $passphrase ) {
+ @res = $pgp->decrypt( Passphrase => $passphrase, Data => $text );
+ } else {
+ @res = $pgp->decrypt( Data => $text );
+ }
+ croak $pgp->errstr unless $res[0];
+
+ # Handle additional stuff in $res[1] and [2]?
+ return $res[0];
+ };
+}
+
+sub _get_pgp_obj_from_args {
+ my ( $args ) = @_;
+ my $pgp;
+ if ( $args->{pgp_args} and ref $args->{pgp_args} eq 'HASH' ) {
+ $pgp = Crypt::OpenPGP->new( %{ $args->{pgp_args} } );
+ }
+ elsif ( $args->{pgp_object} and
+ $args->{pgp_object}->isa('Crypt::OpenPGP')
+ ) {
+ $pgp = $args->{pgp_object};
+ } else {
+ $pgp = Crypt::OpenPGP->new;
+ }
+ croak "Unable to get initialize a Crypt::OpenPGP object" unless $pgp;
+
+ return $pgp;
+}
+
+=head1 AUTHOR
+
+J. Shirley <cpan at coldhardcode.com>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+
+1;
Modified: trunk/DBIx-Class-EncodedColumn/t/02digest.t
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/02digest.t 2008-04-18 22:22:41 UTC (rev 4275)
+++ trunk/DBIx-Class-EncodedColumn/t/02digest.t 2008-04-18 23:25:23 UTC (rev 4276)
@@ -9,15 +9,17 @@
use FindBin '$Bin';
use lib File::Spec->catdir($Bin, 'lib');
-my ($sha_ok, $bcrypt_ok);
+my ($sha_ok, $bcrypt_ok, $pgp_ok);
BEGIN {
$sha_ok = eval 'require Digest' && eval 'require Digest::SHA;';
$bcrypt_ok = eval 'require Crypt::Eksblowfish::Bcrypt';
+ $pgp_ok = eval 'require Crypt::Eksblowfish::Bcrypt';
}
my $tests = 5;
$tests += 21 if $sha_ok;
$tests += 6 if $bcrypt_ok;
+$tests += 6 if $pgp_ok;
plan tests => $tests;
@@ -135,6 +137,39 @@
is($new->sha256b64, $checks->{'SHA-256'}{base64}{test1}, 'b64 sha256 on new');
}
+if ( $pgp_ok ) {
+ my $row = $rs->create( {
+ dummy_col => 'Dummy Column',
+ pgp_col_passphrase => 'Test Encrypted Column with Passphrase',
+ pgp_col_key => 'Test Encrypted Column with Key Exchange',
+ pgp_col_key_ps => 'Test Encrypted Column with Key Exchange + Pass',
+ } );
+
+ like($row->pgp_col_passphrase, qr/BEGIN PGP MESSAGE/, 'Passphrase encrypted');
+ like($row->pgp_col_key, qr/BEGIN PGP MESSAGE/, 'Key encrypted');
+ like($row->pgp_col_key_ps, qr/BEGIN PGP MESSAGE/, 'Key+Passphrase encrypted');
+
+ is(
+ $row->decrypt_pgp_passphrase('Secret Words'),
+ 'Test Encrypted Column with Passphrase',
+ 'Passphrase decryption/encryption'
+ );
+
+ is(
+ $row->decrypt_pgp_key,
+ 'Test Encrypted Column with Key Exchange',
+ 'Key Exchange decryption/encryption'
+ );
+
+ is(
+ $row->decrypt_pgp_key_ps('Secret Words'),
+ 'Test Encrypted Column with Key Exchange + Pass',
+ 'Secured Key Exchange decryption/encryption'
+ );
+
+
+}
+
DigestTest->clear;
#TODO
Modified: trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm
===================================================================
--- trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2008-04-18 22:22:41 UTC (rev 4275)
+++ trunk/DBIx-Class-EncodedColumn/t/lib/DigestTest/Schema/Test.pm 2008-04-18 23:25:23 UTC (rev 4276)
@@ -5,6 +5,7 @@
BEGIN {
$sha_ok = eval 'require Digest' && eval 'require Digest::SHA;';
$bcrypt_ok = eval 'require Crypt::Eksblowfish::Bcrypt';
+ $pgp_ok = eval 'require Crypt::OpenPGP';
}
use base qw/DBIx::Class/;
@@ -32,6 +33,7 @@
(
sha1_hex => {
data_type => 'char',
+ is_nullable => 1,
size => 40,
encode_column => 1,
encode_class => 'Digest',
@@ -43,6 +45,7 @@
},
sha1_b64 => {
data_type => 'char',
+ is_nullable => 1,
size => 27,
encode_column => 1,
encode_class => 'Digest',
@@ -53,6 +56,7 @@
},
sha256_hex => {
data_type => 'char',
+ is_nullable => 1,
size => 64,
encode_column => 1,
encode_class => 'Digest',
@@ -60,6 +64,7 @@
},
sha256_b64 => {
data_type => 'char',
+ is_nullable => 1,
size => 43,
accessor => 'sha256b64',
encode_column => 1,
@@ -67,6 +72,7 @@
},
sha256_b64_salted => {
data_type => 'char',
+ is_nullable => 1,
size => 57,
encode_column => 1,
encode_class => 'Digest',
@@ -81,6 +87,7 @@
(
bcrypt_1 => {
data_type => 'text',
+ is_nullable => 1,
size => 60,
encode_column => 1,
encode_class => 'Crypt::Eksblowfish::Bcrypt',
@@ -88,6 +95,7 @@
},
bcrypt_2 => {
data_type => 'text',
+ is_nullable => 1,
size => 59,
encode_column => 1,
encode_class => 'Crypt::Eksblowfish::Bcrypt',
@@ -97,6 +105,49 @@
);
}
+if( $pgp_ok ){
+ my $pgp_conf = {
+ SecRing => "$FindBin::Bin/secring.gpg",
+ PubRing => "$FindBin::Bin/pubring.gpg",
+ };
+ __PACKAGE__->add_columns(
+ pgp_col_passphrase => {
+ data_type => 'text',
+ is_nullable => 1,
+ encode_column => 1,
+ encode_class => 'Crypt::OpenPGP',
+ encode_args => {
+ passphrase => 'Secret Words',
+ armour => 1
+ },
+ encode_check_method => 'decrypt_pgp_passphrase',
+ },
+ pgp_col_key => {
+ data_type => 'text',
+ is_nullable => 1,
+ encode_column => 1,
+ encode_class => 'Crypt::OpenPGP',
+ encode_args => {
+ recipient => '1B8924AA',
+ pgp_args => $pgp_conf,
+ armour => 1
+ },
+ encode_check_method => 'decrypt_pgp_key',
+ },
+ pgp_col_key_ps => {
+ data_type => 'text',
+ is_nullable => 1,
+ encode_column => 1,
+ encode_class => 'Crypt::OpenPGP',
+ encode_args => {
+ recipient => '7BEF6294',
+ pgp_args => $pgp_conf,
+ armour => 1
+ },
+ encode_check_method => 'decrypt_pgp_key_ps',
+ },
+ );
+}
__PACKAGE__->set_primary_key('id');
Added: trunk/DBIx-Class-EncodedColumn/t/pubring.gpg
===================================================================
(Binary files differ)
Property changes on: trunk/DBIx-Class-EncodedColumn/t/pubring.gpg
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/DBIx-Class-EncodedColumn/t/secring.gpg
===================================================================
(Binary files differ)
Property changes on: trunk/DBIx-Class-EncodedColumn/t/secring.gpg
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
More information about the Bast-commits
mailing list