160 lines
3.4 KiB
Tcl
160 lines
3.4 KiB
Tcl
#!/usr/bin/env tclsh
|
|
|
|
# Tcl implementation of Chaocipher
|
|
# (John F. Byrne, 1918)
|
|
#
|
|
# from paper "CHAOCIPHER REVEALED: THE ALGORITHM"
|
|
# (Moshe Rubin, 2010)
|
|
# http://www.mountainvistasoft.com/chaocipher/ActualChaocipher/Chaocipher-Revealed-Algorithm.pdf
|
|
#
|
|
|
|
# ============ globals "wheels" ============
|
|
variable l_key {HXUCZVAMDSLKPEFJRIGTWOBNYQ}
|
|
variable r_key {PTLNBQDEOYSFAVZKGJRIHWXUMC}
|
|
|
|
|
|
|
|
# ============ procedures ==================
|
|
|
|
|
|
# swap range of n letters from end to front
|
|
proc permute {alpha n } {
|
|
|
|
set A [string range $alpha 0 $n-1 ]
|
|
set B [string range $alpha $n end ]
|
|
|
|
return "${B}${A}"
|
|
}
|
|
|
|
|
|
# rotate based on key in right alphabet
|
|
# (permute each by same amnount)
|
|
proc rotate { left right key } {
|
|
|
|
set idx [string first $key $right]
|
|
|
|
set L [permute $left $idx ]
|
|
|
|
set R [permute $right $idx]
|
|
|
|
return [list $L $R]
|
|
}
|
|
|
|
|
|
# split and rearrange each alphabet
|
|
# according to recipe
|
|
proc cycle { left right } {
|
|
|
|
# (0)(2-13)(1)(14-25)
|
|
set l1 [string index $left 0 ]
|
|
set l2 [string range $left 2 13 ]
|
|
set l3 [string index $left 1 ]
|
|
set l4 [string range $left 14 end]
|
|
|
|
set L [join [list $l1 $l2 $l3 $l4] ""]
|
|
|
|
# (1-2)(4-14)(3)(15-25)(0)
|
|
set r1 [string range $right 1 2 ]
|
|
set r2 [string range $right 4 14 ]
|
|
set r3 [string index $right 3 ]
|
|
set r4 [string range $right 15 end]
|
|
set r5 [string index $right 0 ]
|
|
|
|
set R [join [list $r1 $r2 $r3 $r4 $r5] ""]
|
|
|
|
return [list $L $R]
|
|
}
|
|
|
|
|
|
# rotate wheels and generate cipher text or
|
|
# recover plain text
|
|
proc chao { input left right mode verbose } {
|
|
|
|
set out {}
|
|
|
|
set wheels {}
|
|
|
|
set len [string length $input]
|
|
|
|
if { $verbose } {
|
|
puts stdout "input\t$input\tLENGTH $len"
|
|
|
|
set s [format "%-${len}s\t|\t%-${len}s" $left $right]
|
|
|
|
puts stdout "keys:\t$s"
|
|
|
|
puts stdout "\ncycled keys:"
|
|
}
|
|
|
|
# string -> list
|
|
set input_list [split $input ""]
|
|
|
|
set count 0
|
|
# iterate each letter
|
|
foreach letter $input_list {
|
|
|
|
incr count
|
|
|
|
if {$mode eq "encrypt" } {
|
|
# encrypt
|
|
|
|
# rotate and permute
|
|
set wheels [rotate $left $right $letter]
|
|
lassign $wheels left right
|
|
|
|
# ciphered letter to output (left[0])
|
|
lappend out [string index $left 0]
|
|
|
|
} else {
|
|
|
|
# decrypt
|
|
|
|
# rotate and permute
|
|
set wheels [rotate $right $left $letter]
|
|
lassign $wheels right left
|
|
|
|
# deciphered letter to output (right[0])
|
|
lappend out [string index $right 0]
|
|
}
|
|
|
|
# cycle the alphabets
|
|
set cycled [cycle $left $right]
|
|
lassign $cycled left right
|
|
|
|
if {$verbose} { puts stderr "${count}\t${left}\t|\t${right}" }
|
|
|
|
|
|
} ; # foreach letter
|
|
|
|
# list -> string
|
|
set out [join $out ""]
|
|
|
|
return $out
|
|
}
|
|
|
|
|
|
# ============= main =================
|
|
if { [info script] eq $::argv0 } {
|
|
|
|
# --------- init ------------------
|
|
set left $l_key
|
|
set right $r_key
|
|
set plain_text "WELLDONEISBETTERTHANWELLSAID"
|
|
|
|
# ---------- encipher -------------
|
|
|
|
set cipher_text [chao $plain_text $left $right encrypt 1]
|
|
|
|
# ---------- decipher -------------
|
|
|
|
set decrypted_text [chao $cipher_text $left $right decrypt 0]
|
|
# ----------- output --------------
|
|
|
|
puts stdout "\nplain text: \t ${plain_text}"
|
|
puts stdout "\ncipher text: \t ${cipher_text}"
|
|
puts stdout "\ndecrypted: \t ${decrypted_text}"
|
|
|
|
return 0
|
|
}
|
|
|
|
# end
|