Updated 2012-07-25 10:20:36 by RLE

In WWII (and before), the Germans relied on the Enigma machine to keep their communications secret. With information from [1] and using [2] as a reference implementation, I, PS, created the code below.

12May2003 PS: I've added a very, very simple GUI to play with the Enigma. It is not pretty and it does no error checking (you can make Enigma configurations which won't work). Should work with wiki-reaper/wish-reaper/wikirun.

Ethan Urie has written a nice document about the Enigma, the history, design and breaking [3]. The Code Book [4] by Simon Singh is another place where you can read about Enigma and many other things crypto.
 namespace eval enigma {

    variable letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    variable nextMachine 0
    variable machines 

    #The rotors, notches and reflectors. 
    #Taken from 
    #http://www.codesandciphers.org.uk/enigma/rotorspec.htm
    array set rotors {    
        I     {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}
        II    {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}
        III   {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}
        IV    {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}
        V     {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}
        VI    {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}
        VII   {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}
        VIII  {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}
        Beta  {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}
        Gamma {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}    
    }

    array set reflectors {
        B {AY BR CU DH EQ FS GL IP JX KN MO TZ VW}
        C {AF BV CP DJ EI GO HY KR LZ MX NW TQ SU}
        BD {AE BN CK DQ FU GY HW IJ LO MP RX SZ TV}
        CD {AR BD CO EJ FN GT HK IV LM PW QZ SX UY}
    }
    
    array set notches {
        I     {Q}
        II    {E}
        III   {V}
        IV    {J}
        V     {Z}
        VI    {Z M}
        VII   {Z M}
        VIII  {Z M}
        Beta  {}
        Gamma {}    
    }

    #create the easy access rotors
    foreach rotor [array names rotors] {
        foreach output $rotors($rotor) input $letters {
            lappend rotors($rotor.$input) $output
            lappend rotors($rotor.inv.$output) $input
        }
    }

    #create the easy access reflectors
    foreach reflector [array names reflectors] {
        foreach swap $reflectors($reflector) {
            set reflectors($reflector.[string index $swap 0]) [string index $swap 1]
            set reflectors($reflector.[string index $swap 1]) [string index $swap 0]
        }
    }
 }

 proc enigma::shift {position input} {  
    variable letters
    return [lindex $letters [expr ([lsearch $letters $position] +[lsearch $letters $input])%26]]
 }

 proc enigma::coreshift {position ring} {  
    variable letters
    return [lindex $letters [expr ([lsearch $letters $position] -[lsearch $letters $ring])%26]]
 }

 proc enigma::shiftback {position input} {  
    variable letters
    return [lindex $letters [expr ([lsearch $letters $input] -[lsearch $letters $position])%26]]
 }

 proc enigma::rotor {rotor position input {inverse 0}} {
    variable rotors
    upvar trans trans
    #effect one rotor, in one direction:
    
    if { $inverse } {
        append trans [shift $position $input]:$rotors($rotor.inv.[shift $position $input])
        return [shiftback $position $rotors($rotor.inv.[shift $position $input])]
    } else {
        append trans [shift $position $input]:$rotors($rotor.[shift $position $input])
        return [shiftback $position $rotors($rotor.[shift $position $input])]
    }
 }

 proc enigma::create {myRotors rings steckers {reflector B} } {
    variable nextMachine
    variable machines
    variable letters

    set m $nextMachine

    incr nextMachine
    
    set machines($m.rotors) $myRotors
    set machines($m.reflector) $reflector
    for {set i 0} {$i < [llength $myRotors]} {incr i} {
        set machines($m.ring.$i) [lindex $rings $i] 
    }

    foreach swap $steckers {
        set machines($m.board.[string index $swap 0]) [string index $swap 1]
        set machines($m.board.[string index $swap 1]) [string index $swap 0]
    }

    foreach l $letters {
        if {![info exists machines($m.board.$l)]} {
            set machines($m.board.$l) $l
        }
    }

    return $m    
 }

 proc enigma::destroy { machine } {
    variable machines
    foreach key [array names machines -glob $machine.*] {
        unset machines($key)
    }
 }

 proc enigma::get {machine pty} {
    variable machines 
    
    return $machines($machine.$pty)
 }

 proc enigma::setrotors {machine positions} {
    variable machines
    set i 0
    foreach letter $positions {
        set machines($machine.position.$i) $letter
        incr i
    } 
    set machines($machine.position) $positions

 }

 proc enigma::encode {machine letter} {
    #pass current through current configuration of machine, state remains 
    #unaltered.

    variable machines
    variable reflectors

    
    set letter $machines($machine.board.$letter)
    set trans ""
    for {set i [expr [llength $machines($machine.rotors)]-1]} {$i >= 0} {incr i -1} {
        set pos $machines($machine.position.$i)
        
        set corepos [shiftback $machines($machine.ring.$i) $pos]
        #puts "ring $machines($machine.ring.$i) $corepos"
        append trans $letter

        set letter [rotor [lindex $machines($machine.rotors) $i] \
                        $corepos \
                        $letter]

        #set letter [shiftback $machines($machine.ring.$i) $letter]
        #puts "[lindex $machines($machine.rotors) $i] $letter"
        append trans "$letter "

    }
    set letter $reflectors($machines($machine.reflector).$letter)   
    append trans " > $letter "
 
    for {set i 0} {$i < [llength $machines($machine.rotors)]} {incr i} {
        set pos $machines($machine.position.$i)

        set corepos [shiftback $machines($machine.ring.$i) $pos]

        append trans $letter
        set letter [rotor [lindex $machines($machine.rotors) $i] \
                        $corepos \
                        $letter \
                        1]
        append trans "$letter "

    }

    set letter $machines($machine.board.$letter)
    #puts $trans
    return $letter
 }

 proc enigma::step {machine} {
    variable machines
    variable notches

    #determine which ones should rotate:
    #right most always moves.
    lappend pushes [expr [llength $machines($machine.rotors)] -1]
    for {set i [expr [llength $machines($machine.rotors)] -1]} {$i > -1} {incr i -1} {
        if { [lsearch $notches([lindex $machines($machine.rotors) $i]) $machines($machine.position.$i)] >-1 } {
            if { [lsearch $pushes $i] == -1 } { lappend pushes $i }
            if { [lsearch $pushes [expr $i-1]] == -1 } { lappend pushes [expr $i-1] }                
        }
    }

    foreach push $pushes {
        if { $push > -1 } {
            set machines($machine.position.$push) [shift $machines($machine.position.$push) B]
        }
    }

    set i 0
    foreach r $machines($machine.rotors) {
        lappend state $machines($machine.position.$i)
        incr i
    }
    #puts "state: $state $pushes"
    set machines($machine.position) $state

    return $state
 }

 proc enigma::crypt {machine text} {
    set enc ""
    variable letters
    foreach letter [split $text {}] {
        set letter [string toupper $letter]
        if { [lsearch -exact $letters $letter] > -1 } {
            step $machine
            append enc [encode $machine $letter]
        } else {
            append enc $letter
        }
    }
    return $enc
 }

 package require Tk

 wm title . "Pascal's Enigma Simulator"

 proc validateEnigma {} {
    updateOutput
    return 1
 }

 proc updateOutput {} {

    set m [enigma::create $::rotors $::rings $::steckers $::reflector]
    enigma::setrotors $m $::positions
    .output delete 0.0 end
    .output insert 0.0 [enigma::crypt $m [.input get 0.0 end]]
    set ::posat [enigma::get $m position]
    enigma::destroy $m
    if { [.input edit modified] } { .input edit modified 0 }
 }


 label .lrotors -text "Rotore"
 entry .rotors -width 12 -textvariable ::rotors -validate focusout -validatecommand validateEnigma
 grid .lrotors .rotors -sticky nw

 label .lring -text "Ringstellung"
 entry .rings -width 8 -textvariable ::rings -validate focusout -validatecommand validateEnigma
 grid .lring .rings -sticky nw

 label .lsteckers -text "Steckerverbindungen"
 entry .steckers -width 30 -textvariable ::steckers -validate focusout -validatecommand validateEnigma
 grid .lsteckers .steckers -sticky nw

 label .lreflector -text "Reflector"
 entry .reflector -width 3 -textvariable ::reflector -validate focusout -validatecommand validateEnigma
 grid .lreflector .reflector -sticky nw

 label .lpos -text "Rotors start position"
 entry .pos -width 8 -textvariable ::positions -validate focusout -validatecommand validateEnigma
 grid .lpos .pos -sticky nw

 label .lposat -text "Rotor position"
 entry .posat -width 8 -textvariable ::posat -state readonly
 grid .lposat .posat -sticky nw

 label .linput -text "Input" 
 grid .linput -sticky nw

 text .input -width 60 -height 6
 grid .input - -sticky nw

 label .loutput -text "Output"
 grid .loutput  -sticky nw

 text .output -width 60 -height 6
 grid .output -  -sticky nw

 set ::rotors {II I V}
 set ::rings {P R S}
 set ::steckers {IL IK ET CL GH BP VU AS}
 set ::reflector B
 set ::positions {M K U}
 set ::posat $::positions

 bind .input <<Modified>> updateOutput
 if { 0 } {

To encrypt a message, you do this:
 #Use rotors IV I and V, with 'ringstellung' H Z I and 
 #steckerverbindungen DN GR IS KC QX TM PV HY FW BJ.
 set m [enigma::create {IV I V} {H Z I} {DN GR IS KC QX TM PV HY FW BJ}]

 #set the initial letters for encryption (indicator)
 enigma::setrotors $m {T C L}  
 set message_key [list [enigma::crypt $m P] [enigma::crypt $m R] [enigma::crypt $m S]]
 enigma::setrotors $m $message_key
 set encrypted [enigma::crypt $m "Crypto Fun with Tcl!"]
 enigma::setrotors $m $message_key
 puts "$encrypted\n[enigma::crypt $m $encrypted]"

So.

With rotors II I V, at T C L and steckers IL IK ET CL GH BP VU AS, I'd like to say:
 - PRS UCJ FMD -
 PQBFH UNX HVW CGZMYJ YQ. YTTJC DZR LEI XSYTH DR R VQGBKX BFWTSOR BIRI SKFA.

06May2003 PS
 } ;# end if 0.