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