File Coverage

blib/lib/Crypt/Vernam.pm
Criterion Covered Total %
statement 63 64 98.4
branch 21 28 75.0
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 98 106 92.4


line stmt bran cond sub pod time code
1             #------------------------------------------------#
2             # Vernam.pm - (C)opyright 2008 by Manuel Gebele
3             # , Germany.
4             #------------------------------------------------#
5              
6             #------------------------------------------------#
7             package Crypt::Vernam;
8             #------------------------------------------------#
9              
10 1     1   29006 use 5.008008;
  1         4  
  1         39  
11 1     1   6 use strict;
  1         1  
  1         32  
12 1     1   5 use warnings;
  1         6  
  1         35  
13 1     1   5 use Carp;
  1         1  
  1         1140  
14              
15             require Exporter;
16              
17             our @ISA = qw(Exporter);
18              
19             our @EXPORT = qw(
20             vernam_encrypt
21             vernam_decrypt
22             );
23              
24             our $VERSION = '0.03';
25              
26             #-------------------- Globals -------------------#
27              
28             my %alpha_pos_of = (
29             A => 0, N => 13,
30             B => 1, O => 14,
31             C => 2, P => 15,
32             D => 3, Q => 16,
33             E => 4, R => 17,
34             F => 5, S => 18,
35             G => 6, T => 19,
36             H => 7, U => 20,
37             I => 8, V => 21,
38             J => 9, W => 22,
39             K => 10, X => 23,
40             L => 11, Y => 24,
41             M => 12, Z => 25,
42             );
43              
44             my @alpha = sort keys %alpha_pos_of;
45              
46             #--------------- Private methods ----------------#
47              
48             ## Generates a pseudo random key for mod26 mode.
49             sub _get_key_mod26 {
50 4     4   15 my $length = shift;
51 4         5 my $key;
52              
53 4         82 $key .= $alpha[int rand 26] for 1..$length;
54              
55 4         17 return $key;
56             }
57              
58             ## Shift positions and get character at new position.
59             sub _shift_char {
60 26     26   1188 my ($char, $key_char, $action) = @_;
61              
62 26         40 my $pos1 = $alpha_pos_of{uc $char};
63 26         36 my $pos2 = $alpha_pos_of{uc $key_char};
64              
65             # Handle non-alpha characters...
66 26 100       101 return $char unless defined $pos1;
67            
68 23 100       55 my $new_char = $action eq 'encrypt'
69             ?
70             $alpha[($pos1 + $pos2) % 26]
71             :
72             $alpha[($pos1 - $pos2) % 26]
73             ;
74              
75             # Handle lower-case letters...
76 23 50       80 if ($char =~ /[a-z]/) {
77 23         66 return lc $new_char;
78             }
79              
80 0         0 return $new_char;
81             }
82              
83             ## Encrypt/Decrypt @data using mod26 mode.
84             sub _vernam_mod26 {
85 4     4   527 my @data = split //, shift;
86 4         15 my @key = split //, shift;
87 4         8 my $action = shift;
88 4         5 my $ind = 0;
89 4         5 my $retval;
90              
91 4         9 for my $char (@data) {
92 22         43 $retval .=
93             _shift_char(
94             $char, # plain/cipher char
95             $key[$ind], # key char
96             $action
97             );
98              
99 22         36 $ind++;
100             }
101              
102 4         16 return $retval;
103             }
104              
105             ## Generates a pseudo random key for xor mode.
106             sub _get_key_xor {
107 4     4   292 my $length = shift;
108 4         5 my $key;
109              
110 4         28 $key .= chr rand 256 for 1..$length;
111              
112 4         13 return $key;
113             }
114              
115             ## Encrypt/Decrypt @data using xor mode.
116             sub _vernam_xor {
117 4     4   378 my ($data, $key) = @_;
118 4         5 my $retval;
119              
120 4         10 $retval = $data ^ $key;
121              
122 4         12 return $retval;
123             }
124              
125             ## Help function for vernam_encrypt and vernam_decrypt
126             sub _check_args {
127 4     4   7 my ($mode, $data, $key) = @_;
128 4         8 my $length = length $data;
129              
130 4 50       36 croak "Illegal encryption/decryption mode"
131             if $mode !~ /mod26|xor/i;
132 4 50       11 croak "Missing plain/ciphertext string"
133             if !defined $data;
134 4 50       12 croak "Empty plain/ciphertext string"
135             if $length <= 0;
136              
137 4 100       32 return ($mode, $data)
138             if (caller(1))[3] !~ /decrypt$/;
139            
140             # Only required for vernam_decrypt...
141 2 50       8 croak "Missing decryption key"
142             if !defined $key;
143            
144 2         4 my $klength = length $key;
145            
146 2 50       8 croak "The encryption key must have the "
147             . "same length as the ciphertext string"
148             if $length != $klength;
149              
150 2 100       8 if ($mode =~ /mod26/i) {
151 1         16 for (split //, $key) {
152 6 50       23 croak "Invalid mod26 key"
153             if !/[a-z]/i;
154             }
155             }
156            
157 2         7 return ($mode, $data, $key);
158             }
159              
160             #---------------- Public methods ----------------#
161              
162             sub vernam_encrypt {
163 2     2 1 906 my ($mode, $plaintext) = _check_args(@_);
164 2         4 my ($ciphertext, $key);
165              
166 2         15 my $length = length $plaintext;
167              
168 2 100       10 $key = $mode =~ /mod26/i
169             ?
170             _get_key_mod26($length)
171             :
172             _get_key_xor($length)
173             ;
174              
175 2 100       10 $ciphertext = $mode =~ /mod26/i
176             ?
177             _vernam_mod26($plaintext, $key, 'encrypt')
178             :
179             _vernam_xor($plaintext, $key)
180             ;
181              
182 2         10 return ($ciphertext, $key);
183             }
184              
185             sub vernam_decrypt {
186 2     2 1 12 my ($mode, $ciphertext, $key) = _check_args(@_);
187 2         3 my $plaintext;
188              
189 2 100       33 $plaintext = $mode =~ /mod26/i
190             ?
191             _vernam_mod26($ciphertext, $key, 'decrypt')
192             :
193             _vernam_xor($ciphertext, $key)
194             ;
195              
196 2         8 return $plaintext;
197             }
198              
199             1;
200              
201             =head1 NAME
202              
203             Crypt::Vernam - Perl implementation of the Vernam cipher
204              
205             =head1 SYNOPSIS
206              
207             use Crypt::Vernam;
208              
209             # mod26 mode
210             my ($ciphertext, $key) = vernam_encrypt('mod26', 'Vernam');
211             my $plaintext = vernam_decrypt('mod26', $ciphertext, $key);
212              
213             # xor mode
214             ($ciphertext, $key) = vernam_encrypt('xor', 'Vernam');
215             $plaintext = vernam_decrypt('xor', $ciphertext, $key);
216              
217             =head1 DESCRIPTION
218              
219             The Crypt::Vernam module allows you to do a simple but robust
220             encryption/decryption, with the algorithm of Gilbert Sandford, Vernam.
221             This kind of encryption is truly unbreakable as long the key is
222             maintained a secret.
223              
224             See the README file that came with the Crypt::Vigenere package for
225             more information.
226              
227             =head2 Public methods
228              
229             =over
230              
231             =item B
232              
233             The C method is called to encrypt the $plaintext
234             string, using $mode (mod26 or xor).
235              
236             =item B
237              
238             The C method is called to decrypt the $ciphertext
239             string, using $mode (mod26 or xor) and decryption key $key.
240              
241             =back
242              
243             =head1 EXPORT
244              
245             B
246             B
247              
248             =head1 AUTHOR
249              
250             Manuel Gebele, Eforensixs[at]gmx.deE
251              
252             =head1 COPYRIGHT AND LICENSE
253              
254             Copyright (C) 2008 by Manuel Gebele.
255              
256             This library is free software; you can redistribute it and/or modify
257             it under the same terms as Perl itself, either Perl version 5.8.8 or,
258             at your option, any later version of Perl 5 you may have available.
259              
260              
261             =cut