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   428 use strict;
  1         1  
  1         31  
6 1     1   3 use warnings;
  1         1  
  1         23  
7 1     1   13 use utf8;
  1         1  
  1         4  
8 1     1   424 use integer;
  1         7  
  1         3  
9              
10 1     1   20 use Carp;
  1         2  
  1         51  
11 1     1   4 use List::Util qw(all);
  1         1  
  1         85  
12 1     1   356 use Scalar::Util::Numeric qw(isint);
  1         484  
  1         52  
13              
14             our $VERSION = '0.0308'; # VERSION
15              
16 1     1   5 use Config;
  1         0  
  1         57  
17             BEGIN {
18 1 50   1   399 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   1702 use constant keysize => $KEY_SIZE;
  1         1  
  1         50  
35              
36              
37 1     1   2 use constant blocksize => $BLOCK_SIZE;
  1         1  
  1         632  
38              
39              
40             sub new {
41 2     2 1 873 my $class = shift;
42 2         4 my $key = shift;
43 2   33     10 my $rounds = shift // $ROUNDS;
44 2         2 my $tea_key;
45              
46 2 50       4 croak( 'key is required' ) if not defined $key;
47              
48 2 50       6 if ( my $ref_of_key = ref( $key ) ) {
49              
50 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';
51 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  
52 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  
53              
54 0         0 $tea_key = $key;
55              
56             } else {
57              
58 2 50       6 croak( sprintf( 'key must be a %d-byte-long STRING or a reference of ARRAY', $KEY_SIZE ) ) if length $key != $KEY_SIZE;
59              
60 2         3 $tea_key = key_setup($key);
61              
62             }
63              
64 2 50       9 croak( 'rounds must be a positive NUMBER' ) if isint( $rounds ) != 1;
65              
66 2         5 my $self = {
67             key => $tea_key,
68             rounds => $rounds,
69             };
70 2   33     13 bless $self, ref($class) || $class;
71             }
72              
73              
74             sub encrypt {
75 2     2 1 740 my $self = shift;
76 2         4 my $plain_text = shift;
77 2 50       8 croak( sprintf( 'plain_text size must be %d bytes', $BLOCK_SIZE) ) if length($plain_text) != $BLOCK_SIZE;
78 2         6 my @block = unpack 'N*', $plain_text;
79 2         7 my $cipher_text_ref = $self->encrypt_block( \@block );
80 2         3 return pack( 'N*', @{$cipher_text_ref} );
  2         16  
81             }
82              
83              
84             sub decrypt {
85 2     2 1 1086 my $self = shift;
86 2         4 my $cipher_text = shift;
87 2 50       6 croak( sprintf( 'cipher_text size must be %d bytes', $BLOCK_SIZE) ) if length($cipher_text) != $BLOCK_SIZE;
88 2         7 my @block = unpack 'N*', $cipher_text;
89 2         5 my $plain_text_ref = $self->decrypt_block( \@block );
90 2         3 return pack( 'N*', @{$plain_text_ref} );
  2         7  
91             }
92              
93             sub encrypt_block {
94 2     2 0 2 my $self = shift;
95 2         3 my $block_ref = shift;
96 2         6 my $key_ref = $self->{key};
97              
98 2 50       3 croak( sprintf( 'block must has %d elements', $ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) != $ELEMENTS_IN_BLOCK;
  2         5  
99 2 50       3 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         6  
100              
101 2         2 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         7  
  2         4  
102 2         20 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         16  
  2         4  
103 2         4 my $sumation = 0 & 0xffff_ffff;
104 2         2 my $delta = $DELTA & 0xffff_ffff;
105 2         5 for my $i ( 0 .. $self->{rounds}-1 ) {
106 64         53 $sumation = ( $sumation + $delta ) & 0xffff_ffff;
107 64         92 $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;
108 64         691 $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;
109             }
110 2         8 return \@block;
111             }
112              
113             sub decrypt_block {
114 2     2 0 3 my $self = shift;
115 2         2 my $block_ref = shift;
116 2         3 my $key_ref = $self->{key};
117              
118 2 50       2 croak( sprintf( 'block must has %d elements', $ELEMENTS_IN_BLOCK ) ) if scalar( @{ $block_ref } ) != $ELEMENTS_IN_BLOCK;
  2         5  
119 2 50       2 croak( sprintf( 'key must has %d elements', $ELEMENTS_IN_KEY ) ) if scalar( @{ $key_ref } ) != $ELEMENTS_IN_KEY;
  2         5  
120              
121 2         2 my @block = map { $_ & 0xffff_ffff } @{ $block_ref };
  4         7  
  2         4  
122 2         2 my @key = map { $_ & 0xffff_ffff } @{ $key_ref };
  8         10  
  2         3  
123 2         3 my $sumation = $SUMATION & 0xffff_ffff;
124 2         2 my $delta = $DELTA & 0xffff_ffff;
125 2         5 for my $i ( 0 .. $self->{rounds}-1 ) {
126 64         99 $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;
127 64         94 $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;
128 64         62 $sumation = ( $sumation - $delta ) & 0xffff_ffff;
129             }
130 2         5 return \@block;
131             }
132              
133             sub key_setup {
134 2     2 0 3 my $key_str = shift;
135 2 50       4 croak( sprintf( 'key must be %s bytes long', $KEY_SIZE ) ) if length( $key_str ) != $KEY_SIZE;
136 2         8 my @tea_key = unpack 'N*', $key_str;
137 2         4 return \@tea_key;
138             }
139              
140              
141             1;
142              
143             __END__