File Coverage

blib/lib/Gantry/Utils/Crypt.pm
Criterion Covered Total %
statement 12 64 18.7
branch 0 12 0.0
condition 0 4 0.0
subroutine 4 9 44.4
pod 3 5 60.0
total 19 94 20.2


line stmt bran cond sub pod time code
1             package Gantry::Utils::Crypt;
2 1     1   710 use strict;
  1         2  
  1         33  
3              
4 1     1   944 use Crypt::CBC;
  1         5658  
  1         28  
5 1     1   934 use MIME::Base64;
  1         774  
  1         73  
6 1     1   7 use Digest::MD5 qw( md5_hex );
  1         2  
  1         668  
7              
8             sub new {
9 0     0 1   my ( $class, $opt ) = @_;
10              
11 0           my $self = { options => $opt };
12 0           bless( $self, $class );
13              
14 0           my @errors;
15 0           foreach( qw/secret/ ) {
16 0 0         push( @errors, "$_ is not set properly" ) if ! $opt->{$_};
17             }
18              
19 0 0         if ( scalar( @errors ) ) {
20 0           die join( "\n", @errors );
21             }
22            
23             # populate self with data from site
24 0           return( $self );
25              
26             } # end new
27              
28             #-------------------------------------------------
29             # decrypt()
30             #-------------------------------------------------
31             sub decrypt {
32 0     0 1   my ( $self, $encrypted ) = @_;
33              
34 0   0       $encrypted ||= '';
35 0           $self->set_error( undef );
36            
37 0           local $^W = 0;
38            
39 0           my $c;
40 0           eval {
41 0           $c = new Crypt::CBC ( {
42             'key' => $self->{options}{secret},
43             'cipher' => 'Blowfish',
44             'padding' => 'null',
45             } );
46             };
47 0 0         if ( $@ ) {
48 0           my $error = (
49             "Error building CBC object are your Crypt::CBC and"
50             . " Crypt::Blowfish up to date? Actual error: $@"
51             );
52            
53 0           $self->set_error( $error );
54 0           die $error;
55             }
56              
57 0           my $p_text = $c->decrypt( MIME::Base64::decode( $encrypted ) );
58            
59 0           $c->finish();
60            
61 0           my @decrypted_values = split( ':;:', $p_text );
62 0           my $md5 = pop( @decrypted_values );
63 0   0       my $omd5 = md5_hex( join( '', @decrypted_values ) ) || '';
64              
65 0 0         if ( $omd5 eq $md5 ) {
66 0 0         if ( wantarray ) {
67 0           return @decrypted_values;
68             }
69             else {
70 0           return join( ' ', @decrypted_values );
71             }
72             }
73             else {
74 0           $self->set_error( 'bad encryption' );
75             }
76              
77             } # END decrypt_cookie
78              
79             #-------------------------------------------------
80             # encrypt
81             #-------------------------------------------------
82             sub encrypt {
83 0     0 1   my ( $self, @to_encrypt ) = @_;
84              
85 0           local $^W = 0;
86 0           $self->set_error( undef );
87            
88 0           my $c;
89 0           eval {
90 0           $c = new Crypt::CBC( {
91             'key' => $self->{options}{secret},
92             'cipher' => 'Blowfish',
93             'padding' => 'null',
94             } );
95             };
96 0 0         if ( $@ ) {
97 0           my $error = (
98             "Error building CBC object are your Crypt::CBC and"
99             . " Crypt::Blowfish up to date? Actual error: $@"
100             );
101              
102 0           $self->set_error( $error );
103 0           die $error;
104             }
105              
106 0           my $md5 = md5_hex( join( '', @to_encrypt ) );
107 0           push ( @to_encrypt, $md5 );
108            
109 0           my $str = join( ':;:', @to_encrypt );
110 0           my $encd = $c->encrypt( $str );
111 0           my $c_text = MIME::Base64::encode( $encd, '' );
112              
113 0           $c->finish();
114            
115 0           return( $c_text );
116            
117             } # END encrypt
118              
119             #-------------------------------------------------
120             # set_error()
121             #-------------------------------------------------
122             sub set_error {
123 0     0 0   my $self = shift;
124 0           $self->{__error__} = shift;
125              
126 0           return $self->{__error__};
127             }
128              
129             #-------------------------------------------------
130             # get_error()
131             #-------------------------------------------------
132             sub get_error {
133 0     0 0   my $self = shift;
134 0           return $self->{__error__};
135             }
136              
137             # EOF
138             1;
139              
140             __END__