Posted to tcl by Zarutian at Sat Jun 21 11:26:21 GMT 2008view pretty

package require Tcl 8.5
package require sha1 1.0.3

# an simple cipher feedback (cfb) based cipher
#
# This version actually works
# I suspect that the strength of this cipher
# is based on the strength of the one-way function it uses
# (which is sha1)

proc encrypt {iv plain key} {
  set out {}
  set tmp1 $iv
  set tmp2 [string length $plain]
  while {$tmp2 > 0} {
    while {[string length $plain] < 20} {
      append plain \x00
    }
    set tmp3 [sha1::sha1 "[set key][set tmp1]"]
    set tmp4 [bin2hex [string range $plain 0 19]]
    set tmp5 [XOR $tmp3 $tmp4]
    set cipher [hex2bin $tmp5]
    append out [string range $cipher 0 [expr {$tmp2 - 1}]]
    set plain [string range $plain 20 end]
    set tmp1 $cipher
    set tmp2 [string length $plain]
  }
  return $out
}
proc decrypt {iv cipher key} {
  set out {}
  set tmp1 $iv
  set tmp2 [string length $cipher]
  while {$tmp2 > 0} {
    while {[string length $cipher] < 20} {
      append cipher \x00
    }
    set tmp3 [sha1::sha1 "[set key][set tmp1]"]
    set tmp4 [string range $cipher 0 19]
    set tmp5 [bin2hex $tmp4]
    set tmp6 [XOR $tmp3 $tmp5]
    set tmp7 [hex2bin $tmp6]
    append out [string range $tmp7 0 [expr {$tmp2 - 1}]]
    set cipher [string range $cipher 20 end]
    set tmp1 $tmp4
    set tmp2 [string length $cipher]
  }
  return $out
}

proc XOR {a b} {
  if {[string length $a] != [string length $b]} {
    error "a and b arent of same length!"
  }
  set out {}
  foreach i [split $a ""] j [split $b ""] {
    scan $i "%x" i
    scan $j "%x" j
    set c [expr {$i ^ $j}]
    append out [format "%x" $c]
  }
  return $out
}
proc bin2hex {input} {
  set out {}
  foreach byte [split $input ""] {
    binary scan $byte H* t
    append out $t
  }
  return $out
}
proc hex2bin {input} {
  set out {}
  foreach {a b} [split $input ""] {
    set c "[set a][set b]"
    append out [binary format H* $c]
  }
  return $out
}