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

  1. package require Tcl 8.5
  2. package require sha1
  3.  
  4. # cipher feedback (cfb) based cipher
  5.  
  6. proc encrypt {iv plain key} {
  7. set out {}
  8. set tmp1 $iv
  9. set tmp2 [string length $plain]
  10. while {$tmp2 > 0} {
  11. while {[string length $plain] < 20]} {
  12. append plain \x00
  13. }
  14. set tmp3 [sha1::sha1 "[set key][set tmp1]"]
  15. set cipher [XOR $tmp3 [string range $plain 0 19]]
  16. append out [string range $chiper 0 [expr {$tmp2 - 1}]]
  17. set plain [string range $plain 20 end]
  18. set tmp1 $chiper
  19. set tmp2 [string length $plain]
  20. }
  21. return $out
  22. }
  23. proc decrypt {iv cipher key} {
  24. set out {}
  25. set tmp1 $iv
  26. set tmp2 [string length $cipher]
  27. while {$tmp2 > 0} {
  28. while {[string length $cipher] < 20]} {
  29. append cipher \x00
  30. }
  31. set tmp3 [sha1::sha1 "[set key][set tmp1]"]
  32. set tmp1 [string range $cipher 0 19]
  33. append out [string range [XOR $tmp3 $tmp1] 0 [expr {$tmp2 - 1}]]
  34. set cipher [string range $cipher 20 end]
  35. set tmp2 [string length $cipher]
  36. }
  37. return $out
  38. }
  39.  
  40. proc XOR {a b} {
  41. binary scan $a H* a
  42. binary scan $b H* b
  43. scan $a "%040x" a
  44. scan $b "%040x" b
  45. set c [expr {$a ^ $b}]
  46. return [binary format H* [format "%040x" $c]]
  47. }

Comments

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

this one got errors so dont use