line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Commercial.pm |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Copyright (c) 2002 Ambriel Consulting |
6
|
|
|
|
|
|
|
# sjb Mon Mar 18 20:55:53 GMT 2002 |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Crypt::OOEnigma::Commercial ; |
10
|
|
|
|
|
|
|
$VERSION="0.3"; |
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Crypt::OOEnigma::Commercial - A commercial Enigma machine circa 1940. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Crypt::OOEnigma::Commercial; |
18
|
|
|
|
|
|
|
my $enigma = new Crypt::OOEnigma::Commercial; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# or |
21
|
|
|
|
|
|
|
use Crypt::OOEnigma::Commercial; |
22
|
|
|
|
|
|
|
use Crypt::OOEnigma::Rotor; |
23
|
|
|
|
|
|
|
my @rotors = (); |
24
|
|
|
|
|
|
|
# Populate the list of Crypt::OOEnigma::Rotor |
25
|
|
|
|
|
|
|
Crypt::OOEnigma::Commercial->new( rotors => [@rotors] ); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# or even |
28
|
|
|
|
|
|
|
use Crypt::OOEnigma::Commercial; |
29
|
|
|
|
|
|
|
use Crypt::OOEnigma::Rotor; |
30
|
|
|
|
|
|
|
use Crypt::OOEnigma::Reflector; |
31
|
|
|
|
|
|
|
my @rotors = () |
32
|
|
|
|
|
|
|
# Populate the list of Crypt::OOEnigma::Rotor |
33
|
|
|
|
|
|
|
my $reflector = new Crypt:OOEnigma::Reflector(params); # see relevant pod |
34
|
|
|
|
|
|
|
Crypt::OOEnigma::Commercial->new( rotors => [@rotors], |
35
|
|
|
|
|
|
|
reflector => $reflector); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $cipher = $enigma->encipher($mesg); |
38
|
|
|
|
|
|
|
my $decode = $enigma->encipher($cipher); # self-inverse |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Also, for use internally: |
41
|
|
|
|
|
|
|
$enigma->init(); # returns the rotors to their initial state |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 DESCRIPTION |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
This module provides a commercial Enigma machine consisting of a number of |
46
|
|
|
|
|
|
|
rotors and a reflector. If no Rotors are provided in the constructor, 3 |
47
|
|
|
|
|
|
|
default Rotors are used, each of which uses an identity substitution (ie no |
48
|
|
|
|
|
|
|
cipher at all in each rotor in start position 0). |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Normally, you should create your own rotors and use those. See the |
51
|
|
|
|
|
|
|
documentation for Crypt::OOEnigma::Rotor for details. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 NOTES |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
None |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 BUGS and CAVEATS |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head2 Enigma is weak! |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Cryptographers talk of the strength of a cryptographic algorithm in term of |
62
|
|
|
|
|
|
|
whether it is computationally feasible to break it. It is, of course, |
63
|
|
|
|
|
|
|
computationally feasible to break an Enigma cipher so don't use it for |
64
|
|
|
|
|
|
|
anything serious! |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 HISTORY |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
This package was created in spring 2002 as an exercise in OO Perl and |
69
|
|
|
|
|
|
|
preparing modules properly for CPAN. More importantly, the Enigma is |
70
|
|
|
|
|
|
|
interesting. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
CPAN already has a Crypt::Enigma which is not object oriented and implements |
73
|
|
|
|
|
|
|
only one Enigma (whereas you can create any Enigma-like machine with these |
74
|
|
|
|
|
|
|
objects). Hence the package name Crypt::OOEnigma |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 SEE ALSO |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The Pleasures of Counting, T W Korner, CUP 1996. A great book for anyone with |
79
|
|
|
|
|
|
|
the slightest interest in mathematics |
80
|
|
|
|
|
|
|
ISBN 0 521 56087 X hardback |
81
|
|
|
|
|
|
|
ISBN 0 521 56823 4 paperback |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Crypt::OOEnigma::Military |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
The components: |
86
|
|
|
|
|
|
|
Crypt::OOEnigma::Rotor |
87
|
|
|
|
|
|
|
Crypt::OOEnigma::Reflector |
88
|
|
|
|
|
|
|
Crypt::OOEnigma::Plugboard |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 AUTHOR |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
S J Baker, Ambriel Consulting, http://ambrielconsulting.com |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 COPYRIGHT |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
This package is licenced under the same terms as Perl itself. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut |
99
|
|
|
|
|
|
|
|
100
|
2
|
|
|
2
|
|
65544
|
use Carp ; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
183
|
|
101
|
2
|
|
|
2
|
|
1578
|
use Crypt::OOEnigma::Rotor ; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
55
|
|
102
|
2
|
|
|
2
|
|
1332
|
use Crypt::OOEnigma::Reflector ; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
78
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# use Autoloading for accessors |
106
|
2
|
|
|
2
|
|
11
|
use subs qw(rotors reflector); |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
10
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my %fields = ( |
109
|
|
|
|
|
|
|
rotors => undef, |
110
|
|
|
|
|
|
|
reflector => undef |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub new { |
114
|
9
|
|
|
9
|
0
|
81
|
my $invocant = shift ; |
115
|
9
|
|
33
|
|
|
44
|
my $class = ref($invocant) || $invocant ; |
116
|
9
|
|
|
|
|
42
|
my $self = { %fields, @_ } ; |
117
|
9
|
|
|
|
|
31
|
bless $self, $class ; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# only set valid rotors |
120
|
9
|
100
|
|
|
|
44
|
if( defined($self->rotors())){ |
121
|
8
|
|
|
|
|
11
|
foreach my $r (@{$self->rotors()}){ |
|
8
|
|
|
|
|
27
|
|
122
|
36
|
50
|
|
|
|
41
|
if(keys(%{$r->cipher()}) == 26){ |
|
36
|
|
|
|
|
136
|
|
123
|
|
|
|
|
|
|
# This rotor is ok |
124
|
|
|
|
|
|
|
} else { |
125
|
0
|
|
|
|
|
0
|
croak("An invalid rotor was provided."); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
} else { |
129
|
|
|
|
|
|
|
# use three default rotors (identity substitution!) |
130
|
1
|
|
|
|
|
5
|
my $r1 = Crypt::OOEnigma::Rotor->new(); |
131
|
1
|
|
|
|
|
7
|
my $r2 = Crypt::OOEnigma::Rotor->new(); |
132
|
1
|
|
|
|
|
4
|
my $r3 = Crypt::OOEnigma::Rotor->new(); |
133
|
1
|
|
|
|
|
9
|
$self->rotors([$r1, $r2, $r3]); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# Reflector does not require setup |
137
|
9
|
|
|
|
|
57
|
$self->reflector(Crypt::OOEnigma::Reflector->new()); |
138
|
|
|
|
|
|
|
|
139
|
9
|
|
|
|
|
24
|
$self->init(); |
140
|
9
|
|
|
|
|
49
|
return $self ; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub init { |
144
|
61
|
|
|
61
|
0
|
115
|
my $self = shift ; |
145
|
|
|
|
|
|
|
# Initialise all the rotors |
146
|
61
|
|
|
|
|
102
|
foreach my $r (@{$self->rotors()}){ |
|
61
|
|
|
|
|
218
|
|
147
|
267
|
|
|
|
|
851
|
$r->init(); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub encipher { |
152
|
52
|
|
|
52
|
0
|
243177
|
my $self = shift; |
153
|
52
|
|
|
|
|
96
|
my $work = shift; |
154
|
52
|
|
|
|
|
156
|
$work =~ s/\s/X/g; |
155
|
52
|
|
|
|
|
127
|
$work = uc($work); |
156
|
52
|
|
|
|
|
82
|
my $result = ""; |
157
|
52
|
|
|
|
|
76
|
my @rotors = @{$self->rotors()}; |
|
52
|
|
|
|
|
311
|
|
158
|
|
|
|
|
|
|
|
159
|
52
|
|
|
|
|
452
|
foreach my $ch ( split //, $work ){ |
160
|
|
|
|
|
|
|
# encipher in every rotor |
161
|
1748
|
|
|
|
|
2978
|
foreach $r (@rotors){ |
162
|
7572
|
|
|
|
|
18964
|
$ch = $r->encode($ch); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
# reflect |
165
|
1748
|
|
|
|
|
6049
|
$ch = $self->reflector()->reflect($ch); |
166
|
|
|
|
|
|
|
# reverse encipher in every rotor |
167
|
1748
|
|
|
|
|
3919
|
foreach $r (reverse @rotors){ |
168
|
7572
|
|
|
|
|
18021
|
$ch = $r->revencode($ch); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
# nudge all the rotors |
171
|
1748
|
|
|
|
|
3017
|
foreach $r (@rotors){ |
172
|
7572
|
|
|
|
|
18799
|
$r->next(); |
173
|
|
|
|
|
|
|
} |
174
|
1748
|
|
|
|
|
3231
|
$result .= $ch ; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
52
|
|
|
|
|
384
|
$self->init(); |
178
|
52
|
|
|
|
|
327
|
return $result; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub AUTOLOAD { |
182
|
1888
|
|
|
1888
|
|
2355
|
my $self = shift; |
183
|
|
|
|
|
|
|
# only access instance methods not class methods |
184
|
1888
|
50
|
|
|
|
3816
|
croak "$self is not an object" unless(ref($self)); |
185
|
1888
|
|
|
|
|
2356
|
my $name = our $AUTOLOAD; |
186
|
1888
|
50
|
|
|
|
4292
|
return if($name =~ /::DESTROY/ ); |
187
|
1888
|
|
|
|
|
5617
|
$name =~ s/.*://; # strip fully-qualified portion |
188
|
1888
|
50
|
|
|
|
4161
|
unless (exists $self->{$name} ) { |
189
|
0
|
|
|
|
|
0
|
croak "Can't access `$name' field in object of class $self"; |
190
|
|
|
|
|
|
|
} |
191
|
1888
|
100
|
|
|
|
6593
|
if (@_) { |
192
|
10
|
|
|
|
|
23
|
return $self->{$name} = shift; |
193
|
|
|
|
|
|
|
} else { |
194
|
1878
|
|
|
|
|
7152
|
return $self->{$name}; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
1; |
199
|
|
|
|
|
|
|
|