Data update

Task/Chaocipher/Ada/chaocipher.adb

@@ -0,0 +1,101 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure chao_slices is
+   type iMode is (Encrypt, Decrypt);
+
+   L_Alphabet : String := "HXUCZVAMDSLKPEFJRIGTWOBNYQ";
+   R_Alphabet : String := "PTLNBQDEOYSFAVZKGJRIHWXUMC";
+   plaintext  : String := "WELLDONEISBETTERTHANWELLSAID";
+   ciphertext : String (1 .. plaintext'length);
+   plaintext2 : String (1 .. plaintext'length);
+   offset     : Natural;
+
+   function IndexOf (Source : String; Value : Character) return Positive is
+      Result : Positive;
+
+   begin
+      for I in Source'Range loop
+         if Source (I) = Value then
+            Result := I;
+            exit;
+         end if;
+      end loop;
+      return Result;
+   end IndexOf;
+
+   function Exec
+     (Text : String; mode : iMode; showsteps : Boolean := False) return String
+   is
+      etext : String (Text'First .. Text'Last);
+      temp  : String (1 .. 26);
+      index : Positive;
+      store : Character;
+      left  : String := L_Alphabet;
+      right : String := R_Alphabet;
+   begin
+      for I in Text'Range loop
+         if showsteps then
+            Put_Line (left & "  " & right);
+         end if;
+
+         if mode = Encrypt then
+            index     := IndexOf (Source => right, Value => Text (I));
+            etext (I) := left (index);
+         else
+            index     := IndexOf (Source => left, Value => Text (I));
+            etext (I) := right (index);
+         end if;
+
+         exit when I = Text'Last;
+
+         -- permute left
+         -- The array value permutations are performed using array slices
+         -- rather than explicit loops
+
+         if index > 1 then
+            offset                 := 26 - index;
+            temp (1 .. offset + 1) := left (index .. index + offset);
+
+            temp (offset + 2 .. 26) := left (1 .. index - 1);
+            store                   := temp (2);
+
+            temp (2 .. 13) := temp (3 .. 14);
+            temp (14)      := store;
+            left           := temp;
+
+            -- permute right
+            -- The array value permutations are performed using array slices
+            -- rather than explicit loops
+
+            temp (1 .. offset + 1) := right (index .. index + offset);
+
+            temp (offset + 2 .. 26) := right (1 .. index - 1);
+            store                   := temp (1);
+
+            temp (1 .. 25) := temp (2 .. 26);
+            temp (26)      := store;
+            store          := temp (3);
+
+            temp (3 .. 13) := temp (4 .. 14);
+            temp (14)      := store;
+            right          := temp;
+         end if;
+
+      end loop;
+
+      return etext;
+
+   end Exec;
+begin
+   Put_Line ("The original text is : " & plaintext);
+   New_Line;
+   Put_Line
+     ("The left and right alphabets after each permutation during encryption are:");
+   New_Line;
+   ciphertext := Exec (plaintext, Encrypt, True);
+   New_Line;
+   Put_Line ("The ciphertext is : " & ciphertext);
+   plaintext2 := Exec (ciphertext, Decrypt);
+   New_Line;
+   Put_Line ("The recovered plaintext is : " & plaintext2);
+end chao_slices;

Task/Chaocipher/Crystal/chaocipher.cr

@@ -0,0 +1,40 @@
+enum Chaoperation
+  Encode
+  Decode
+end
+
+class Array
+  # useful method to work on parts of the array
+  def slice (start, length)
+    start = size - start if start < 0
+    raise "Out of bounds" unless start >= 0 && length >= 0 && start + length <= size
+    Slice.new(to_unsafe + start, length)
+  end
+end
+
+def chaocipher (message : String, left : String, right : String,
+                op : Chaoperation = Chaoperation::Encode)
+  ct = left.chars
+  pt = right.chars
+  String.build do |s|
+    message.each_char do |ch|
+      idx = (op == Chaoperation::Encode ? pt : ct).index! ch
+      s <<  (op == Chaoperation::Encode ? ct : pt)[idx]
+      # permute left
+      ct.rotate! idx
+      ct.slice(1, 13).rotate! 1
+      # permute right
+      pt.rotate! idx+1
+      pt.slice(2, 12).rotate! 1
+    end
+  end
+end
+
+left = "HXUCZVAMDSLKPEFJRIGTWOBNYQ"
+right = "PTLNBQDEOYSFAVZKGJRIHWXUMC"
+message = "WELLDONEISBETTERTHANWELLSAID"
+
+encoded = chaocipher(message, left, right)
+decoded = chaocipher(encoded, left, right, Chaoperation::Decode)
+
+print message, " -> ", encoded, " -> ", decoded, "\n"

Task/Chaocipher/Forth/chaocipher.fth

@@ -0,0 +1,77 @@
+                                       \ triple words
+: 3drop drop drop drop ;               ( n1 n2 n3 ---)
+: 3dup >r over over r@ rot rot r> ;    ( n1 n2 n3 -- n1 n2 n3 n1 n2 n3)
+                                       \ ASCIIZ string words
+: zstring create chars allot ;         ( a1 -- a1 n1)
+: zcount dup begin dup c@ while char+ repeat over - ;
+: zplace over chars over + >r swap cmove 0 r> c! ;
+: +zplace zcount chars + zplace ;      ( a1 n1 a2 --)
+                                       \ find character in string
+: where?                               ( c a1 n1 -- n2)
+  0 ?do over over i chars + c@ = if drop i negate leave then loop nip negate ;
+
+64 constant /str                       \ size of input/output string
+27 constant /alpha                     \ size of alphabet
+
+/str zstring {i}                       \ input string
+/str zstring {o}                       \ output string
+
+/alpha zstring l                       \ left alphabet
+/alpha zstring r                       \ right alphabet
+/alpha zstring t                       \ temporary alphabet
+
+: [] chars + ;                         ( a n -- a+n)
+: .tab 9 emit ;                        ( --)
+: .list cr .tab zcount type cr ;       ( a --)
+
+: PermuteLeft                          ( index --)
+  26 over ?do t over negate i + [] l i [] c@ swap c! loop
+  dup   0 ?do t over negate 26 i + + [] l i [] c@ swap c! loop drop
+  t char+ c@ >r t 2 [] dup char- 12 cmove r> t 13 [] c! t zcount l zplace
+;
+
+: PermuteRight                         ( index --)
+  26 over ?do t over negate i + [] r i [] c@ swap c! loop
+  dup   0 ?do t over negate 26 i + + [] r i [] c@ swap c! loop drop
+  t c@ >r      t char+ dup char- 25 cmove r> t 25 [] c!
+  t 2 [] c@ >r t 3 []  dup char- 11 cmove r> t 13 [] c! t zcount r zplace
+;
+
+: Encrypt                              ( input output index1 -- index2)
+  >r swap r@ [] c@ r /alpha where? dup 0< abort" Corrupt right alphabet"
+  l over [] c@ rot r> [] c!
+;
+
+: Decrypt                              ( input output index1 -- index2)
+  >r swap r@ [] c@ l /alpha where? dup 0< abort" Corrupt left alphabet"
+  r over [] c@ rot r> [] c!
+;
+
+: chao                                 ( i o xt f --)
+  s" HXUCZVAMDSLKPEFJRIGTWOBNYQ" l zplace
+  s" PTLNBQDEOYSFAVZKGJRIHWXUMC" r zplace
+  t /alpha erase >r                    \ erase temporary string
+                                       ( i o xt R: f)
+  r@ if cr ." The left and right alphabets after each permutation:" cr then
+  >r over r> swap zcount 1- nip >r     ( i o xt R: f len)
+
+  0 begin                              ( i o xt 0 R: f len)
+    r> r@ if l zcount type 2 spaces r zcount type cr then >r
+    >r 3dup r@ swap execute r> dup r@ <
+  while                                ( i o xt 0 R: f len)
+    >r dup PermuteLeft PermuteRight r> 1+
+  repeat rdrop rdrop drop drop 3drop
+;
+
+: main
+  s" WELLDONEISBETTERTHANWELLSAID" {i} zplace
+  {o} /str erase                       \ initialize output string
+
+     ." The original plaintext is :"  {i} .list
+  {i} {o} ['] Encrypt true  chao
+  cr ." The ciphertext is :"          {o} .list
+  {o} {i} ['] Decrypt false chao
+  cr ." The recovered plaintext is :" {i} .list
+;
+
+main

Task/Chaocipher/Pluto/chaocipher.pluto

@@ -0,0 +1,55 @@
+require "table2"
+
+enum chao begin
+    encrypt,
+    decrypt
+end
+
+local function exec(text, mode, show_steps)
+    local len = #text
+    local left  = "HXUCZVAMDSLKPEFJRIGTWOBNYQ"
+    local right = "PTLNBQDEOYSFAVZKGJRIHWXUMC"
+    local etext = table.rep(len, 0)
+    local temp  = table.rep(26, "")
+    for i = 1, len do
+        if show_steps then print($"{left}  {right}") end
+        local index
+        if mode == chao.encrypt then
+            index = right:find(text[i], 1, true)
+            etext[i] = left[index]
+        else
+            index = left:find(text[i], 1, true)
+            etext[i] = right[index]
+        end
+        if i == len then break end
+
+        -- Permute left.
+        for j = index, 26 do temp[j - index + 1] = left[j] end
+        for j = 1, index - 1 do temp[27 - index + j] = left[j] end
+        local store = temp[2]
+        for j = 3, 14 do temp[j - 1] = temp[j] end
+        temp[14] = store
+        left = temp:concat("")
+
+        -- Permute right.
+        for j = index, 26 do temp[j - index + 1] = right[j] end
+        for j = 1, index - 1 do temp[27 - index + j] = right[j] end
+        store = temp[1]
+        for j = 2, 26 do temp[j - 1] = temp[j] end
+        temp[26] = store
+        store = temp[3]
+        for j = 4, 14 do temp[j - 1] = temp[j] end
+        temp[14] = store
+        right = temp:concat("")
+    end
+    return etext:concat("")
+end
+
+local plain_text = "WELLDONEISBETTERTHANWELLSAID"
+print($"The original plaintext is : {plain_text}")
+io.write("\nThe left and right alphabets after each permutation ")
+print("during encryption are :\n")
+local cipher_text = exec(plain_text, chao.encrypt, true)
+print($"\nThe ciphertext is : {cipher_text}")
+local plain_text2 = exec(cipher_text, chao.decrypt, false)
+print($"\nThe recovered plaintext is : {plain_text2}")

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