Data update

Task/Chaocipher/Tcl/chaocipher.tcl

@@ -0,0 +1,160 @@
+#!/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