Posted to tcl by Zarutian at Sat Jun 21 11:26:21 GMT 2008view raw
- 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
- }