File Coverage

blib/lib/Crypt/XXTEA_PP.pm
Criterion Covered Total %
statement 120 129 93.0
branch 13 32 40.6
condition 1 3 33.3
subroutine 18 19 94.7
pod 3 6 50.0
total 155 189 82.0


line stmt bran cond sub pod time code
1             package Crypt::XXTEA_PP;
2              
3             # ABSTRACT: Pure Perl Implementation of Corrected Block Tiny Encryption Algorithm
4              
5 1     1   483 use strict;
  1         2  
  1         38  
6 1     1   3 use warnings;
  1         1  
  1         50  
7 1     1   15 use utf8;
  1         2  
  1         5  
8 1     1   425 use integer;
  1         7  
  1         3  
9              
10 1     1   21 use Carp;
  1         1  
  1         67  
11 1     1   5 use List::Util qw(all);
  1         1  
  1         96  
12 1     1   479 use Scalar::Util::Numeric qw(isint);
  1         476  
  1         58  
13              
14             our $VERSION = '0.0102'; # VERSION
15              
16 1     1   4 use Config;
  1         1  
  1         53  
17             BEGIN {
18 1 50   1   434 if ( not defined $Config{use64bitint} ) {
19 0         0 require bigint;
20 0         0 bigint->import;
21             }
22             }
23              
24              
25             my $DELTA = 0x9e3779b9;
26             my $FACTOR = 4;
27             my $KEY_SIZE = 16;
28             my $ELEMENTS_IN_KEY = $KEY_SIZE / $FACTOR;
29             my $MIN_BLOCK_SIZE = 8;
30             my $MIN_ELEMENTS_IN_BLOCK = $MIN_BLOCK_SIZE / $FACTOR;
31              
32              
33 1     1   2115 use constant keysize => $KEY_SIZE;
  1         1  
  1         51  
34              
35              
36 1     1   4 use constant blocksize => $MIN_BLOCK_SIZE;
  1         1  
  1         873  
37              
38              
39             sub new {
40 2     2 1 799 my $class = shift;
41 2         4 my $key = shift;
42 2         2 my $xxtea_key;
43 2 50       6 croak( 'key is required' ) if not defined $key;
44 2 50       7 if ( my $ref_of_key = ref( $key ) ) {
45 0 0       0 croak( sprintf( 'key must be a %d-byte-long STRING or a reference of ARRAY', $KEY_SIZE ) ) if not $ref_of_key eq 'ARRAY';
46 0 0       0 croak( sprintf( 'key must has %d elements if key is a reference of ARRAY', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key } ) != $ELEMENTS_IN_KEY;
  0         0  
47 0 0   0   0 croak( 'each element of key must be a 32bit Integer if key is a reference of ARRAY' ) if not all { isint( $_ ) != 0 } @{ $key };
  0         0  
  0         0  
48 0         0 $xxtea_key = $key;
49             } else {
50 2 50       7 croak( sprintf( 'key must be a %d-byte-long STRING or a reference of ARRAY', $KEY_SIZE ) ) if length $key != $KEY_SIZE;
51 2         5 $xxtea_key = key_setup($key);
52             }
53 2         4 my $self = {
54             key => $xxtea_key,
55             };
56 2   33     15 bless $self, ref($class) || $class;
57             }
58              
59              
60             sub encrypt {
61 2     2 1 586 my $self = shift;
62 2         4 my $plain_text = shift;
63              
64 2 50       7 croak( sprintf( 'plain_text size must be at least %d bytes', $MIN_BLOCK_SIZE) ) if length($plain_text) < $MIN_BLOCK_SIZE;
65 2 50       12 croak( sprintf( 'plain_text size must be a multiple of %d bytes', $FACTOR) ) if length($plain_text) % $FACTOR != 0;
66              
67 2         7 my @block = unpack 'N*', $plain_text;
68 2         4 my $cipher_text_ref = $self->encrypt_block( \@block );
69 2         1 return pack( 'N*', @{$cipher_text_ref} );
  2         11  
70             }
71              
72              
73             sub decrypt {
74 2     2 1 547 my $self = shift;
75 2         2 my $cipher_text = shift;
76              
77 2 50       5 croak( sprintf( 'cipher_text size must be at least %d bytes', $MIN_BLOCK_SIZE) ) if length($cipher_text) < $MIN_BLOCK_SIZE;
78 2 50       5 croak( sprintf( 'cipher_text size must be a multiple of %d bytes', $FACTOR) ) if length($cipher_text) % $FACTOR != 0;
79              
80 2         5 my @block = unpack 'N*', $cipher_text;
81 2         6 my $plain_text_ref = $self->decrypt_block( \@block );
82 2         2 return pack( 'N*', @{$plain_text_ref} );
  2         5  
83             }
84              
85             sub encrypt_block {
86 2     2 0 2 my $self = shift;
87 2         2 my $block_ref = shift;
88 2         6 my $key_ref = $self->{key};
89              
90 2 50       1 croak( sprintf( 'block must has at least %d elements', $MIN_ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) < $MIN_ELEMENTS_IN_BLOCK;
  2         7  
91 2 50       2 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         5  
92              
93 2         2 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         14  
  2         2  
94 2         2 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         22  
  2         4  
95              
96 2         2 my $delta = $DELTA & 0xffff_ffff;
97 2         5 my $rounds = 6 + 52 / ( scalar @block );
98 2         2 my $sum = 0 & 0xffff_ffff;
99 2         1 my $z = $block[-1];
100 2         2 my ( $e, $p, $y );
101              
102 2         4 for ( 0 .. $rounds-1 ) {
103 64         43 $sum = ( $sum + $delta ) & 0xffff_ffff;
104 64         392 $e = ( $sum >> 2 ) & 3;
105 64         57 for ( 0 .. $#block-1 ) {
106 64         35 $p = $_;
107 64         41 $y = $block[ $p + 1 ];
108 64         63 $z = $block[ $p ] = ( $block[ $p ] + _MX( $y, $z, $sum, $p, $e, \@key ) ) & 0xffff_ffff;
109             }
110 64         46 $p += 1;
111 64         39 $y = $block[0];
112 64         58 $z = $block[-1] = ( $block[-1] + _MX( $y, $z, $sum, $p, $e, \@key ) ) & 0xffff_ffff;
113             }
114 2         5 return \@block;
115             }
116              
117             sub decrypt_block {
118 2     2 0 2 my $self = shift;
119 2         2 my $block_ref = shift;
120 2         2 my $key_ref = $self->{key};
121              
122 2 50       2 croak( sprintf( 'block must has at least %d elements', $MIN_ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) < $MIN_ELEMENTS_IN_BLOCK;
  2         4  
123 2 50       2 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         4  
124              
125 2         1 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         7  
  2         3  
126 2         1 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         8  
  2         3  
127              
128 2         2 my $delta = $DELTA & 0xffff_ffff;
129 2         3 my $rounds = 6 + 52 / ( scalar @block );
130 2         4 my $sum = ( $rounds * $delta ) & 0xffff_ffff;
131 2         1 my $y = $block[0];
132 2         2 my ( $e, $p, $z );
133 2         4 for ( 0 .. $rounds-1 ) {
134 64         39 $e = ( $sum >> 2 ) & 3;
135 64         54 for ( reverse 1 .. $#block ) {
136 64         35 $p = $_;
137 64         41 $z = $block[ $p - 1 ];
138 64         59 $y = $block[ $p ] = ( $block[ $p ] - _MX( $y, $z, $sum, $p, $e, \@key ) ) & 0xffff_ffff;
139             }
140 64         49 $p -= 1;
141 64         36 $z = $block[-1];
142 64         63 $y = $block[0] = ( $block[0] - _MX( $y, $z, $sum, $p, $e, \@key ) ) & 0xffff_ffff;
143 64         49 $sum = ( $sum - $delta ) & 0xffff_ffff;
144             }
145 2         4 return \@block;
146             }
147              
148             sub _MX {
149 256     256   188 my ( $y, $z, $sum, $p, $e, $key ) = @_;
150 256         476 return ( ( ( ( ( ( ( $z >> 5 ) & 0xffff_ffff ) ^ ( ( $y << 2 ) & 0xffff_ffff ) ) & 0xffff_ffff ) + ( ( ( ( $y >> 3 ) & 0xffff_ffff ) ^ ( ( $z << 4 ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff ) ^ ( ( ( ( $sum ^ $y ) & 0xffff_ffff ) + ( ( $key->[ ( $p & 3 ) ^ $e ] ^ $z ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff;
151             }
152              
153             sub key_setup {
154 2     2 0 1 my $key_str = shift;
155 2 50       6 croak( sprintf( 'key must be %s bytes long', $KEY_SIZE ) ) if length( $key_str ) != $KEY_SIZE;
156 2         10 my @xxtea_key = unpack 'N*', $key_str;
157 2         5 return \@xxtea_key;
158             }
159              
160              
161             1;
162              
163             __END__