line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Military.pm |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Copyright (c) 2002 Ambriel Consulting |
6
|
|
|
|
|
|
|
# sjb Mon Mar 18 20:55:53 GMT 2002 |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Crypt::OOEnigma::Military ; |
10
|
|
|
|
|
|
|
$VERSION="0.3"; |
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Crypt::OOEnigma::Military - A military Enigma machine circa 1940. It |
14
|
|
|
|
|
|
|
differs from the Commercial Enigma in the addition of a plugboard before |
15
|
|
|
|
|
|
|
the rotors. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Crypt::OOEnigma::Military; |
20
|
|
|
|
|
|
|
# An Enigma with 3 default Rotors (with identity substitutions) |
21
|
|
|
|
|
|
|
my $enigma = new Crypt::OOEnigma::Military; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# OR |
24
|
|
|
|
|
|
|
use Crypt::OOEnigma::Military; |
25
|
|
|
|
|
|
|
use Crypt::OOEnigma::Rotor; |
26
|
|
|
|
|
|
|
my @rotors = () |
27
|
|
|
|
|
|
|
# Populate the list of Crypt::OOEnigma::Rotor |
28
|
|
|
|
|
|
|
Crypt::OOEnigma::Military->new( rotors => [@rotors] ); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# OR EVEN |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
use Crypt::OOEnigma::Military; |
33
|
|
|
|
|
|
|
use Crypt::OOEnigma::Rotor; |
34
|
|
|
|
|
|
|
use Crypt::OOEnigma::Reflector; |
35
|
|
|
|
|
|
|
use Crypt::OOEnigma::Plugboard; |
36
|
|
|
|
|
|
|
my @rotors = () |
37
|
|
|
|
|
|
|
# Populate the list of Crypt::OOEnigma::Rotor, see relevant pod |
38
|
|
|
|
|
|
|
my $reflector = new Crypt:OOEnigma::Reflector(params); # see relevant pod |
39
|
|
|
|
|
|
|
my $plugboard = new Crypt:OOEnigma::Plugboard(params); # see relevant pod |
40
|
|
|
|
|
|
|
Crypt::OOEnigma::Military->new( rotors => [@rotors], |
41
|
|
|
|
|
|
|
plugboard => $plugboard, |
42
|
|
|
|
|
|
|
reflector => $reflector); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $cipher = $enigma->encipher($mesg); |
45
|
|
|
|
|
|
|
my $decode = $enigma->encipher($cipher); # self-inverse |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# for internal use |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
$enigma->init(); # returns the rotors to their initial state |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 DESCRIPTION |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
This module provides a Military Enigma machine which differs in that a |
54
|
|
|
|
|
|
|
Plugboard is added before the Rotors. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
You should usually create a Military Enigma with your own Plugboard, |
57
|
|
|
|
|
|
|
Rotors and Reflector. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 NOTES |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
None |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 BUGS and CAVEATS |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 Enigma is weak! |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Cryptographers talk of the strength of a cryptographic algorithm in term of |
68
|
|
|
|
|
|
|
whether it is computationally feasible to break it. It is, of course, |
69
|
|
|
|
|
|
|
computationally feasible to break an Enigma cipher so don't use it for |
70
|
|
|
|
|
|
|
anything serious! |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 HISTORY |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
This package was created in spring 2002 as an exercise in OO Perl and |
75
|
|
|
|
|
|
|
preparing modules properly for CPAN. More importantly, the Enigma is |
76
|
|
|
|
|
|
|
interesting. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
CPAN already has a Crypt::Enigma which is not object oriented and implements |
79
|
|
|
|
|
|
|
only one Enigma (whereas you can create any Enigma-like machine with these |
80
|
|
|
|
|
|
|
objects). Hence the package name Crypt::OOEnigma |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 SEE ALSO |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
The Pleasures of Counting, T W Korner, CUP 1996. A great book for anyone with |
85
|
|
|
|
|
|
|
the slightest interest in mathematics |
86
|
|
|
|
|
|
|
ISBN 0 521 56087 X hardback |
87
|
|
|
|
|
|
|
ISBN 0 521 56823 4 paperback |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Crypt::OOEnigma::Military |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
The components: |
92
|
|
|
|
|
|
|
Crypt::OOEnigma::Rotor |
93
|
|
|
|
|
|
|
Crypt::OOEnigma::Reflector |
94
|
|
|
|
|
|
|
Crypt::OOEnigma::Plugboard |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 AUTHOR |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
S J Baker, Ambriel Consulting, http://ambrielconsulting.com |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 COPYRIGHT |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
This package is licenced under the same terms as Perl itself. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=cut |
105
|
2
|
|
|
2
|
|
62809
|
use Carp ; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
196
|
|
106
|
2
|
|
|
2
|
|
3202
|
use Crypt::OOEnigma::Rotor ; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
58
|
|
107
|
2
|
|
|
2
|
|
1068
|
use Crypt::OOEnigma::Reflector ; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
47
|
|
108
|
2
|
|
|
2
|
|
1194
|
use Crypt::OOEnigma::Plugboard ; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
60
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# use Autoloading for accessors |
112
|
2
|
|
|
2
|
|
9
|
use subs qw( rotors reflector plugboard ); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
8
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my %fields = ( |
115
|
|
|
|
|
|
|
rotors => undef, |
116
|
|
|
|
|
|
|
reflector => undef, |
117
|
|
|
|
|
|
|
plugboard => undef |
118
|
|
|
|
|
|
|
); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub new { |
121
|
9
|
|
|
9
|
0
|
72
|
my $invocant = shift ; |
122
|
9
|
|
33
|
|
|
41
|
my $class = ref($invocant) || $invocant ; |
123
|
9
|
|
|
|
|
42
|
my $self = { %fields, @_ } ; |
124
|
9
|
|
|
|
|
24
|
bless $self, $class ; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# only set valid rotors |
127
|
9
|
100
|
|
|
|
43
|
if( defined($self->rotors())){ |
128
|
8
|
|
|
|
|
9
|
foreach my $r (@{$self->rotors()}){ |
|
8
|
|
|
|
|
28
|
|
129
|
36
|
50
|
|
|
|
40
|
if(keys(%{$r->cipher()}) == 26){ |
|
36
|
|
|
|
|
129
|
|
130
|
|
|
|
|
|
|
# This rotor is ok |
131
|
|
|
|
|
|
|
} else { |
132
|
0
|
|
|
|
|
0
|
croak("An invalid rotor was provided."); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} else { |
136
|
|
|
|
|
|
|
# use three default rotors |
137
|
1
|
|
|
|
|
5
|
my $r1 = Crypt::OOEnigma::Rotor->new(); |
138
|
1
|
|
|
|
|
4
|
my $r2 = Crypt::OOEnigma::Rotor->new(); |
139
|
1
|
|
|
|
|
4
|
my $r3 = Crypt::OOEnigma::Rotor->new(); |
140
|
1
|
|
|
|
|
7
|
$self->rotors([$r1, $r2, $r3]); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# only set a valid plugboard |
144
|
9
|
50
|
|
|
|
33
|
if( defined($self->plugboard()) ){ |
145
|
0
|
0
|
|
|
|
0
|
if(keys(%{$self->plugboard()->cipher()}) == 26){ |
|
0
|
|
|
|
|
0
|
|
146
|
|
|
|
|
|
|
# This plugboard is ok TODO: improve checking - self-inverse? |
147
|
|
|
|
|
|
|
} else { |
148
|
0
|
|
|
|
|
0
|
croak("An invalid plugboard was provided."); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} else { |
151
|
9
|
|
|
|
|
43
|
$self->plugboard(Crypt::OOEnigma::Plugboard->new()); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Reflector does not require setup |
155
|
9
|
|
|
|
|
40
|
$self->reflector(Crypt::OOEnigma::Reflector->new()); |
156
|
|
|
|
|
|
|
|
157
|
9
|
|
|
|
|
23
|
$self->init(); |
158
|
9
|
|
|
|
|
33
|
return $self ; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub init { |
162
|
61
|
|
|
61
|
0
|
136
|
my $self = shift ; |
163
|
|
|
|
|
|
|
# Initialise all the rotors |
164
|
61
|
|
|
|
|
82
|
foreach my $r (@{$self->rotors()}){ |
|
61
|
|
|
|
|
200
|
|
165
|
267
|
|
|
|
|
723
|
$r->init(); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
# Plugboard and reflector require no initialisation |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub encipher { |
172
|
52
|
|
|
52
|
0
|
259471
|
my $self = shift; |
173
|
52
|
|
|
|
|
112
|
my $work = shift ; |
174
|
52
|
|
|
|
|
172
|
$work =~ s/\s/X/g; |
175
|
52
|
|
|
|
|
129
|
$work = uc($work); |
176
|
52
|
|
|
|
|
80
|
my $result = ""; |
177
|
52
|
|
|
|
|
70
|
my @rotors = @{$self->rotors()}; |
|
52
|
|
|
|
|
270
|
|
178
|
|
|
|
|
|
|
|
179
|
52
|
|
|
|
|
445
|
foreach my $ch ( split //, $work ){ |
180
|
|
|
|
|
|
|
# pass through plugboard |
181
|
1748
|
|
|
|
|
9655
|
$ch = $self->plugboard()->encode($ch); |
182
|
|
|
|
|
|
|
# encipher in every rotor |
183
|
1748
|
|
|
|
|
3925
|
foreach $r (@rotors){ |
184
|
7572
|
|
|
|
|
18313
|
$ch = $r->encode($ch); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
# reflect |
187
|
1748
|
|
|
|
|
6075
|
$ch = $self->reflector()->reflect($ch); |
188
|
|
|
|
|
|
|
# reverse encipher in every rotor |
189
|
1748
|
|
|
|
|
4136
|
foreach $r (reverse @rotors){ |
190
|
7572
|
|
|
|
|
19170
|
$ch = $r->revencode($ch); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
# nudge all the rotors |
193
|
1748
|
|
|
|
|
3242
|
foreach $r (@rotors){ |
194
|
7572
|
|
|
|
|
17814
|
$r->next(); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
# pass through plugboard - self-inverse |
197
|
1748
|
|
|
|
|
6470
|
$ch = $self->plugboard()->encode($ch); |
198
|
1748
|
|
|
|
|
4216
|
$result .= $ch ; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
52
|
|
|
|
|
403
|
$self->init(); |
202
|
52
|
|
|
|
|
311
|
return $result; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub AUTOLOAD { |
206
|
5402
|
|
|
5402
|
|
6224
|
my $self = shift; |
207
|
|
|
|
|
|
|
# only access instance methods not class methods |
208
|
5402
|
50
|
|
|
|
10239
|
croak "$self is not an object" unless(ref($self)); |
209
|
5402
|
|
|
|
|
6196
|
my $name = our $AUTOLOAD; |
210
|
5402
|
50
|
|
|
|
17134
|
return if($name =~ /::DESTROY/ ); |
211
|
5402
|
|
|
|
|
16380
|
$name =~ s/.*://; # strip fully-qualified portion |
212
|
5402
|
50
|
|
|
|
16260
|
unless (exists $self->{$name} ) { |
213
|
0
|
|
|
|
|
0
|
croak "Can't access `$name' field in object of class $self"; |
214
|
|
|
|
|
|
|
} |
215
|
5402
|
100
|
|
|
|
8688
|
if (@_) { |
216
|
19
|
|
|
|
|
39
|
return $self->{$name} = shift; |
217
|
|
|
|
|
|
|
} else { |
218
|
5383
|
|
|
|
|
20630
|
return $self->{$name}; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
1; |