File Coverage

blib/lib/Crypt/ARIA.pm
Criterion Covered Total %
statement 93 107 86.9
branch 13 18 72.2
condition 4 9 44.4
subroutine 18 20 90.0
pod 9 14 64.2
total 137 168 81.5


line stmt bran cond sub pod time code
1 5     5   109698 use strict;
  5         12  
  5         180  
2 5     5   22 use warnings;
  5         8  
  5         272  
3             package Crypt::ARIA;
4             {
5             $Crypt::ARIA::VERSION = '0.004';
6             }
7              
8 5     5   25 use Carp qw/croak carp/;
  5         13  
  5         983  
9              
10             # ABSTRACT: Perl extension for ARIA encryption/decryption algorithm.
11              
12             require Exporter;
13              
14             our @ISA = qw(Exporter);
15              
16             # Items to export into callers namespace by default. Note: do not export
17             # names by default without a very good reason. Use EXPORT_OK instead.
18             # Do not simply export all your public functions/methods/constants.
19              
20             # This allows declaration use Crypt::ARIA ':all';
21             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
22             # will save memory.
23             our %EXPORT_TAGS = ( 'all' => [ qw(
24              
25             ) ] );
26              
27             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
28              
29             our @EXPORT = qw(
30              
31             );
32              
33             # our $VERSION = '0.01';
34              
35             require XSLoader;
36             XSLoader::load('Crypt::ARIA', $Crypt::ARIA::VERSION);
37              
38             # Preloaded methods go here.
39              
40 5     5   26 use constant BLOCKSIZE => 16;
  5         19  
  5         519  
41 5     5   44 use constant KEYSIZES => ( 128, 192, 256 );
  5         7  
  5         322  
42 5     5   25 use constant MAX_USER_KEYS => 99_999_999;
  5         11  
  5         7052  
43              
44 6     6 0 49 sub blocksize { return BLOCKSIZE; }
45 6     6 0 333 sub keysize { return max_keysize(); }
46 7     7 0 29 sub max_keysize { return (KEYSIZES)[-1] / 8; }
47 1     1 0 6 sub min_keysize { return (KEYSIZES)[0] / 8; }
48              
49             sub usage {
50 0     0 0 0 my ( $package, $filename, $line, $subr ) = caller(1);
51 0         0 $Carp::CarpLevel = 2;
52 0         0 croak "Usage: $subr(@_)";
53             }
54              
55             # new( [ key ] )
56             sub new {
57 27     27 1 23439 my $this = shift;
58 27   33     135 my $class = ref($this) || $this;
59              
60 27         47 my $self = { };
61 27         61 bless $self, $class;
62              
63 27 100       72 if ( @_ ) {
64 4         12 $self->set_key( shift );
65             }
66              
67 26         94 return $self;
68             }
69              
70             sub has_key {
71 0     0 1 0 my $self = shift;
72              
73 0         0 return defined( $self->{key} );
74             }
75              
76             sub set_key {
77 26     26 1 574 my $self = shift;
78 26         35 my $key = shift;
79              
80 26         54 my $len = 8 * length $key;
81 26 100       59 unless ( grep { $len == $_ } KEYSIZES ) {
  78         788  
82 1         312 croak 'Keysize should be one of '.join(',', KEYSIZES).' bits.'
83             .'(current keysize = '.$len.' bits)';
84             }
85 25         81 $self->{key} = $key;
86 25         47 $self->{keybits} = 8 * length $key;
87              
88 25         396 ( $self->{enc_round}, $self->{enc_roundkey} ) = _setup_enc_key( $self->{key}, $self->{keybits} );
89 25         169 ( $self->{dec_round}, $self->{dec_roundkey} ) = _setup_dec_key( $self->{key}, $self->{keybits} );
90              
91 25         52 return $self;
92             }
93              
94             sub set_key_hexstring {
95 20     20 1 35 my $self = shift;
96 20         26 my $key = shift;
97              
98 20         51 $key =~ s/\s+//g;
99 20         97 $self->set_key( pack("H*", $key) );
100              
101 20         74 return $self;
102             }
103              
104             sub unset_key {
105 1     1 1 861 my $self = shift;
106              
107 1         5 undef $self->{key};
108 1         3 undef $self->{enc_round};
109 1         2 undef $self->{enc_roundkey};
110 1         31 undef $self->{dec_round};
111 1         3 undef $self->{dec_roundkey};
112              
113 1         3 return $self;
114             }
115              
116             # one block
117             sub encrypt {
118 117     117 1 1225 my $self = shift;
119 117         130 my $data = shift;
120              
121 117 100 66     507 unless ( defined $self->{enc_roundkey} and defined $self->{enc_round} ) {
122 2         486 carp 'key should be provided using set_key() or set_key_hexstring().';
123 2         262 return undef;
124             }
125              
126 115         133 my $len = length $data;
127 115 50       201 if ( $len != BLOCKSIZE ) {
128 0         0 carp 'data should be '.BLOCKSIZE.' bytes.';
129 0         0 return undef;
130             }
131              
132 115         482 my $cipher = _crypt( $data, $self->{enc_round}, $self->{enc_roundkey} );
133 115         299 return $cipher;
134             }
135              
136             sub decrypt {
137 114     114 1 7091 my $self = shift;
138 114         128 my $cipher = shift;
139              
140 114 50 33     508 unless ( defined $self->{enc_roundkey} and defined $self->{enc_round} ) {
141 0         0 carp 'key should be provided using set_key() or set_key_hexstring().';
142 0         0 return undef;
143             }
144              
145 114         132 my $len = length $cipher;
146 114 50       187 if ( $len != BLOCKSIZE ) {
147 0         0 carp 'cipher should be '.BLOCKSIZE.' bytes.';
148 0         0 return undef;
149             }
150              
151 114         1518 my $data = _crypt( $cipher, $self->{dec_round}, $self->{dec_roundkey} );
152 114         307 return $data;
153             }
154              
155             # ECB - null padding
156             sub encrypt_ecb {
157 3     3 1 16 my $self = shift;
158 3         5 my $data = shift;
159              
160 3         16 my $len = length $data;
161 3         7 my $cipher = "";
162              
163 3         6 my $i = 0;
164 3         11 while ( $i < $len ) {
165 30 100       64 my $buflen = ($len-$i) > BLOCKSIZE ? BLOCKSIZE : $len - $i;
166 30         42 my $buf = substr( $data, $i, $buflen );
167 30 50       158 if ( $buflen < BLOCKSIZE ) {
168 0         0 $buf .= "\x00" x (BLOCKSIZE - $buflen);
169             }
170 30         65 my $cipbuf = $self->encrypt( $buf );
171 30         47 $cipher .= $cipbuf;
172 30         146 $i += $buflen;
173             }
174              
175 3         10 return $cipher;
176             }
177              
178             sub decrypt_ecb {
179 3     3 1 2335 my $self = shift;
180 3         5 my $cipher = shift;
181              
182 3         5 my $len = length $cipher;
183 3 50       12 if ( $len % BLOCKSIZE ) {
184 0         0 carp 'Size of cipher is not a multiple of '.BLOCKSIZE;
185 0         0 return undef;
186             }
187              
188 3         4 my $data = "";
189              
190 3         4 my $i = 0;
191 3         624 while ( $i < $len ) {
192 30         42 my $cipbuf = substr( $cipher, $i, BLOCKSIZE );
193 30         58 my $buf = $self->decrypt( $cipbuf );
194 30         61 $data .= $buf;
195 30         66 $i += BLOCKSIZE;
196             }
197              
198 3         9 return $data;
199             }
200              
201             1;
202              
203             =pod
204              
205             =encoding UTF-8
206              
207             =head1 NAME
208              
209             Crypt::ARIA - Perl extension for ARIA encryption/decryption algorithm.
210              
211             =head1 VERSION
212              
213             version 0.004
214              
215             =head1 SYNOPSIS
216              
217             use Crypt::ARIA;
218              
219             # create an object
220             my $aria = Crypt::ARIA->new();
221             # or,
222             my $key = pack 'H*', '00112233445566778899aabbccddeeff';
223             my $aria = Crypt::ARIA->new( $key );
224              
225              
226             # set master key
227             $aria->set_key( pack 'H*', '00112233445566778899aabbccddeeff' );
228             # or
229             # (whitespace allowed)
230             $aria->set_key_hexstring( '00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff' );
231              
232              
233             # one block encryption/decryption
234             # $plaintext and $ciphertext should be of "blocksize()" bytes.
235             my $cipher = $aria->encrypt( $plain );
236             my $plain = $aria->decrypt( $cipher );
237              
238            
239             # multi block encryption/decryption
240             # simple ECB mode
241             my $cipher = $aria->encrypt_ecb( $plain );
242             my $decrypted = $aria->decrypt_ecb( $cipher );
243             # note that $decrypt may not be same as $plain, because it is appended
244             # null bytes to.
245              
246              
247             # CBC mode
248             use Crypt::CBC;
249             my $cbc = Crypt::CBC->new(
250             -cipher => Crypt::ARIA->new()->set_key( $key ),
251             -iv => $initial_vector,
252             -header => 'none';
253             -padding => 'none';
254             );
255             my $cipher = $cbc->encrypt( $plain );
256             my $plain = $cbc->decrypt( $cipher );
257              
258             =head1 DESCRIPTION
259              
260             Crypt::ARIA provides an interface between Perl and ARIA implementation
261             in C.
262              
263             ARIA is a block cipher algorithm designed in South Korea.
264             For more information about ARIA, visit links in L section.
265              
266             The C portion of this module is made by researchers of ARIA and is
267             available from the ARIA website. I had asked them and they've made sure
268             that the code is free to use.
269              
270             =head1 METHODS
271              
272             =over
273              
274             =item new
275              
276             C method creates an object.
277              
278             my $aria = Crypt::ARIA->new();
279              
280             You can give a master key as argument. The master key in ARIA should be of 16, 24, or 32 bytes.
281              
282             my $key = pack 'H*', '00112233445566778899aabbccddeeff';
283             my $aria = Crypt::ARIA->new( $key );
284              
285             =item set_key
286              
287             C sets a master key. This method returns the object itself.
288              
289             $aria->set_key( pack 'H*', '00112233445566778899aabbccddeeff' );
290              
291             =item set_key_hexstring
292              
293             C sets a master key. You can give a hexstring as
294             argument. The hexstring can include whitespaces.
295             This method returns the object itself.
296              
297             $aria->set_key_hexstring( '00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff' );
298              
299             =item unset_key
300              
301             This method removes the master key from object and return the object itsetf.
302              
303             $aria->unset_key();
304              
305             =item has_key
306              
307             This method returns true if a master key is set, false otherwise.
308              
309             =item encrypt
310              
311             C encrypts a block of plaintext.
312              
313             my $cipher = $aria->encrypt( $plain );
314              
315             $plain should be of exactly 16 bytes.
316             It returns a ciphertext of 16 bytes.
317             If you want to encrypt a text of different length,
318             you have to choose the operation mode and the padding method.
319             You may implement them by yourself or use another module for them.
320              
321             C is designed to be compatible with L.
322             Therefore, you can use C to use CBC mode with several
323             padding methods.
324              
325             use Crypt::CBC;
326             my $cbc = Crypt::CBC->new(
327             -cipher => Crypt::ARIA->new()->set_key( $key ),
328             -iv => $initial_vector,
329             -header => 'none';
330             -padding => 'none';
331             );
332             my $cipher = $cbc->encrypt( $plain );
333             my $plain = $cbc->decrypt( $cipher );
334              
335             =item decrypt
336              
337             C decrypts a block of ciphertext.
338              
339             my $plain = $aria->decrypt( $cipher );
340              
341             $cipher should be of exactly 16 bytes.
342             Again, you have to use another module to decrypt multi-block
343             message.
344              
345             =item encrypt_ecb
346              
347             This method encrypts a plaintext of arbitrary length.
348              
349             my $cipher = $aria->encrypt_ecb( $plain );
350              
351             It returns the ciphertext whose length is multiple of 16 bytes.
352              
353             NOTE: If the length of $plain is not n-times of 16 exactly,
354             C appends null bytes to fill it. If the length
355             is n-times of 16 exactly, $plain would be untouched. This means
356             you should have to deliver the original length of $plain to the
357             receiver. You had better use other module like L that
358             provides advanced operation mode and padding method.
359             This method is just for test purpose.
360              
361             =item decrypt_ecb
362              
363             This method decrypts a multi-block ciphertext.
364              
365             my $decrypted = $aria->decrypt_ecb( $cipher );
366              
367             As described in L, $decrypted may contain a sequence
368             of null bytes in its end. You should remove them yourself.
369              
370             =back
371              
372             =head1 SEE ALSO
373              
374             L, L
375              
376             L
377              
378             L
379              
380             IETF RFC 5794 : A Description of the ARIA Encryption Algorithm
381             L
382              
383             =head1 AUTHOR
384              
385             Geunyoung Park
386              
387             =head1 COPYRIGHT AND LICENSE
388              
389             This software is copyright (c) 2013 by Geunyoung Park.
390              
391             This is free software; you can redistribute it and/or modify it under
392             the same terms as the Perl 5 programming language system itself.
393              
394             =cut
395              
396             __END__