File Coverage

blib/lib/Crypt/TripleDES/CBC.pm
Criterion Covered Total %
statement 51 51 100.0
branch n/a
condition n/a
subroutine 11 11 100.0
pod 2 2 100.0
total 64 64 100.0


line stmt bran cond sub pod time code
1 1     1   53858 use strict;
  1         2  
  1         24  
2 1     1   4 use warnings;
  1         1  
  1         55  
3              
4             package Crypt::TripleDES::CBC;
5              
6             # PODNAME: Crypt::TripleDES::CBC
7             # ABSTRACT: Triple DES in CBC mode Pure implementation
8             #
9             # This file is part of Crypt-TripleDES-CBC
10             #
11             # This software is copyright (c) 2015 by Shantanu Bhadoria.
12             #
13             # This is free software; you can redistribute it and/or modify it under
14             # the same terms as the Perl 5 programming language system itself.
15             #
16             our $VERSION = '0.005'; # VERSION
17              
18             # Dependencies
19              
20 1     1   425 use Moose;
  1         313452  
  1         6  
21 1     1   5046 use 5.010;
  1         3  
  1         24  
22 1     1   559 use Crypt::DES;
  1         673  
  1         350  
23              
24              
25             has cipher1 => (
26             is => 'ro',
27             lazy_build => 1,
28             );
29              
30             sub _build_cipher1 {
31 4     4   5 my ($self) = @_;
32 4         89 my $cipher = new Crypt::DES( substr( $self->key, 0, 8 ) );
33             }
34              
35              
36             has cipher2 => (
37             is => 'ro',
38             lazy_build => 1,
39             );
40              
41             sub _build_cipher2 {
42 4     4   6 my ($self) = @_;
43 4         86 my $cipher = new Crypt::DES( substr( $self->key, 8 ) );
44             }
45              
46              
47             has key => (
48             is => 'ro',
49             required => 1,
50             );
51              
52              
53             has iv => (
54             is => 'ro',
55             required => 1,
56             default => pack( "H*", "0000000000000000" ),
57             );
58              
59              
60             sub encrypt {
61 2     2 1 4273 my ( $self, $cleartext ) = @_;
62 2         5 my $length = length($cleartext);
63 2         3 my $result = '';
64 2         44 my $iv = $self->iv;
65 2         7 while ( $length > 8 ) {
66 36         31 my $block = substr( $cleartext, 0, 8 );
67 36         32 $cleartext = substr( $cleartext, 8 );
68 36         54 my $ciphertext = $self->_encrypt_3des( $block ^ $iv );
69 36         315 $result .= $ciphertext;
70 36         22 $iv = $ciphertext;
71 36         56 $length = length($cleartext);
72             }
73 2         6 my $ciphertext = $self->_encrypt_3des( $cleartext ^ $iv );
74 2         17 $result .= $ciphertext;
75 2         5 return $result;
76             }
77              
78              
79             sub decrypt {
80 2     2 1 3760 my ( $self, $ciphertext ) = @_;
81 2         6 my $length = length($ciphertext);
82 2         3 my $result = '';
83 2         47 my $iv = $self->iv;
84 2         5 while ( $length > 8 ) {
85 36         40 my $block = substr( $ciphertext, 0, 8 );
86 36         32 $ciphertext = substr( $ciphertext, 8 );
87 36         40 my $cleartext = $self->_decrypt_3des($block);
88 36         323 $result .= $cleartext ^ $iv;
89 36         31 $iv = $block;
90 36         47 $length = length($ciphertext);
91             }
92 2         4 my $cleartext = $self->_decrypt_3des($ciphertext);
93 2         18 $result .= $cleartext ^ $iv;
94 2         5 return $result;
95             }
96              
97             sub _encrypt_3des {
98 38     38   25 my ( $self, $plaintext ) = @_;
99 38         859 return $self->cipher1->encrypt(
100             $self->cipher2->decrypt( $self->cipher1->encrypt($plaintext) ) );
101             }
102              
103             sub _decrypt_3des {
104 38     38   34 my ( $self, $ciphertext ) = @_;
105 38         829 return $self->cipher1->decrypt(
106             $self->cipher2->encrypt( $self->cipher1->decrypt($ciphertext) ) );
107             }
108              
109             1;
110              
111             __END__
112              
113             =pod
114              
115             =head1 NAME
116              
117             Crypt::TripleDES::CBC - Triple DES in CBC mode Pure implementation
118              
119             =head1 VERSION
120              
121             version 0.005
122              
123             =head1 SYNOPSIS
124              
125             use Crypt::TripleDES::CBC;
126            
127             my $key = pack("H*"
128             , "1234567890123456"
129             . "7890123456789012");
130             my $iv = pack("H*","0000000000000000");
131             my $crypt = Crypt::TripleDES::CBC->new(
132             key => $key,
133             iv => $iv,
134             );
135            
136             say unpack("H*",$crypt->encrypt(pack("H*","0ABC0F2241535345631FCE"))); # Output F64F2268BF6185A16DADEFD7378E5CE5
137             say unpack("H*",$crypt->decrypt(pack("H*","F64F2268BF6185A16DADEFD7378E5CE5"))); # Output 0ABC0F2241535345631FCE0000000000
138              
139             =head1 DESCRIPTION
140              
141             Most Modules on CPAN don't do a standards compliant implementation, while they
142             are able to decrypt what they encrypt. There are corner cases where certain
143             blocks of data in a chain don't decrypt properly. This is (almost)a pure perl
144             implementation of TripleDES in CBC mode using Crypt::DES to encrypt individual
145             blocks.
146              
147             =head1 ATTRIBUTES
148              
149             =head2 cipher1
150              
151             First Crypt::DES Cipher object generated from the key. This is built
152             automatically. Do not change this value from your program.
153              
154             =head2 cipher2
155              
156             second Crypt::DES Cipher object generated from the key. This is built
157             automatically. Do not change this value from your program.
158              
159             =head2 key
160              
161             Encryption Key this must be ascii packed string as shown in Synopsis.
162              
163             =head2 iv
164              
165             Initialization vector, default is a null string.
166              
167             =head1 METHODS
168              
169             =head2 encrypt
170              
171             Encryption Method
172              
173             =head2 decrypt
174              
175             Decryption method
176              
177             =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
178              
179             =head1 SUPPORT
180              
181             =head2 Bugs / Feature Requests
182              
183             Please report any bugs or feature requests through github at
184             L<https://github.com/shantanubhadoria/perl-crypt-tripledes-cbc/issues>.
185             You will be notified automatically of any progress on your issue.
186              
187             =head2 Source Code
188              
189             This is open source software. The code repository is available for
190             public review and contribution under the terms of the license.
191              
192             L<https://github.com/shantanubhadoria/perl-crypt-tripledes-cbc>
193              
194             git clone git://github.com/shantanubhadoria/perl-crypt-tripledes-cbc.git
195              
196             =head1 AUTHOR
197              
198             Shantanu Bhadoria <shantanu@cpan.org> L<https://www.shantanubhadoria.com>
199              
200             =head1 CONTRIBUTORS
201              
202             =for stopwords Shantanu Bhadoria
203              
204             =over 4
205              
206             =item *
207              
208             Shantanu <shantanu@cpan.org>
209              
210             =item *
211              
212             Shantanu Bhadoria <shantanu@cpan.org>
213              
214             =back
215              
216             =head1 COPYRIGHT AND LICENSE
217              
218             This software is copyright (c) 2015 by Shantanu Bhadoria.
219              
220             This is free software; you can redistribute it and/or modify it under
221             the same terms as the Perl 5 programming language system itself.
222              
223             =cut