File Coverage

blib/lib/Crypt/XTEA_PP.pm
Criterion Covered Total %
statement 97 106 91.5
branch 12 30 40.0
condition 2 6 33.3
subroutine 16 17 94.1
pod 3 6 50.0
total 130 165 78.7


line stmt bran cond sub pod time code
1             package Crypt::XTEA_PP;
2              
3             # ABSTRACT: Pure Perl Implementation of the eXtended Tiny Encryption Algorithm
4              
5 1     1   568 use strict;
  1         2  
  1         39  
6 1     1   4 use warnings;
  1         1  
  1         25  
7 1     1   14 use utf8;
  1         1  
  1         6  
8 1     1   444 use integer;
  1         7  
  1         4  
9              
10 1     1   22 use Carp;
  1         1  
  1         64  
11 1     1   4 use List::Util qw(all);
  1         1  
  1         93  
12              
13             our $VERSION = '0.0104'; # VERSION
14              
15 1     1   7 use Config;
  1         2  
  1         91  
16             BEGIN {
17 1 50   1   477 if ( not defined $Config{use64bitint} ) {
18 0         0 require bigint;
19 0         0 bigint->import;
20             }
21             }
22              
23              
24             my $DELTA = 0x9e3779b9;
25             my $ROUNDS = 32;
26             my $KEY_SIZE = 16;
27             my $ELEMENTS_IN_KEY = $KEY_SIZE / 4;
28             my $BLOCK_SIZE = 8;
29             my $ELEMENTS_IN_BLOCK = $BLOCK_SIZE / 4;
30              
31              
32 1     1   1983 use constant keysize => $KEY_SIZE;
  1         1  
  1         57  
33              
34              
35 1     1   3 use constant blocksize => $BLOCK_SIZE;
  1         1  
  1         677  
36              
37              
38             sub new {
39 2     2 1 614 my $class = shift;
40 2         3 my $key = shift;
41 2   33     8 my $rounds = shift // $ROUNDS;
42 2         1 my $xtea_key;
43 2 50       5 croak( 'key is required' ) if not defined $key;
44 2 50       3 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 NUMBER if key is a reference of ARRAY' ) if not all { /^-?\d+$/ } @{ $key };
  0         0  
  0         0  
48 0         0 $xtea_key = $key;
49             } else {
50 2 50       5 croak( sprintf( 'key must be a %d-byte-long STRING or a reference of ARRAY', $KEY_SIZE ) ) if length $key != $KEY_SIZE;
51 2         3 $xtea_key = key_setup($key);
52             }
53 2 50       8 croak( 'rounds must be a positive NUMBER' ) if $rounds !~ /^\d+$/;
54 2         5 my $self = {
55             key => $xtea_key,
56             rounds => $rounds,
57             };
58 2   33     10 bless $self, ref($class) || $class;
59             }
60              
61              
62             sub encrypt {
63 2     2 1 399 my $self = shift;
64 2         3 my $plain_text = shift;
65 2 50       6 croak( sprintf( 'block size must be %d', $BLOCK_SIZE) ) if length($plain_text) != $BLOCK_SIZE;
66 2         4 my @block = unpack 'N*', $plain_text;
67 2         4 my $cipher_text_ref = $self->encrypt_block( \@block );
68 2         2 return pack( 'N*', @{$cipher_text_ref} );
  2         8  
69             }
70              
71              
72             sub decrypt {
73 2     2 1 478 my $self = shift;
74 2         2 my $cipher_text = shift;
75 2 50       6 croak( sprintf( 'block size must be %d', $BLOCK_SIZE) ) if length($cipher_text) != $BLOCK_SIZE;
76 2         4 my @block = unpack 'N*', $cipher_text;
77 2         4 my $plain_text_ref = $self->decrypt_block( \@block );
78 2         2 return pack( 'N*', @{$plain_text_ref} );
  2         5  
79             }
80              
81             sub encrypt_block {
82 2     2 0 2 my $self = shift;
83 2         2 my $block_ref = shift;
84 2         4 my $key_ref = $self->{key};
85              
86 2 50       1 croak( sprintf( 'block must has %d elements', $ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) != $ELEMENTS_IN_BLOCK;
  2         5  
87 2 50       2 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         4  
88              
89 2         2 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         6  
  2         3  
90 2         2 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         6  
  2         2  
91              
92 2         2 my $sumation = 0 & 0xffff_ffff;
93 2         13 my $delta = $DELTA & 0xffff_ffff;
94              
95 2         5 for my $i ( 0 .. $self->{rounds}-1 ) {
96 64         72 $block[0] = ( $block[0] + ( ( ( ( ( ( ( ( $block[1] << 4 ) & 0xffff_ffff ) ^ ( ( $block[1] >> 5 ) & 0xffff_ffff ) ) & 0xffff_ffff ) + $block[1] ) & 0xffff_ffff ) ^ ( ( $sumation + $key[ $sumation & 3 ] ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff;
97 64         40 $sumation = ( $sumation + $delta ) & 0xffff_ffff;
98 64         80 $block[1] = ( $block[1] + ( ( ( ( ( ( ( ( $block[0] << 4 ) & 0xffff_ffff ) ^ ( ( $block[0] >> 5 ) & 0xffff_ffff ) ) & 0xffff_ffff ) + $block[0] ) & 0xffff_ffff ) ^ ( ( $sumation + $key[ ( ( $sumation >> 11 ) & 0xffff_ffff ) & 3 ] ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff;
99             }
100 2         5 return \@block;
101             }
102              
103             sub decrypt_block {
104 2     2 0 2 my $self = shift;
105 2         2 my $block_ref = shift;
106 2         2 my $key_ref = $self->{key};
107              
108 2         2 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         6  
  2         2  
109 2         2 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         404  
  2         2  
110              
111 2 50       1 croak( sprintf( 'block must has %d elements', $ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) != $ELEMENTS_IN_BLOCK;
  2         5  
112 2 50       2 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         3  
113              
114 2         2 my $delta = $DELTA & 0xffff_ffff;
115 2         2 my $sumation = ( $delta * $self->{rounds} ) & 0xffff_ffff;
116              
117 2         4 for my $i ( 0 .. $self->{rounds}-1 ) {
118 64         72 $block[1] = ( $block[1] - ( ( ( ( ( ( ( ( $block[0] << 4 ) & 0xffff_ffff ) ^ ( ( $block[0] >> 5 ) & 0xffff_ffff ) ) & 0xffff_ffff ) + $block[0] ) & 0xffff_ffff ) ^ ( ( $sumation + $key[ ( ( $sumation >> 11 ) & 0xffff_ffff ) & 3 ] ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff;
119 64         39 $sumation = ( $sumation - $delta ) & 0xffff_ffff;
120 64         78 $block[0] = ( $block[0] - ( ( ( ( ( ( ( ( $block[1] << 4 ) & 0xffff_ffff ) ^ ( ( $block[1] >> 5 ) & 0xffff_ffff ) ) & 0xffff_ffff ) + $block[1] ) & 0xffff_ffff ) ^ ( ( $sumation + $key[ $sumation & 3 ] ) & 0xffff_ffff ) ) & 0xffff_ffff ) ) & 0xffff_ffff;
121             }
122 2         5 return \@block;
123             }
124              
125             sub key_setup {
126 2     2 0 1 my $key_str = shift;
127 2 50       4 croak( sprintf( 'key must be %s bytes long', $KEY_SIZE ) ) if length( $key_str ) != $KEY_SIZE;
128 2         5 my @tea_key = unpack 'N*', $key_str;
129 2         4 return \@tea_key;
130             }
131              
132              
133             1;
134              
135             __END__