From c802d62a3afc99c784cfbb7ca2033930d6537555 Mon Sep 17 00:00:00 2001 From: dakkar Date: Mon, 29 Aug 2011 18:22:24 +0100 Subject: full-machine and tests --- lib/Enigmatic/Machine.pm | 89 +++++++++++++++++++++++++++++++++++++++++++ lib/Enigmatic/ReflectorBox.pm | 3 +- lib/Enigmatic/RotorBox.pm | 5 ++- t/basic-enigma.t | 28 ++++++++++++++ t/full-enigma.t | 69 +++++++++++++++++++++++++++++++++ t/lib/Test/Enigmatic.pm | 25 ++++++++++++ t/simple-enigma.t | 23 +++++++++++ 7 files changed, 239 insertions(+), 3 deletions(-) create mode 100644 lib/Enigmatic/Machine.pm create mode 100644 t/basic-enigma.t create mode 100644 t/full-enigma.t create mode 100644 t/simple-enigma.t diff --git a/lib/Enigmatic/Machine.pm b/lib/Enigmatic/Machine.pm new file mode 100644 index 0000000..f5d5081 --- /dev/null +++ b/lib/Enigmatic/Machine.pm @@ -0,0 +1,89 @@ +package Enigmatic::Machine; +use DAKKAR::p 'class'; +use Enigmatic::RotorBox; +use Enigmatic::ReflectorBox; +use Enigmatic::Plugboard; +use Enigmatic::CryptTrain; +use Enigmatic::Types qw(Letter RotorT ReflectorT PlugboardT); +use MooseX::Types::Moose qw(ArrayRef Str); + +has train => ( + isa => 'Enigmatic::CryptTrain', + is => 'ro', +); + +has plugboard => ( + isa => PlugboardT, + is => 'ro', + default => sub { Enigmatic::Plugboard->new }, + coerce => 1, +); + +around BUILDARGS => sub { + my $orig = shift; + my $class = shift; + + my $args = $class->$orig(@_); + + croak "no rotors specified" unless $args->{rotors}; + croak "no reflector specified" unless $args->{reflector}; + + my $rotors = $args->{rotors}->map(\&to_RotorT); + my $reflector = to_ReflectorT($args->{reflector}); + + if ($args->{ring_settings}) { + $args->{ring_settings}->each( + sub { + my ($idx,$setting) = @_; + $rotors->[$idx]->ring_setting($setting); + }); + } + + $args->{train} = Enigmatic::CryptTrain->new({ + rotors => $rotors, + reflector => $reflector, + ( $args->{rotor_positions} ? ( positions => $args->{rotor_positions} ) : () ), + }); + + return $args; +}; + +sub map { + my $self = shift; + my ($letter) = pos_validated_list( + \@_, + { isa => Letter }, + ); + +warn "mapping $letter\n"; +warn " initial positions: @{[ $self->train->positions ]}\n"; + + $letter = $self->plugboard->map($letter); + +warn " after plugboard: $letter\n"; + + $letter = $self->train->map($letter); + +warn " after rotors: $letter\n"; + + $letter = $self->plugboard->map($letter); + +warn " after plugboard: $letter\n"; + +warn " new positions: @{[ $self->train->positions ]}\n"; + + return $letter; +} + +sub map_string { + my ($self,$string) = @_; + + my @letters = $string->split(qr//)->grep(\&is_Letter)->flatten; + + my @res; + for my $letter (@letters) { + push @res, $self->map($letter); + } + + return wantarray ? @res : @res->join; +} diff --git a/lib/Enigmatic/ReflectorBox.pm b/lib/Enigmatic/ReflectorBox.pm index eafa667..e0558cf 100644 --- a/lib/Enigmatic/ReflectorBox.pm +++ b/lib/Enigmatic/ReflectorBox.pm @@ -1,13 +1,14 @@ package Enigmatic::ReflectorBox; use DAKKAR::p 'class'; use Enigmatic::Reflector; +use Enigmatic::Types 'ReflectorT'; use MooseX::Types::Structured qw(Map); use MooseX::Types::Moose qw(Str); use Moose::Util::TypeConstraints; has reflectorset => ( is => 'ro', - isa => Map[Str,class_type('Enigmatic::Reflector')], + isa => Map[Str,ReflectorT], lazy_build => 1, traits => ['Hash'], handles => { diff --git a/lib/Enigmatic/RotorBox.pm b/lib/Enigmatic/RotorBox.pm index 57f0a47..caf7ed1 100644 --- a/lib/Enigmatic/RotorBox.pm +++ b/lib/Enigmatic/RotorBox.pm @@ -1,13 +1,14 @@ package Enigmatic::RotorBox; use DAKKAR::p 'class'; use Enigmatic::Rotor; +use Enigmatic::Types 'RotorT'; use MooseX::Types::Structured qw(Map); use MooseX::Types::Moose qw(Str); use Moose::Util::TypeConstraints; has rotorset => ( is => 'ro', - isa => Map[Str,class_type('Enigmatic::Rotor')], + isa => Map[Str,RotorT], lazy_build => 1, traits => ['Hash'], handles => { @@ -26,7 +27,7 @@ sub _build_rotorset { VII => { wiring => 'NZJHGRCXMYSWBOUFAIVLPEKQDT', notches => ['M','Z'] }, VIII => { wiring => 'FKQHTLXOCBJSPDZRAMEWNIUYGV', notches => ['M','Z'] }, Beta => { wiring => 'LEYJVCNIXWPBQMDRTAKZGFUHOS', notches => [] }, - Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [''] }, + Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [] }, ); $_ = Enigmatic::Rotor->new($_) for values %rotors; diff --git a/t/basic-enigma.t b/t/basic-enigma.t new file mode 100644 index 0000000..0760737 --- /dev/null +++ b/t/basic-enigma.t @@ -0,0 +1,28 @@ +#!perl +use DAKKAR::p 'test'; +use Test::Enigmatic; +use Enigmatic::Machine; + +Test::Enigmatic::test_full_machine( + sub { + Enigmatic::Machine->new({ + reflector => 'B', + rotors => [ 'III', 'II', 'I' ], + }); + }, + 'AAAAA', + 'BDZGO'); + +Test::Enigmatic::test_full_machine( + sub { + Enigmatic::Machine->new({ + reflector => 'B', + rotors => [ 'III', 'II', 'I' ], + ring_settings => ['B','B','B'], + }); + }, + 'AAAAA', + 'EWTYX'); + + +done_testing(); diff --git a/t/full-enigma.t b/t/full-enigma.t new file mode 100644 index 0000000..0015b46 --- /dev/null +++ b/t/full-enigma.t @@ -0,0 +1,69 @@ +#!perl +use DAKKAR::p 'test'; + +use Enigmatic::Machine; + +sub real_machine { + return Enigmatic::Machine->new({ + reflector => 'B_thin', + rotors => [ 'I', 'IV', 'II', 'Beta' ], + plugboard => 'AT BL DF GJ HM NW OP QY RZ VX', + ring_settings => [ 'V', 'A', 'A', 'A' ], + rotor_positions => [ 'A', 'N', 'J', 'V' ], + }); +} + +my $plaintext = <<'EOPLAIN'; +VONV ONJL OOKS JHFF TTTE +INSE INSD REIZ WOYY QNNS +NEUN INHA LTXX BEIA NGRI +FFUN TERW ASSE RGED RUEC +KTYW ABOS XLET ZTER GEGN +ERST ANDN ULAC HTDR EINU +LUHR MARQ UANT ONJO TANE +UNAC HTSE YHSD REIY ZWOZ +WONU LGRA DYAC HTSM YSTO +SSEN ACHX EKNS VIER MBFA +ELLT YNNN NNNO OOVI ERYS +ICHT EINS NULL +EOPLAIN +$plaintext =~ s{\s+}{}g; + +my $ciphertext = <<'EOCIPHER'; +NCZW VUSX PNYM INHZ XMQX +SFWX WLKJ AHSH NMCO CCAK +UQPM KCSM HKSE INJU SBLK +IOSX CKUB HMLL XCSJ USRR +DVKO HULX WCCB GVLI YXEO +AHXR HKKF VDRE WEZL XOBA +FGYU JQUK GRTV UKAM EURB +VEKS UHHV OYHA BCJW MAKL +FKLM YFVN RIZR VVRT KOFD +ANJM OLBG FFLE OPRG TFLV +RHOW OPBE KVWM UQFM PWPA +RMFH AGKX IIBG +EOCIPHER +$ciphertext =~ s{\s+}{}g; + +note "encrypt real"; + +my $check = real_machine->map_string($plaintext); +p $check; +is($check,$ciphertext, + 'ok crypt'); + +note "round-trip check"; + +$check = real_machine->map_string($check); +p $check; +is($check,$plaintext, + 'round tripped'); + +note "decrypt real"; + +$check = real_machine->map_string($ciphertext); +p $check; +is($check,$plaintext, + 'ok plain'); + + diff --git a/t/lib/Test/Enigmatic.pm b/t/lib/Test/Enigmatic.pm index 923ede1..9958667 100644 --- a/t/lib/Test/Enigmatic.pm +++ b/t/lib/Test/Enigmatic.pm @@ -13,3 +13,28 @@ sub test_static_map { "$name on $c"); } } + + +sub test_full_machine { + my ($factory,$input,$exp_output) = @_; + + $input =~ s{\s+}{}g; + + my $output = $factory->()->map_string(uc $input); + + note "output: $output"; + + my $back = $factory->()->map_string($output); + + note "back: $back"; + + is($back, + $input, + 'round tripped'); + if ($exp_output) { + $exp_output =~ s{\s+}{}g; + is($output, + uc($exp_output), + 'got expected output'); + } +} diff --git a/t/simple-enigma.t b/t/simple-enigma.t new file mode 100644 index 0000000..b2bcbdd --- /dev/null +++ b/t/simple-enigma.t @@ -0,0 +1,23 @@ +#!perl +use DAKKAR::p 'test'; + +use Enigmatic::Machine; + +sub real_machine { + return Enigmatic::Machine->new({ + reflector => 'B_thin', + rotors => [ 'I', 'IV', 'II', 'Beta' ], + plugboard => 'AT BL DF GJ HM NW OP QY RZ VX', + ring_settings => [ 'V', 'A', 'A', 'A' ], + rotor_positions => [ 'A', 'N', 'J', 'V' ], + }); +} + +my $plaintext = 'this is a simple text to be encrypted by an enigma machine'->uc; +note "encrypt simple"; +my $ciphertext = real_machine->map_string($plaintext);note $ciphertext; +note "decrypt simple"; +my $check = real_machine->map_string($ciphertext);note $check; +$plaintext =~ s{\s+}{}g; +is($check,$plaintext, + 'round tripped'); -- cgit v1.2.3