Posted to tcl by Zarutian at Sat Jun 21 02:32:08 GMT 2008view raw
- 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