File Coverage

blib/lib/Crypt/TEA_PP.pm
Criterion Covered Total %
statement 100 109 91.7
branch 12 30 40.0
condition 2 6 33.3
subroutine 17 18 94.4
pod 3 6 50.0
total 134 169 79.2


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