In WWII (and before), the Germans relied on the Enigma machine to keep their communications secret. With information from [http://www.codesandciphers.org.uk/enigma/] and using [http://homepages.tesco.net/~andycarlson/enigma/enigma_j.html] 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 [wish-reaper].

Ethan Urie has written a nice document about the Enigma, the history, design and breaking [http://www.csh.rit.edu/~ethan/The%20Enigma%20Machine.pdf]. The Code Book [http://www.simonsingh.com/The_Code_Book.html] 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::setrotors {machine positions} {
    variable machines
    set i 0
    foreach letter $positions {
	set machines($machine.position.$i) $letter
	incr i
    } 
 }

 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"
    return $state
 }

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

 package require Tk

 wm title . "Pascal's Eniga 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
----

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 - 
 SKWZS XDI ZDS YOUPQM QX. WSMTY DLQ OID QCAXW BN U ROHKFW OLABHOM WKXL WISI.

06May2003 [PS]

----

[[
[Category Cryptography]
]]