line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Crypt::Enigma; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
$VERSION = '1.4'; |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
8637
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2900
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub new { |
8
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
9
|
0
|
0
|
|
|
|
|
my $args = ref($_[0]) ? shift : {@_}; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Setup the object |
12
|
0
|
|
|
|
|
|
my $self = { |
13
|
|
|
|
|
|
|
_rotorObjects => undef, |
14
|
|
|
|
|
|
|
_reflectorObject => undef, |
15
|
|
|
|
|
|
|
_stecker => undef, |
16
|
|
|
|
|
|
|
_settings => [], |
17
|
|
|
|
|
|
|
_debug => 0, |
18
|
|
|
|
|
|
|
}; |
19
|
0
|
|
|
|
|
|
bless $self, $class; |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
|
|
|
$self->_init( $args ); |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
|
return( $self ); |
24
|
|
|
|
|
|
|
}; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _init { |
27
|
0
|
|
|
0
|
|
|
my $self = shift; |
28
|
0
|
|
|
|
|
|
my $args = shift; |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
foreach( keys %{$args} ) { |
|
0
|
|
|
|
|
|
|
31
|
0
|
0
|
0
|
|
|
|
if( ($_ =~ /^(rotors|startletters|ringsettings|stecker)$/) && (ref($args->{$_}) ne 'ARRAY') ) { |
32
|
0
|
|
|
|
|
|
$self->_printDebug( "Argument '$_' should be an array reference (using defaults)" ); |
33
|
0
|
|
|
|
|
|
delete( ${$args}{$_} ); |
|
0
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
}; |
35
|
|
|
|
|
|
|
}; |
36
|
|
|
|
|
|
|
|
37
|
0
|
|
0
|
|
|
|
my $rotors = $args->{rotors} || [ 'RotorI', 'RotorII', 'RotorIII' ]; |
38
|
0
|
|
0
|
|
|
|
my $startletters = $args->{startletters} || [ 'Z', 'A', 'A' ]; |
39
|
0
|
|
0
|
|
|
|
my $rings = $args->{ringsettings} || [ 0, 0, 0 ]; |
40
|
0
|
|
0
|
|
|
|
my $reflector = $args->{reflector} || 'ReflectorB'; |
41
|
0
|
|
0
|
|
|
|
my $stecker = $args->{stecker} || []; |
42
|
|
|
|
|
|
|
|
43
|
0
|
0
|
|
|
|
|
if( @{$rotors} < 3 ) { |
|
0
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
$self->_printDebug( 'A minimum of 3 rotors must be defined (using defaults)' ); |
45
|
0
|
|
|
|
|
|
my @misc_rotors = ( 'RotorV', 'RotorVI', 'RotorVII' ); |
46
|
0
|
|
|
|
|
|
while( @{$rotors} < 3 ) { |
|
0
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
push @{$rotors}, shift @misc_rotors; |
|
0
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
}; |
49
|
|
|
|
|
|
|
}; |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
|
my $count = 0; |
52
|
0
|
|
|
|
|
|
foreach( @{$rotors} ) { |
|
0
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
|
push @{$self->{_settings}}, [ $_, $startletters->[$count], $rings->[$count] ]; |
|
0
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
$count++; |
55
|
|
|
|
|
|
|
}; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Create Reflector |
58
|
0
|
|
|
|
|
|
$self->setReflector( $reflector ); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Setup Steckerboard |
61
|
0
|
|
|
|
|
|
$self->setSteckerBoard( $stecker ); |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
return( $self ); |
64
|
|
|
|
|
|
|
}; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub getRotorNames { |
68
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
69
|
0
|
|
|
|
|
|
my @names; |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
foreach( $self->_getRotorObjects ) { |
72
|
0
|
|
|
|
|
|
push @names, $_->getName; |
73
|
|
|
|
|
|
|
}; |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
return( @names ); |
76
|
|
|
|
|
|
|
}; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub getStartLetters { |
79
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
80
|
0
|
|
|
|
|
|
my @letters; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
foreach( $self->_getRotorObjects ) { |
83
|
0
|
|
|
|
|
|
push @letters, $_->getStartLetter; |
84
|
|
|
|
|
|
|
}; |
85
|
0
|
|
|
|
|
|
return( @letters ); |
86
|
|
|
|
|
|
|
}; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub getRingSettings { |
89
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
90
|
0
|
|
|
|
|
|
my @rings; |
91
|
0
|
|
|
|
|
|
foreach( $self->_getRotorObjects ) { |
92
|
0
|
|
|
|
|
|
push @rings, $_->getRingSetting; |
93
|
|
|
|
|
|
|
}; |
94
|
0
|
|
|
|
|
|
return( @rings ); |
95
|
|
|
|
|
|
|
}; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub getReflector { |
98
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
99
|
0
|
|
|
|
|
|
return( $self->{_reflectorObject}->getName ); |
100
|
|
|
|
|
|
|
}; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub setSteckerBoard { |
103
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
104
|
0
|
|
|
|
|
|
my $stecker = shift; |
105
|
|
|
|
|
|
|
|
106
|
0
|
0
|
|
|
|
|
unless( (@{$stecker} % 2) == 0 ) { |
|
0
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
$self->_printDebug( 'Odd number of letters in setSteckerBoard (disabling Steckerboard)' ); |
108
|
0
|
|
|
|
|
|
return; |
109
|
|
|
|
|
|
|
}; |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
|
for(my $count = 0; $count < @{$stecker}; $count = $count+2 ) { |
|
0
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
my $letter1 = uc( $stecker->[$count] ); |
113
|
0
|
|
|
|
|
|
my $letter2 = uc( $stecker->[$count+1] ); |
114
|
0
|
|
|
|
|
|
$self->{_stecker}->{$letter1} = $letter2; |
115
|
0
|
|
|
|
|
|
$self->{_stecker}->{$letter2} = $letter1; |
116
|
|
|
|
|
|
|
}; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
return; |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub dumpSettings { |
122
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
print STDERR "Rotors:\t\t". join( ' ', $self->getRotorNames ) ."\n"; |
125
|
0
|
|
|
|
|
|
print STDERR "Start:\t\t". join( ' ', $self->getStartLetters ) ."\n"; |
126
|
0
|
|
|
|
|
|
print STDERR "Rings:\t\t". join( ' ', $self->getRingSettings ) ."\n"; |
127
|
0
|
|
|
|
|
|
print STDERR "Reflector:\t". $self->getReflector ."\n"; |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
return; |
130
|
|
|
|
|
|
|
}; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub setRotor { |
133
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
134
|
0
|
|
|
|
|
|
my $rotorName = shift; |
135
|
0
|
|
|
|
|
|
my $startLetter = uc( shift ); |
136
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
137
|
0
|
|
|
|
|
|
my $rotorNumber = shift; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Do some checking |
140
|
0
|
0
|
0
|
|
|
|
unless( defined($rotorName) && ($rotorName =~ /^Rotor(I|II|III|IV|V|VI|VII|VIII|Beta|Gamma)$/) ) { |
141
|
0
|
|
|
|
|
|
$self->_printDebug( 'Invalid rotor name (using default \'RotorI\')' ); |
142
|
0
|
|
|
|
|
|
$rotorName = 'RotorI'; |
143
|
|
|
|
|
|
|
}; |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
0
|
|
|
|
unless( defined($startLetter) && $startLetter =~ /^[A-Z]$/ ) { |
146
|
0
|
|
|
|
|
|
$self->_printDebug( "Invalid start letter (using default 'A' for $rotorName)" ); |
147
|
0
|
|
|
|
|
|
$startLetter = 'A'; |
148
|
|
|
|
|
|
|
}; |
149
|
|
|
|
|
|
|
|
150
|
0
|
0
|
0
|
|
|
|
unless( defined($ringSetting) && ($ringSetting =~ /[0-9]$/) && ($ringSetting >= 0) && ($ringSetting <= 25) ) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
151
|
0
|
|
|
|
|
|
$self->_printDebug( "Invalid ring setting (using default '0' for $rotorName)" ); |
152
|
0
|
|
|
|
|
|
$ringSetting = 0; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
0
|
0
|
0
|
|
|
|
unless( defined($rotorNumber) && ($rotorNumber > 0) && ($rotorNumber < 6) ) { |
|
|
|
0
|
|
|
|
|
156
|
0
|
|
|
|
|
|
$self->_printDebug( "Invalid rotor number (failed to add rotor $rotorName)" ); |
157
|
0
|
|
|
|
|
|
return( 0 ); |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
my $className = 'Crypt::Enigma::Rotors::'.$rotorName; |
161
|
0
|
|
|
|
|
|
my $rotorObj = $className->new( $startLetter, $ringSetting ); |
162
|
0
|
|
|
|
|
|
$self->_storeRotorObject( $rotorObj, $rotorNumber-1 ); |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
return( 1 ); |
165
|
|
|
|
|
|
|
}; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub setReflector { |
169
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
170
|
0
|
|
|
|
|
|
my $reflector = shift; |
171
|
|
|
|
|
|
|
|
172
|
0
|
0
|
|
|
|
|
unless( $reflector =~ /^Reflector(B|Bdunn|C|Cdunn)$/ ) { |
173
|
0
|
|
|
|
|
|
$self->_printDebug( 'Invalid reflector name (using default \'ReflectorB\')' ); |
174
|
0
|
|
|
|
|
|
$reflector = 'ReflectorB'; |
175
|
|
|
|
|
|
|
}; |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
my $reflectorClass = 'Crypt::Enigma::Reflectors::' . $reflector; |
178
|
0
|
|
|
|
|
|
my $reflectorObj = $reflectorClass->new; |
179
|
0
|
|
|
|
|
|
$self->_storeReflectorObject( $reflectorObj ); |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
return( 1 ); |
182
|
|
|
|
|
|
|
}; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub cipher { |
186
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
187
|
0
|
|
|
|
|
|
my $plainText = uc(shift); |
188
|
0
|
|
|
|
|
|
my $cipherText = ''; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# setup the rotors |
191
|
0
|
|
|
|
|
|
my $count = 1; |
192
|
0
|
|
|
|
|
|
foreach( @{$self->{_settings}} ) { |
|
0
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# setRotor(rotorName, startLetter, ringSetting, rotorNumber) |
194
|
0
|
|
|
|
|
|
$self->setRotor( $_->[0], , $_->[1], $_->[2], $count); |
195
|
0
|
|
|
|
|
|
$count++; |
196
|
|
|
|
|
|
|
}; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
foreach my $letter ( split('', $plainText) ) { |
199
|
|
|
|
|
|
|
# next if the text is not alpha |
200
|
0
|
0
|
|
|
|
|
if( $letter !~ /[A-Z]/ ) { |
201
|
0
|
|
|
|
|
|
next; |
202
|
|
|
|
|
|
|
}; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Stecker |
205
|
0
|
|
|
|
|
|
$letter = $self->_performSteckerSwap( $letter ); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# fwd cycle |
208
|
0
|
|
|
|
|
|
my $count = 0; |
209
|
0
|
|
|
|
|
|
foreach( $self->_getRotorObjects ) { |
210
|
|
|
|
|
|
|
# We always rotate the first scrambler |
211
|
0
|
0
|
|
|
|
|
if( $count == 0 ) { |
212
|
0
|
|
|
|
|
|
$_->_rotateDisk; |
213
|
|
|
|
|
|
|
}; |
214
|
0
|
|
|
|
|
|
$letter = $_->fwdCipher( $letter ); |
215
|
|
|
|
|
|
|
# rotate the next disk, if the flag is set |
216
|
0
|
0
|
0
|
|
|
|
if( $_->_getFlag('rotateNext') && ($count != 2) ) { |
217
|
0
|
|
|
|
|
|
$self->_cycleNextRotor( $self->_getRotorObject($count+1) ); |
218
|
0
|
|
|
|
|
|
$_->_setFlag( rotateNext => 0 ); |
219
|
|
|
|
|
|
|
}; |
220
|
0
|
|
|
|
|
|
$count++; |
221
|
|
|
|
|
|
|
}; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# reflector |
224
|
0
|
|
|
|
|
|
$letter = $self->_reflect( $letter ); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# rev cycle |
227
|
0
|
|
|
|
|
|
foreach( reverse($self->_getRotorObjects) ) { |
228
|
0
|
|
|
|
|
|
$letter = $_->revCipher( $letter ); |
229
|
|
|
|
|
|
|
}; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# Stecker |
232
|
0
|
|
|
|
|
|
$letter = $self->_performSteckerSwap( $letter ); |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$cipherText .= $letter; |
235
|
|
|
|
|
|
|
}; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# return uppercase ciphertext, like the original Enigma would do :) |
238
|
0
|
|
|
|
|
|
return( uc($cipherText) ); |
239
|
|
|
|
|
|
|
}; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub _getRotorName { |
243
|
0
|
|
|
0
|
|
|
my $self = shift; |
244
|
0
|
|
|
|
|
|
my $rotor = shift; |
245
|
0
|
|
|
|
|
|
return( $self->{settings}->{_rotorObjects}->[$rotor]->getName ); |
246
|
|
|
|
|
|
|
}; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub _getStartLetter { |
249
|
0
|
|
|
0
|
|
|
my $self = shift; |
250
|
0
|
|
|
|
|
|
my $letter = shift; |
251
|
0
|
|
|
|
|
|
return( $self->{settings}->{startletters}->[$letter] ); |
252
|
|
|
|
|
|
|
}; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub _getRingSetting { |
255
|
0
|
|
|
0
|
|
|
my $self = shift; |
256
|
0
|
|
|
|
|
|
my $ring = shift; |
257
|
0
|
|
|
|
|
|
return( $self->{settings}->{rings}->[$ring] ); |
258
|
|
|
|
|
|
|
}; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub _storeRotorObject { |
261
|
0
|
|
|
0
|
|
|
my $self = shift; |
262
|
0
|
|
|
|
|
|
my $rotorObj = shift; |
263
|
0
|
|
|
|
|
|
my $rotorNumber = shift; |
264
|
|
|
|
|
|
|
|
265
|
0
|
0
|
|
|
|
|
if( defined($rotorNumber) ) { |
266
|
0
|
|
|
|
|
|
$self->{_rotorObjects}->[$rotorNumber] = $rotorObj; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
else { |
269
|
0
|
|
|
|
|
|
push @{$self->{_rotorObjects}}, $rotorObj; |
|
0
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
}; |
271
|
|
|
|
|
|
|
|
272
|
0
|
|
|
|
|
|
return( 1 ); |
273
|
|
|
|
|
|
|
}; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub _getRotorObject { |
276
|
0
|
|
|
0
|
|
|
my $self = shift; |
277
|
0
|
|
|
|
|
|
my $rotor = shift; |
278
|
0
|
|
|
|
|
|
return( $self->{_rotorObjects}->[$rotor] ); |
279
|
|
|
|
|
|
|
}; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub _getRotorObjects { |
282
|
0
|
|
|
0
|
|
|
my $self = shift; |
283
|
0
|
|
|
|
|
|
return( @{$self->{_rotorObjects}} ); |
|
0
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
}; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub _storeReflectorObject { |
287
|
0
|
|
|
0
|
|
|
my $self = shift; |
288
|
0
|
|
|
|
|
|
my $reflectorObj = shift; |
289
|
0
|
|
|
|
|
|
$self->{_reflectorObject} = $reflectorObj; |
290
|
0
|
|
|
|
|
|
return( 1 ); |
291
|
|
|
|
|
|
|
}; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub _getReflectorObject { |
294
|
0
|
|
|
0
|
|
|
my $self = shift; |
295
|
0
|
|
|
|
|
|
return( $self->{_reflectorObject} ); |
296
|
|
|
|
|
|
|
}; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# alter the input using the reflector |
300
|
|
|
|
|
|
|
sub _reflect { |
301
|
0
|
|
|
0
|
|
|
my $self = shift; |
302
|
0
|
|
|
|
|
|
my $inputLetter = shift; |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
|
|
|
my $outputLetter = $self->_getReflectorObject->_reflect( $inputLetter ); |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
return( $outputLetter ); |
307
|
|
|
|
|
|
|
}; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# alter the letter using the Steckerboard |
310
|
|
|
|
|
|
|
sub _performSteckerSwap { |
311
|
0
|
|
|
0
|
|
|
my $self = shift; |
312
|
0
|
|
|
|
|
|
my $inputLetter = shift; |
313
|
|
|
|
|
|
|
|
314
|
0
|
0
|
|
|
|
|
if( defined($self->{_stecker}->{$inputLetter}) ) { |
315
|
0
|
|
|
|
|
|
return( $self->{_stecker}->{$inputLetter} ); |
316
|
|
|
|
|
|
|
}; |
317
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
|
return( $inputLetter ); |
319
|
|
|
|
|
|
|
}; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# Rotate the next rotor |
322
|
|
|
|
|
|
|
sub _cycleNextRotor { |
323
|
0
|
|
|
0
|
|
|
my $self = shift; |
324
|
0
|
|
|
|
|
|
my $rotorObj = shift; |
325
|
0
|
|
|
|
|
|
$rotorObj->_rotateDisk; |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
return; |
328
|
|
|
|
|
|
|
}; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub _printDebug { |
331
|
0
|
|
|
0
|
|
|
my $self = shift; |
332
|
0
|
|
|
|
|
|
my $msg = shift; |
333
|
|
|
|
|
|
|
|
334
|
0
|
0
|
|
|
|
|
if( $self->{_debug} ) { |
335
|
0
|
|
|
|
|
|
print $msg, "\n"; |
336
|
|
|
|
|
|
|
}; |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
return; |
339
|
|
|
|
|
|
|
}; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub setDebug { |
342
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
343
|
0
|
|
0
|
|
|
|
my $debug = shift || 0; |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
$self->{_debug} = $debug; |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
return; |
348
|
|
|
|
|
|
|
}; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
package Crypt::Enigma::Reflectors; |
351
|
|
|
|
|
|
|
|
352
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1638
|
|
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub _reflect { |
355
|
0
|
|
|
0
|
|
|
my $self = shift; |
356
|
0
|
|
|
|
|
|
my $inputLetter = shift; |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
|
my $intInputLetter = ord($inputLetter) - 65; |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
my $outputLetter = ${$self->{_alphabet}}[$intInputLetter]; |
|
0
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
return( $outputLetter ); |
363
|
|
|
|
|
|
|
}; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub getName { |
366
|
0
|
|
|
0
|
|
|
my $self = shift; |
367
|
0
|
|
|
|
|
|
return( $self->{_label} ); |
368
|
|
|
|
|
|
|
}; |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
package Crypt::Enigma::Reflectors::ReflectorB; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
@Crypt::Enigma::Reflectors::ReflectorB::ISA = qw(Crypt::Enigma::Reflectors); |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
sub new { |
376
|
0
|
|
|
0
|
|
|
my $class = shift; |
377
|
|
|
|
|
|
|
|
378
|
0
|
|
|
|
|
|
my $self = { |
379
|
|
|
|
|
|
|
'_label' => 'ReflectorB', |
380
|
|
|
|
|
|
|
'_alphabet' => [ |
381
|
|
|
|
|
|
|
'Y', 'R', 'U', 'H', 'Q', 'S', 'L', 'D', 'P', 'X', 'N', 'G', 'O', 'K', 'M', 'I', 'E', 'B', 'F', 'Z', 'C', 'W', 'V', 'J', 'A', 'T' |
382
|
|
|
|
|
|
|
], |
383
|
|
|
|
|
|
|
}; |
384
|
0
|
|
|
|
|
|
bless $self, $class; |
385
|
|
|
|
|
|
|
|
386
|
0
|
|
|
|
|
|
return( $self ); |
387
|
|
|
|
|
|
|
}; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
package Crypt::Enigma::Reflectors::ReflectorBdunn; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
@Crypt::Enigma::Reflectors::ReflectorBdunn::ISA = qw(Crypt::Enigma::Reflectors); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub new { |
396
|
0
|
|
|
0
|
|
|
my $class = shift; |
397
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
|
my $self = { |
399
|
|
|
|
|
|
|
'_label' => 'ReflectorBdunn', |
400
|
|
|
|
|
|
|
'_alphabet' => [ |
401
|
|
|
|
|
|
|
'E', 'N', 'K', 'Q', 'A', 'U', 'Y', 'W', 'J', 'I', 'C', 'O', 'P', 'B', 'L', 'M', 'D', 'X', 'Z', 'V', 'F', 'T', 'H', 'R', 'G', 'S' |
402
|
|
|
|
|
|
|
], |
403
|
|
|
|
|
|
|
}; |
404
|
0
|
|
|
|
|
|
bless $self, $class; |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
|
return( $self ); |
407
|
|
|
|
|
|
|
}; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
package Crypt::Enigma::Reflectors::ReflectorC; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
@Crypt::Enigma::Reflectors::ReflectorC::ISA = qw(Crypt::Enigma::Reflectors); |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub new { |
415
|
0
|
|
|
0
|
|
|
my $class = shift; |
416
|
|
|
|
|
|
|
|
417
|
0
|
|
|
|
|
|
my $self = { |
418
|
|
|
|
|
|
|
'_label' => 'ReflectorC', |
419
|
|
|
|
|
|
|
'_alphabet' => [ |
420
|
|
|
|
|
|
|
'F', 'N', 'P', 'J', 'I', 'A', 'O', 'Y', 'E', 'D', 'R', 'Z', 'X', 'W', 'G', 'C', 'T', 'K', 'U', 'Q', 'S', 'B', 'N', 'M', 'H', 'L' |
421
|
|
|
|
|
|
|
], |
422
|
|
|
|
|
|
|
}; |
423
|
0
|
|
|
|
|
|
bless $self, $class; |
424
|
|
|
|
|
|
|
|
425
|
0
|
|
|
|
|
|
return( $self ); |
426
|
|
|
|
|
|
|
}; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
package Crypt::Enigma::Reflectors::ReflectorCdunn; |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
@Crypt::Enigma::Reflectors::ReflectorCdunn::ISA = qw(Crypt::Enigma::Reflectors); |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub new { |
434
|
0
|
|
|
0
|
|
|
my $class = shift; |
435
|
|
|
|
|
|
|
|
436
|
0
|
|
|
|
|
|
my $self = { |
437
|
|
|
|
|
|
|
'_label' => 'ReflectorCdunn', |
438
|
|
|
|
|
|
|
'_alphabet' => [ |
439
|
|
|
|
|
|
|
'R', 'D', 'O', 'B', 'J', 'N', 'T', 'K', 'V', 'E', 'H', 'M', 'L', 'F', 'C', 'W', 'Z', 'A', 'X', 'G', 'Y', 'I', 'P', 'S', 'U', 'Q' |
440
|
|
|
|
|
|
|
], |
441
|
|
|
|
|
|
|
}; |
442
|
0
|
|
|
|
|
|
bless $self, $class; |
443
|
|
|
|
|
|
|
|
444
|
0
|
|
|
|
|
|
return( $self ); |
445
|
|
|
|
|
|
|
}; |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors; |
449
|
|
|
|
|
|
|
|
450
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
101
|
|
|
1
|
|
|
|
|
2898
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
sub _init { |
453
|
0
|
|
|
0
|
|
|
my $self = shift; |
454
|
0
|
|
|
|
|
|
my $startLetter = shift; |
455
|
|
|
|
|
|
|
|
456
|
0
|
|
|
|
|
|
my $intStartLetter = ord($startLetter) - 65; |
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
|
for( my $count = 0; $count < $intStartLetter; $count++ ) { |
459
|
|
|
|
|
|
|
# rotate the letters |
460
|
0
|
|
|
|
|
|
my $letter = pop @{$self->{_alphabet}}; |
|
0
|
|
|
|
|
|
|
461
|
0
|
|
|
|
|
|
unshift @{$self->{_alphabet}}, $letter; |
|
0
|
|
|
|
|
|
|
462
|
0
|
0
|
|
|
|
|
$self->{_cycleLetterPosition} == 0 ? $self->{_cycleLetterPosition} = 25 : $self->{_cycleLetterPosition}--; |
463
|
|
|
|
|
|
|
}; |
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
|
return( 0 ); |
466
|
|
|
|
|
|
|
}; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub getName { |
469
|
0
|
|
|
0
|
|
|
my $self = shift; |
470
|
0
|
|
|
|
|
|
return( $self->{_label} ); |
471
|
|
|
|
|
|
|
}; |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
sub getStartLetter { |
474
|
0
|
|
|
0
|
|
|
my $self = shift; |
475
|
0
|
|
|
|
|
|
return( $self->{_startLetter} ); |
476
|
|
|
|
|
|
|
}; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
sub getRingSetting { |
479
|
0
|
|
|
0
|
|
|
my $self = shift; |
480
|
0
|
|
|
|
|
|
return( $self->{_ringSetting} ); |
481
|
|
|
|
|
|
|
}; |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
sub fwdCipher { |
484
|
0
|
|
|
0
|
|
|
my $self = shift; |
485
|
0
|
|
|
|
|
|
my $inputLetter = shift; |
486
|
|
|
|
|
|
|
|
487
|
0
|
|
|
|
|
|
my $intInputLetter = ( ord($inputLetter) - 65 + $self->{_ringSetting} ) % 26; |
488
|
0
|
|
|
|
|
|
my $outputLetter = ${$self->{_alphabet}}[$intInputLetter]; |
|
0
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
|
return( $outputLetter ); |
491
|
|
|
|
|
|
|
}; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub revCipher { |
495
|
0
|
|
|
0
|
|
|
my $self = shift; |
496
|
0
|
|
|
|
|
|
my $inputLetter = shift; |
497
|
0
|
|
|
|
|
|
my $outputLetter; |
498
|
|
|
|
|
|
|
|
499
|
0
|
|
|
|
|
|
my $count = 0; |
500
|
0
|
|
|
|
|
|
foreach ( @{$self->{_alphabet}} ) { |
|
0
|
|
|
|
|
|
|
501
|
0
|
0
|
|
|
|
|
if( $inputLetter eq $_ ) { |
502
|
0
|
|
|
|
|
|
$outputLetter = chr((($count - $self->{_ringSetting} + 26) % 26) + 65); |
503
|
|
|
|
|
|
|
}; |
504
|
0
|
|
|
|
|
|
$count++; |
505
|
|
|
|
|
|
|
}; |
506
|
0
|
|
|
|
|
|
return( $outputLetter ); |
507
|
|
|
|
|
|
|
}; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# rotate the polyalphabetic substitution by 1 letter |
511
|
|
|
|
|
|
|
sub _rotateDisk { |
512
|
0
|
|
|
0
|
|
|
my $self = shift; |
513
|
|
|
|
|
|
|
|
514
|
0
|
|
|
|
|
|
my $letter = pop @{$self->{_alphabet}}; |
|
0
|
|
|
|
|
|
|
515
|
0
|
|
|
|
|
|
unshift @{$self->{_alphabet}}, $letter; |
|
0
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
|
517
|
0
|
0
|
|
|
|
|
if( $self->{_cycleLetterPosition} == 0 ) { |
518
|
0
|
|
|
|
|
|
$self->_setFlag( rotateNext => 1 ); |
519
|
0
|
|
|
|
|
|
$self->{_cycleLetterPosition} = 25; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
else { |
522
|
0
|
|
|
|
|
|
$self->{_cycleLetterPosition}--; |
523
|
|
|
|
|
|
|
}; |
524
|
|
|
|
|
|
|
|
525
|
0
|
|
|
|
|
|
return( 0 ); |
526
|
|
|
|
|
|
|
}; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub _setFlag { |
530
|
0
|
|
|
0
|
|
|
my $self = shift; |
531
|
0
|
|
|
|
|
|
my $flag = shift; |
532
|
0
|
|
|
|
|
|
my $bool = shift; |
533
|
|
|
|
|
|
|
|
534
|
0
|
|
|
|
|
|
$self->{flags}->{$flag} = $bool; |
535
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
|
return( 1 ); |
537
|
|
|
|
|
|
|
}; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub _getFlag { |
540
|
0
|
|
|
0
|
|
|
my $self = shift; |
541
|
0
|
|
|
|
|
|
my $flag = shift; |
542
|
|
|
|
|
|
|
|
543
|
0
|
0
|
|
|
|
|
if( defined($self->{flags}->{$flag}) ) { |
544
|
0
|
|
|
|
|
|
return( $self->{flags}->{$flag} ); |
545
|
|
|
|
|
|
|
}; |
546
|
|
|
|
|
|
|
|
547
|
0
|
|
|
|
|
|
return( 0 ); |
548
|
|
|
|
|
|
|
}; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorI; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorI::ISA = qw(Crypt::Enigma::Rotors); |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub new { |
556
|
0
|
|
|
0
|
|
|
my $class = shift; |
557
|
0
|
|
|
|
|
|
my $startLetter = shift; |
558
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
|
|
|
|
my $self = { |
561
|
|
|
|
|
|
|
'_label' => 'RotorI', |
562
|
|
|
|
|
|
|
'_cycleLetterPosition' => (16 + $ringSetting) % 25, |
563
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
564
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
565
|
|
|
|
|
|
|
'_alphabet' => [ |
566
|
|
|
|
|
|
|
'E', 'K', 'M', 'F', 'L', 'G', 'D', 'Q', 'V', 'Z', 'N', 'T', 'O', 'W', 'Y', 'H', 'X', 'U', 'S', 'P', 'A', 'I', 'B', 'R', 'C', 'J' |
567
|
|
|
|
|
|
|
] |
568
|
|
|
|
|
|
|
}; |
569
|
0
|
|
|
|
|
|
bless $self, $class; |
570
|
|
|
|
|
|
|
|
571
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
return( $self ); |
574
|
|
|
|
|
|
|
}; |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorII; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorII::ISA = qw(Crypt::Enigma::Rotors); |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
sub new { |
582
|
0
|
|
|
0
|
|
|
my $class = shift; |
583
|
0
|
|
|
|
|
|
my $startLetter = shift; |
584
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
585
|
|
|
|
|
|
|
|
586
|
0
|
|
|
|
|
|
my $self = { |
587
|
|
|
|
|
|
|
'_label' => 'RotorII', |
588
|
|
|
|
|
|
|
'_cycleLetterPosition' => (5 + $ringSetting) % 25, |
589
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
590
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
591
|
|
|
|
|
|
|
'_alphabet' => [ |
592
|
|
|
|
|
|
|
'A', 'J', 'D', 'K', 'S', 'I', 'R', 'U', 'X', 'B', 'L', 'H', 'W', 'T', 'M', 'C', 'Q', 'G', 'Z', 'N', 'P', 'Y', 'F', 'V', 'O', 'E' |
593
|
|
|
|
|
|
|
] |
594
|
|
|
|
|
|
|
}; |
595
|
0
|
|
|
|
|
|
bless $self, $class; |
596
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
598
|
|
|
|
|
|
|
|
599
|
0
|
|
|
|
|
|
return( $self ); |
600
|
|
|
|
|
|
|
}; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorIII; |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorIII::ISA = qw(Crypt::Enigma::Rotors); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
sub new { |
608
|
0
|
|
|
0
|
|
|
my $class = shift; |
609
|
0
|
|
|
|
|
|
my $startLetter = shift; |
610
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
611
|
|
|
|
|
|
|
|
612
|
0
|
|
|
|
|
|
my $self = { |
613
|
|
|
|
|
|
|
'_label' => 'RotorIII', |
614
|
|
|
|
|
|
|
'_cycleLetterPosition' => (22 + $ringSetting) % 25, |
615
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
616
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
617
|
|
|
|
|
|
|
'_alphabet' => [ |
618
|
|
|
|
|
|
|
'B', 'D', 'F', 'H', 'J', 'L', 'C', 'P', 'R', 'T', 'X', 'V', 'Z', 'N', 'Y', 'E', 'I', 'W', 'G', 'A', 'K', 'M', 'U', 'S', 'Q', 'O' |
619
|
|
|
|
|
|
|
] |
620
|
|
|
|
|
|
|
}; |
621
|
0
|
|
|
|
|
|
bless $self, $class; |
622
|
|
|
|
|
|
|
|
623
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
624
|
|
|
|
|
|
|
|
625
|
0
|
|
|
|
|
|
return( $self ); |
626
|
|
|
|
|
|
|
}; |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorIV; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorIV::ISA = qw(Crypt::Enigma::Rotors); |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
sub new { |
635
|
0
|
|
|
0
|
|
|
my $class = shift; |
636
|
0
|
|
|
|
|
|
my $startLetter = shift; |
637
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
638
|
|
|
|
|
|
|
|
639
|
0
|
|
|
|
|
|
my $self = { |
640
|
|
|
|
|
|
|
'_label' => 'RotorIV', |
641
|
|
|
|
|
|
|
'_cycleLetterPosition' => (10 + $ringSetting) % 25, |
642
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
643
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
644
|
|
|
|
|
|
|
'_alphabet' => [ |
645
|
|
|
|
|
|
|
'E', 'S', 'O', 'V', 'P', 'Z', 'J', 'A', 'Y', 'Q', 'U', 'I', 'R', 'H', 'X', 'L', 'N', 'F', 'T', 'G', 'K', 'D', 'C', 'M', 'W', 'B' |
646
|
|
|
|
|
|
|
] |
647
|
|
|
|
|
|
|
}; |
648
|
0
|
|
|
|
|
|
bless $self, $class; |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
651
|
|
|
|
|
|
|
|
652
|
0
|
|
|
|
|
|
return( $self ); |
653
|
|
|
|
|
|
|
}; |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorV; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorV::ISA = qw(Crypt::Enigma::Rotors); |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub new { |
662
|
0
|
|
|
0
|
|
|
my $class = shift; |
663
|
0
|
|
|
|
|
|
my $startLetter = shift; |
664
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
my $self = { |
667
|
|
|
|
|
|
|
'_label' => 'RotorV', |
668
|
|
|
|
|
|
|
'_cycleLetterPosition' => (0 + $ringSetting) % 25, |
669
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
670
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
671
|
|
|
|
|
|
|
'_alphabet' => [ |
672
|
|
|
|
|
|
|
'V', 'Z', 'B', 'R', 'G', 'I', 'T', 'Y', 'U', 'P', 'S', 'D', 'N', 'H', 'L', 'X', 'A', 'W', 'M', 'J', 'Q', 'O', 'F', 'E', 'C', 'K' |
673
|
|
|
|
|
|
|
] |
674
|
|
|
|
|
|
|
}; |
675
|
0
|
|
|
|
|
|
bless $self, $class; |
676
|
|
|
|
|
|
|
|
677
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
678
|
|
|
|
|
|
|
|
679
|
0
|
|
|
|
|
|
return( $self ); |
680
|
|
|
|
|
|
|
}; |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorVI; |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorVI::ISA = qw(Crypt::Enigma::Rotors); |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub new { |
690
|
0
|
|
|
0
|
|
|
my $class = shift; |
691
|
0
|
|
|
|
|
|
my $startLetter = shift; |
692
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
693
|
|
|
|
|
|
|
|
694
|
0
|
|
|
|
|
|
my $self = { |
695
|
|
|
|
|
|
|
'_label' => 'RotorVI', |
696
|
|
|
|
|
|
|
'_cycleLetterPosition' => (13 + $ringSetting) % 25, |
697
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
698
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
699
|
|
|
|
|
|
|
'_alphabet' => [ |
700
|
|
|
|
|
|
|
'J', 'P', 'G', 'V', 'O', 'U', 'M', 'F', 'Y', 'Q', 'B', 'E', 'N', 'H', 'Z', 'R', 'D', 'K', 'A', 'S', 'X', 'L', 'I', 'C', 'T', 'W' |
701
|
|
|
|
|
|
|
] |
702
|
|
|
|
|
|
|
}; |
703
|
0
|
|
|
|
|
|
bless $self, $class; |
704
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
706
|
|
|
|
|
|
|
|
707
|
0
|
|
|
|
|
|
return( $self ); |
708
|
|
|
|
|
|
|
}; |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorVII; |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorVII::ISA = qw(Crypt::Enigma::Rotors); |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
sub new { |
718
|
0
|
|
|
0
|
|
|
my $class = shift; |
719
|
0
|
|
|
|
|
|
my $startLetter = shift; |
720
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
721
|
|
|
|
|
|
|
|
722
|
0
|
|
|
|
|
|
my $self = { |
723
|
|
|
|
|
|
|
'_label' => 'RotorVII', |
724
|
|
|
|
|
|
|
'_cycleLetterPosition' => (13 + $ringSetting) % 25, |
725
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
726
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
727
|
|
|
|
|
|
|
'_alphabet' => [ |
728
|
|
|
|
|
|
|
'N', 'Z', 'J', 'H', 'G', 'R', 'C', 'X', 'M', 'Y', 'S', 'W', 'B', 'O', 'U', 'F', 'A', 'I', 'V', 'L', 'P', 'E', 'K', 'Q', 'D', 'T' |
729
|
|
|
|
|
|
|
] |
730
|
|
|
|
|
|
|
}; |
731
|
0
|
|
|
|
|
|
bless $self, $class; |
732
|
|
|
|
|
|
|
|
733
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
734
|
|
|
|
|
|
|
|
735
|
0
|
|
|
|
|
|
return( $self ); |
736
|
|
|
|
|
|
|
}; |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorVIII; |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorVIII::ISA = qw(Crypt::Enigma::Rotors); |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
sub new { |
746
|
0
|
|
|
0
|
|
|
my $class = shift; |
747
|
0
|
|
|
|
|
|
my $startLetter = shift; |
748
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
749
|
|
|
|
|
|
|
|
750
|
0
|
|
|
|
|
|
my $self = { |
751
|
|
|
|
|
|
|
'_label' => 'RotorVIII', |
752
|
|
|
|
|
|
|
'_cycleLetterPosition' => (13 + $ringSetting) % 25, |
753
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
754
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
755
|
|
|
|
|
|
|
'_alphabet' => [ |
756
|
|
|
|
|
|
|
'F', 'K', 'Q', 'H', 'T', 'L', 'X', 'O', 'C', 'B', 'J', 'S', 'P', 'D', 'Z', 'R', 'A', 'M', 'E', 'W', 'N', 'I', 'U', 'Y', 'G', 'V' |
757
|
|
|
|
|
|
|
] |
758
|
|
|
|
|
|
|
}; |
759
|
0
|
|
|
|
|
|
bless $self, $class; |
760
|
|
|
|
|
|
|
|
761
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
762
|
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
return( $self ); |
764
|
|
|
|
|
|
|
}; |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorBeta; |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorBeta::ISA = qw(Crypt::Enigma::Rotors); |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
sub new { |
774
|
0
|
|
|
0
|
|
|
my $class = shift; |
775
|
0
|
|
|
|
|
|
my $startLetter = shift; |
776
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
777
|
|
|
|
|
|
|
|
778
|
0
|
|
|
|
|
|
my $self = { |
779
|
|
|
|
|
|
|
'_label' => 'RotorBeta', |
780
|
|
|
|
|
|
|
'_cycleLetterPosition' => (13 + $ringSetting) % 25, |
781
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
782
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
783
|
|
|
|
|
|
|
'_alphabet' => [ |
784
|
|
|
|
|
|
|
'L', 'E', 'Y', 'J', 'V', 'C', 'N', 'I', 'X', 'W', 'P', 'B', 'Q', 'M', 'D', 'R', 'T', 'A', 'K', 'Z', 'G', 'F', 'U', 'H', 'O', 'S' |
785
|
|
|
|
|
|
|
] |
786
|
|
|
|
|
|
|
}; |
787
|
0
|
|
|
|
|
|
bless $self, $class; |
788
|
|
|
|
|
|
|
|
789
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
790
|
|
|
|
|
|
|
|
791
|
0
|
|
|
|
|
|
return( $self ); |
792
|
|
|
|
|
|
|
}; |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
package Crypt::Enigma::Rotors::RotorGamma; |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
@Crypt::Enigma::Rotors::RotorGamma::ISA = qw(Crypt::Enigma::Rotors); |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub new { |
802
|
0
|
|
|
0
|
|
|
my $class = shift; |
803
|
0
|
|
|
|
|
|
my $startLetter = shift; |
804
|
0
|
|
|
|
|
|
my $ringSetting = shift; |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
|
my $self = { |
807
|
|
|
|
|
|
|
'_label' => 'RotorGamma', |
808
|
|
|
|
|
|
|
'_cycleLetterPosition' => (13 + $ringSetting) % 25, |
809
|
|
|
|
|
|
|
'_ringSetting' => $ringSetting, |
810
|
|
|
|
|
|
|
'_startLetter' => $startLetter, |
811
|
|
|
|
|
|
|
'_alphabet' => [ |
812
|
|
|
|
|
|
|
'F', 'S', 'O', 'K', 'A', 'N', 'U', 'E', 'R', 'H', 'M', 'B', 'T', 'I', 'Y', 'C', 'W', 'L', 'Q', 'P', 'Z', 'X', 'V', 'G', 'J', 'D' |
813
|
|
|
|
|
|
|
] |
814
|
|
|
|
|
|
|
}; |
815
|
0
|
|
|
|
|
|
bless $self, $class; |
816
|
|
|
|
|
|
|
|
817
|
0
|
|
|
|
|
|
$self->_init( $startLetter ); |
818
|
|
|
|
|
|
|
|
819
|
0
|
|
|
|
|
|
return( $self ); |
820
|
|
|
|
|
|
|
}; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
1; |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=pod |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=head1 TITLE |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Crypt::Enigma - Perl implementation of the Enigma cipher |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=head1 DESCRIPTION |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
This module is a complete working Perl implementation of the Enigma Machine used during World War II. The cipher calculations are based on actual Enigma values and the resulting ciphered values are as would be expected from an Enigma Machine. |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
The implementation allows for all of the Rotors and Reflectors available to the real world Enigma to be used. A Steckerboard has also been implemented, allowing letter substitutions to be made. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
The list of available rotors is as follows: |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
RotorI, RotorII, RotorIII, RotorIV, RotorV, RotorVI, RotorVII, RotorVIII, RotorBeta, RotorGamma. |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
The list of available reflectors is as follows: |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
ReflectorB, ReflectorBdunn, ReflectorC, ReflectorCdunn. |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
As with the real world Enigma, a minimum of 3 and a maximum of 5 rotors along with 1 reflector may be defined for each encryption/decryption. |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=head1 SYNOPSIS |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
use Crypt::Enigma; |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
my $args = { |
856
|
|
|
|
|
|
|
rotors => [ 'RotorI', 'RotorII', 'RotorIII' ], |
857
|
|
|
|
|
|
|
startletters => [ 'A', 'B', 'C' ], |
858
|
|
|
|
|
|
|
ringsettings => [ '0', '5', '10' ], |
859
|
|
|
|
|
|
|
reflector => 'ReflectorB', |
860
|
|
|
|
|
|
|
}; |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
$enigma = Crypt::Enigma->new( $args ); |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
# Change rotor settings |
865
|
|
|
|
|
|
|
$enigma->setRotor( 'RotorVI', 'Z', '3', 1 ); |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# Set the letter substitutions |
868
|
|
|
|
|
|
|
$enigma->setSteckerBoard( [ 'G', 'C' ] ); |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
# Encode the plaintext |
871
|
|
|
|
|
|
|
$cipher_text = $enigma->cipher( $plain_text ); |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
# Decode the ciphertext |
874
|
|
|
|
|
|
|
$plain_text = $enigma->cipher( $cipher_text ); |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=head1 CLASS INTERFACE |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=head2 CONSTRUCTORS |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
A C object is created by calling the new constructor either with, or without arguments. If the constructor is called without arguments the defaults values will be used (unless these are set using the C method detailed below). |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=over 4 |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item new ( ARGS ) |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
The arguments which can be used to create a C instance are as follows: |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
-rotors |
890
|
|
|
|
|
|
|
-startletters |
891
|
|
|
|
|
|
|
-ringsettings |
892
|
|
|
|
|
|
|
-stecker |
893
|
|
|
|
|
|
|
-reflector |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
The first four are to be passed in as references to arrays, while the last argument is a scalar. |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=back |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=head2 OBJECT METHODS |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
=over 4 |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=item cipher ( ARGS ) |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
This method crypts and decrypts the supplied argument containing a string of text. Any characters which are not from the English alphabet (punctuation, numerics, etc) are ignored. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=item setRotor ( ARGS ) |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
The C method is called to set a rotor of the Enigma to specific settings. The arguments to be passed in are as follows: |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
-rotor name (eg. RotorI, RotorII, etc) |
912
|
|
|
|
|
|
|
-initial start letter (eg. 'A', 'B', etc) |
913
|
|
|
|
|
|
|
-ring setting (eg. '0', '1', etc) |
914
|
|
|
|
|
|
|
-rotor number (eg. '1', '2', etc) |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
If incorrect values are passed in, the default settings are used. |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item setReflector ( ARG ) |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
The C method is called to set the reflector of the Enigma Machine. The argument to be passed in is a string containing the name of any of the available reflectors. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=item setSteckerBoard ( ARGS ) |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
The Steckerboard is set by calling the C method and supplying a reference to an array as the first argument. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
The array should contain a set of letter pairs, such as: |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
[ 'A', 'B', 'C', 'D' ]; |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
In this example, each instance of the letter 'A' will be replaced with the letter 'B' (and vice-versa) and each instance of the letter 'C' will be replaced with the letter 'D' (and vice-versa). |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=item getRotorNames |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Returns an array containing the rotor names currently defined for encryption/decryption. |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=item getStartLetters |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
Returns an array containing the start letters currently defined for encryption/decryption. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=item getRingSettings |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Returns an array containing the ring settings currently defined for encryption/decryption. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=item getReflector |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Returns a string containing the name of the reflector currently defined for encryption/decryption. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=item dumpSettings |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
This method will print out (to STDERR) the current rotor settings. |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=item setDebug ( ARG ) |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
The C method is used to set the debug value of the C object. The value of the argument can be either 1 (debug on) or 0 (debug off). The debug value is set to 0 by default. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=back |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head1 KNOWN BUGS |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
None, but that does not mean there are not any. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head1 AUTHOR |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
Alistair Francis, |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=cut |