Posted to tcl by Zarutian at Sat Jun 21 02:32:08 GMT 2008view pretty

package require Tcl 8.5
package require sha1

# cipher feedback (cfb) based cipher

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 cipher [XOR $tmp3 [string range $plain 0 19]]
    append out [string range $chiper 0 [expr {$tmp2 - 1}]]
    set plain [string range $plain 20 end]
    set tmp1 $chiper
    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 tmp1 [string range $cipher 0 19]
    append out [string range [XOR $tmp3 $tmp1] 0 [expr {$tmp2 - 1}]]
    set cipher [string range $cipher 20 end]
    set tmp2 [string length $cipher]
  }
  return $out
}

proc XOR {a b} {
  binary scan $a H* a
  binary scan $b H* b
  scan $a "%040x" a
  scan $b "%040x" b
  set c [expr {$a ^ $b}]
  return [binary format H* [format "%040x" $c]]
}

Comments

Posted by Zarutian at Sat Jun 21 11:24:23 GMT 2008 [text] [code]

this one got errors so dont use