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 }