Message Boards Message Boards

Computational implementation of the German Enigma Machine

enter image description here

Below is an implementation of the German Enigma Machine which the German forces used to communicate encrypted messages during WWII. The machine was an ingenious design. It used a series of rotors and an elaborate electromechanical coupling to encrypt messages in German.

About the mechanism, the first rotor moved with each click of the keyboard; the second rotor moved once the first rotor completed 26 moves or one complete turn; and the third rotor once the first moved 26*26 steps (one can easily understand where this is going).

Since the rotors could move during the encryption process the key to deciphering the text was the "key" or the initial state of the rotors. The code was finally broken by a team of cryptographers at Bletchley Park led by Alan Turing. Some believe this caused the war to shorten by a few years. A movie titled "The Imitation Game" was released in 2014 highlighting this code breaking feat.

ClearAll@rotateWheel;
SetAttributes[rotateWheel, HoldFirst];
rotateWheel[wheel_] := Block[{},
   wheel = RotateLeft[wheel]];

The immediate block of code above enables me to make in-place modification i.e. to rotate and preserve the state of the rotors.

EnigmaEncryption[string_, staterot1_, staterot2_, staterot3_] := 
 Module[{count = 0, RotorIn, leftRotor, middleRotor, rightRotor, reflector, reflectorOutput,
rotateMiddleCheck, rotateRightCheck, inputToNext, reverseOutput},
  RotorIn = ToLowerCase@CharacterRange["A", "Z"];
  {leftRotor, middleRotor, rightRotor} = MapThread[Function[{x, y}, (z \[Function] 
        RotateLeft[z, First@Position[z, ToLowerCase@y] - 1])@
      Characters@ToLowerCase[x]], {{"BDFHJLCPRTXVZNYEIWGAKMUSQO", 
      "AJDKSIRUXBLHWTMCQGZNPYFVOE", "EKMFLGDQVZNTOWYHXUSPAIBRCJ"},
     {staterot1, staterot2, staterot3}}];

  reflector = Characters@ToLowerCase@"YRUHQSLDPXNGOKMIEBFZCWVJAT";

  inputToNext[rotor_, input_] :=  First@Cases[Thread[{RotorIn, rotor}], {input, map_} :> map ];
  reverseOutput[rotor_, input_] := First@Cases[Thread[{RotorIn, rotor}], {map_, input} :> map ];
  rotateMiddleCheck := If[count~Mod~26 == 0, rotateWheel@middleRotor, middleRotor];
  rotateRightCheck := If[count~Mod~676 == 0, rotateWheel@rightRotor, rightRotor];

   StringJoin@Table[
     If[FreeQ[input, Alternatives[" ", ",", "'", "?" ]],
      count += 1;
      reflectorOutput = 
       Fold[inputToNext[#2, #1] &,  input, {rotateWheel@leftRotor, rotateMiddleCheck, rotateRightCheck, reflector}];
      Fold[reverseOutput[#2, #1] &, reflectorOutput, {rightRotor, middleRotor, leftRotor}], input]
     , {input, Characters@ToLowerCase@string}]
  ]

Now lets assume that the Germans encrypt a message with state "A", "A","A" for the three moving rotors:

Style[text =  EnigmaEncryption["this is the SS, Identify yourself, are you a German or are you Alan Turing?", "A", "A", "A"], {Bold, FontSize -> 24}]

uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?

If the cryptographers at Bletchley have the incorrect key "B","A","E" they will not be able to decipher the text (it will be gibberish).

Style[EnigmaEncryption[text, "B", "A", "E"], {Bold, FontSize -> 24}]

pgyy yd gnu nw, etlisxnw fnkniizh, tgy wde u gqkabx ma foe alc aifb cmavmt?

However, with the right key:

Style[EnigmaEncryption[text, "A", "A", "A"], {Bold, FontSize ->  24}] 

this is the ss, identify yourself, are you a german or are you alan turing?

We can make a small animation of the rotor states. For visual purposes, blue represents the forward states of the system and red the backward state.

enter image description here

the code below can be used to generate the animation sequence:

list = (Rasterize@*Grid /@ 
    Module[{out, states, mergedstates, rotorstates, riffle, first, last, text = text,
      textout = StringReplace[text[[1]], Alternatives[" ", ",", "'", "?"] :> ""]},
     out = Characters@textout;
     states = Partition[text[[2, 1]], 7];
     mergedstates =  Table[Join[states[[i]], {out[[i]]}], {i, Length@states}];
     rotorstates = text[[2, 2]];
     riffle = MapAt[Reverse, (Partition[#, 4] & /@ mergedstates), {All, 2}];
     riffle = Apply[Composition[Partition[#, 2] &, Riffle], riffle, {1}];
     Do[{first, last} = Flatten@Position[rotorstates[[j, i]], #] & /@ riffle[[j, i]];
      rotorstates[[j, i, first]] = Style[First@rotorstates[[j, i, first]], {Blue, Bold, Background -> LightBlue}];
      rotorstates[[j, i, last]] = Style[First@rotorstates[[j, i, last]], {Red, Bold,  Background -> LightRed}];
      , {j, Length@riffle}, {i, 4}];
     rotorstates
     ]);
POSTED BY: Ali Hashmi
10 Replies

Hi Ali,

very nice, thanks for sharing! But I must say that the germans never ever would have encrypted some english text ...

Anyway, your nice code and the fact that you are using just 3 rotors (i.e. there are only 17576 keys) gives me the chance of testing an old idea: An incredibly simple and direct brute force attack - just try all keys and look for english text as outcome, you do not even have to care about the correct key! I guess Alan Turing could not even have dreamed of such an insane approach!

encText = "uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?";
allKeys = Tuples[CharacterRange["A", "Z"], 3];
allEncodings = ParallelMap[EnigmaEncryption[encText, Sequence @@ #] &, allKeys];
bruteForce = ParallelMap[{#, LanguageIdentify[#]} &, allEncodings];
englishText = Select[bruteForce, Last[#] == Entity["Language", "English"] &];

This should work - but it does not work! I was prepared for some false positive findings (therefore I did not use a While construct), but not for so many (>9%)! Can anybody comment why LanguageIdentify is working so badly?!

Best regards -- Henrik

POSTED BY: Henrik Schachner

The problem is that LanguageIdentify, is a simple classifier that always gives an answer. It is the same as:

Classify["Language"]

What you can do: use the underlying classifier and ask for probabilities:

Classify["Language"]["abcdefghijklmnopqrstuvwxyz", "TopProbabilities" -> 1]

and then only accept if the probability is above a high percentage (e.g. 95%). Else, unidentified.

POSTED BY: Sander Huisman
POSTED BY: Dan O'Leary
POSTED BY: Henrik Schachner
Posted 7 years ago

On the Enigma machine: Charles Stevens made the attached cdf. Its outstanding.Taken from this discussion

POSTED BY: Hans Milton

Dan, thank you for this interesting overview!

Breaking Enigma didn’t rely on brute force, but ...

Yes, of course - it is the most stupid approach you can make! But when you have computational power at your fingertips, those pioneers could not event have dreamed of, this brute force attack was just too tempting. We are all "standing on the shoulders of giants".

POSTED BY: Henrik Schachner

Hi Sander,

an 7 years late answer - as this discussion comes up again: According to your advice (and for the sake of completeness), here is a working version of a most simple brute force attack:

encText = "uubf jw dif oo, jctjgmbn nbtqrang, pvs vsh o orgiya lq lyw svn ssui zcxuxs?";
allKeys = Tuples[CharacterRange["A", "Z"], 3];
allEncodings = ParallelMap[EnigmaEncryption[encText, Sequence @@ #] &, allKeys];
bruteForce = ParallelMap[{#, Classify["Language"][#, "TopProbabilities" -> 1]} &, allEncodings];
englishText = Select[bruteForce, #[[2, 1, 1]] == Entity["Language", "English"] && #[[2, 1, 2]] > .9999 &]

It is interesting to see, what else could be an English text with high probability.

Again many thanks and best regards -- Henrik

POSTED BY: Henrik Schachner

Thanks a lot Henrik. What you are proposing is quite interesting. let me look at your code !

POSTED BY: Ali Hashmi

Thanks Hans for pointing it out. Indeed that is a lot of work put in by the author !

POSTED BY: Ali Hashmi
POSTED BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract