1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
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',
},
encode_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
my %VALID_ENCODE_ARGS = (
'compat' => 'Compat',
'cipher' => 'Cipher',
'compress' => 'Compress',
'mdc' => 'MDC',
);
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 @other;
for my $opt (keys %VALID_ENCODE_ARGS) {
if ( defined $args->{$opt} ) {
push @other, $VALID_ENCODE_ARGS{$opt} => $args->{$opt};
}
}
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,
@other,
);
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@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;
|
