# vigenere.tcl - Copyright (C) 2002 Pat Thoyts <[email protected]>
 #
 # Provide a Tcl only implementation of the Vigen?re cipher.
 #
 # -------------------------------------------------------------------------
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # -------------------------------------------------------------------------
 # @(#)$Id: 2884,v 1.8 2005-04-25 06:00:14 jcw Exp $
 
 namespace eval vigen?re {
     namespace export vigen?re
 
     interp alias {} [namespace current]::encode \
         {} [namespace current]::Cipher encode
     interp alias {} [namespace current]::decode \
         {} [namespace current]::Cipher decode
 }
 
 # -------------------------------------------------------------------------
 # Description:
 #  An implementation of the Vigen?re symmetric polyalphabetic cipher.
 #  In this cipher each letter is encoded using a caesar rotation given by the
 #  value of the corresponding letter in the key.
 #
 proc vigen?re::Cipher {mode key plaintext} {
     binary scan $plaintext c* plainchars
     set K [Shifts $mode $key]
     set N 0
     set M [llength $K]
     foreach c $plainchars {
         set n [lindex $K $N]
         set C [expr {
                      (($c ^ 0x40) & 0x5F) < 27 ? 
                      (((($c ^ 0x40) & 0x5F) + $n - 1) % 26 + 1) | ($c & 0xe0)
                      : $c
                  }]
         if {$c != $C} {
             incr N
             if {$N >= $M} { set N 0}
         }
         append r [format %c $C]
     }
     return $r
 }
 
 # -------------------------------------------------------------------------
 # Description:
 #  The cipher operates by converting the key phrase into a sequence of shift 
 #  values from 1 to 26 that correspond to Caesar alphabets to use for enciphering
 #  the current character. This procedure calculates the shifts from the key text.
 #
 proc vigen?re::Shifts {mode keytext} {
     binary scan $keytext c* keychars
     set encode [string match "encode" $mode]
     foreach kc $keychars {
         set v [expr {($kc & 0x5f) - 0x41}]
         if {$encode} {
             lappend shifts $v
         } else {
             lappend shifts [expr {abs($v - 26)}]
         }
     }
     return $shifts
 }
 
 # -------------------------------------------------------------------------
 # Description:
 #  Encrypt data using the Vigen?re cipher. Not secure (but better that rot13!)
 #
 proc vigen?re::vigen?re {args} {
     array set opts {filename {} mode encode key {}}
     while {[string match -* [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
             -k* {
                 set opts(key) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }                
             -m* {
                 set opts(mode) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }                
             -f* {
                 set opts(filename) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -- {
                 set args [lreplace $args 0 0]
                 break
             }
             default {
                 return -code error "bad option [lindex $args 0]:\
                       must be -key, -mode, -filename or --"
             }
         }
         set args [lreplace $args 0 0]
     }
 
     if {$opts(key) == {}} {
         return -code error "invalid args: -key must be specified"
     }
 
     if {$opts(filename) != {}} {
         set f [open $opts(filename) r]
         #fconfigure $f -translation binary
         set data [read $f]
         close $f
     } else {
         if {[llength $args] != 1} {
             return -code error "wrong \# args: should be\
                   \"vigen?re ?-mode mode? -key phrase -file name | data\""
         }
         set data [lindex $args 0]
     }
 
     if {[string match "encode" $opts(mode)]} {
         return [encode $opts(key) $data]
     } else {
         return [decode $opts(key) $data]
     }
 }
 
 # -------------------------------------------------------------------------
 
 package provide vigen?re 1.0
 
 # -------------------------------------------------------------------------
 #
 # Local variables:
 #   mode: tcl
 #   indent-tabs-mode: nil
 # End: