File Coverage

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


line stmt bran cond sub pod time code
1 1     1   52801 use strict;
  1         2  
  1         22  
2 1     1   3 use warnings;
  1         1  
  1         42  
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) 2016 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.006'; # VERSION
17              
18             # Dependencies
19              
20 1     1   485 use Moose;
  1         311959  
  1         4  
21 1     1   4412 use 5.010;
  1         2  
22 1     1   474 use Crypt::DES;
  1         671  
  1         352  
23              
24              
25             has cipher1 => (
26             is => 'ro',
27             lazy_build => 1,
28             );
29              
30             sub _build_cipher1 {
31 4     4   4 my ($self) = @_;
32 4         90 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   5 my ($self) = @_;
43 4         108 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 3748 my ( $self, $cleartext ) = @_;
62 2         4 my $length = length($cleartext);
63 2         2 my $result = '';
64 2         44 my $iv = $self->iv;
65 2         6 while ( $length > 8 ) {
66 36         30 my $block = substr( $cleartext, 0, 8 );
67 36         33 $cleartext = substr( $cleartext, 8 );
68 36         47 my $ciphertext = $self->_encrypt_3des( $block ^ $iv );
69 36         299 $result .= $ciphertext;
70 36         27 $iv = $ciphertext;
71 36         48 $length = length($cleartext);
72             }
73 2         3 my $ciphertext = $self->_encrypt_3des( $cleartext ^ $iv );
74 2         19 $result .= $ciphertext;
75 2         4 return $result;
76             }
77              
78              
79             sub decrypt {
80 2     2 1 3230 my ( $self, $ciphertext ) = @_;
81 2         3 my $length = length($ciphertext);
82 2         2 my $result = '';
83 2         45 my $iv = $self->iv;
84 2         5 while ( $length > 8 ) {
85 36         31 my $block = substr( $ciphertext, 0, 8 );
86 36         25 $ciphertext = substr( $ciphertext, 8 );
87 36         41 my $cleartext = $self->_decrypt_3des($block);
88 36         335 $result .= $cleartext ^ $iv;
89 36         24 $iv = $block;
90 36         50 $length = length($ciphertext);
91             }
92 2         3 my $cleartext = $self->_decrypt_3des($ciphertext);
93 2         18 $result .= $cleartext ^ $iv;
94 2         4 return $result;
95             }
96              
97             sub _encrypt_3des {
98 38     38   26 my ( $self, $plaintext ) = @_;
99 38         847 return $self->cipher1->encrypt(
100             $self->cipher2->decrypt( $self->cipher1->encrypt($plaintext) ) );
101             }
102              
103             sub _decrypt_3des {
104 38     38   29 my ( $self, $ciphertext ) = @_;
105 38         833 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              
120              
121             =begin html
122              
123             <p>
124             <img src="https://img.shields.io/badge/perl-5.10+-brightgreen.svg" alt="Requires Perl 5.10+" />
125             <a href="https://travis-ci.org/shantanubhadoria/perl-Crypt-TripleDES-CBC"><img src="https://api.travis-ci.org/shantanubhadoria/perl-Crypt-TripleDES-CBC.svg?branch=build/master" alt="Travis status" /></a>
126             <a href="http://matrix.cpantesters.org/?dist=Crypt-TripleDES-CBC%200.006"><img src="https://badgedepot.code301.com/badge/cpantesters/Crypt-TripleDES-CBC/0.006" alt="CPAN Testers result" /></a>
127             <a href="http://cpants.cpanauthors.org/dist/Crypt-TripleDES-CBC-0.006"><img src="https://badgedepot.code301.com/badge/kwalitee/Crypt-TripleDES-CBC/0.006" alt="Distribution kwalitee" /></a>
128             <a href="https://gratipay.com/shantanubhadoria"><img src="https://img.shields.io/gratipay/shantanubhadoria.svg" alt="Gratipay" /></a>
129             </p>
130              
131             =end html
132              
133             =head1 VERSION
134              
135             version 0.006
136              
137             =head1 SYNOPSIS
138              
139             use Crypt::TripleDES::CBC;
140            
141             my $key = pack("H*"
142             , "1234567890123456"
143             . "7890123456789012");
144             my $iv = pack("H*","0000000000000000");
145             my $crypt = Crypt::TripleDES::CBC->new(
146             key => $key,
147             iv => $iv,
148             );
149            
150             say unpack("H*",$crypt->encrypt(pack("H*","0ABC0F2241535345631FCE"))); # Output F64F2268BF6185A16DADEFD7378E5CE5
151             say unpack("H*",$crypt->decrypt(pack("H*","F64F2268BF6185A16DADEFD7378E5CE5"))); # Output 0ABC0F2241535345631FCE0000000000
152              
153             =head1 DESCRIPTION
154              
155             Most Modules on CPAN don't do a standards compliant implementation, while they
156             are able to decrypt what they encrypt. There are corner cases where certain
157             blocks of data in a chain don't decrypt properly. This is (almost)a pure perl
158             implementation of TripleDES in CBC mode using Crypt::DES to encrypt individual
159             blocks.
160              
161             =head1 ATTRIBUTES
162              
163             =head2 cipher1
164              
165             First Crypt::DES Cipher object generated from the key. This is built
166             automatically. Do not change this value from your program.
167              
168             =head2 cipher2
169              
170             second Crypt::DES Cipher object generated from the key. This is built
171             automatically. Do not change this value from your program.
172              
173             =head2 key
174              
175             Encryption Key this must be ascii packed string as shown in Synopsis.
176              
177             =head2 iv
178              
179             Initialization vector, default is a null string.
180              
181             =head1 METHODS
182              
183             =head2 encrypt
184              
185             Encryption Method
186              
187             =head2 decrypt
188              
189             Decryption method
190              
191             =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
192              
193             =head1 SUPPORT
194              
195             =head2 Bugs / Feature Requests
196              
197             Please report any bugs or feature requests through github at
198             L<https://github.com/shantanubhadoria/perl-crypt-tripledes-cbc/issues>.
199             You will be notified automatically of any progress on your issue.
200              
201             =head2 Source Code
202              
203             This is open source software. The code repository is available for
204             public review and contribution under the terms of the license.
205              
206             L<https://github.com/shantanubhadoria/perl-crypt-tripledes-cbc>
207              
208             git clone git://github.com/shantanubhadoria/perl-crypt-tripledes-cbc.git
209              
210             =head1 AUTHOR
211              
212             Shantanu Bhadoria <shantanu@cpan.org> L<https://www.shantanubhadoria.com>
213              
214             =head1 COPYRIGHT AND LICENSE
215              
216             This software is copyright (c) 2016 by Shantanu Bhadoria.
217              
218             This is free software; you can redistribute it and/or modify it under
219             the same terms as the Perl 5 programming language system itself.
220              
221             =cut