encrypt and decrypt commands

tsukeh · Post by **tsukeh** » Wed Sep 13, 2006 2:09 pm

I converted one other code to tcl and got those bytetoB64/B64tobyte procedures.

So is there any way to make that 'pure tcl' code faster??

I don't eventually use eggdrop and I have some stability problems with crypto.mod or something..

Testing is done with eggdrop

Code: Select all

load crypto.so; # crypto.mod which provides bencrypt/bdecrypt - http://tclcryptography.sourceforge.net/

package require blowfish
package require math::bignum

set B64 "./0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"

proc encrypt2 {key text} {
 return [bytetoB64 [::blowfish::blowfish -mode ecb -dir encrypt -key $key $text]]
}

proc decrypt2 {key text} {
 return [string trimright [::blowfish::blowfish -mode ecb -dir decrypt -key $key [B64tobyte $text]] \0]
}

proc B64tobyte {ec} {
 set dc ""
 set k -1
 while {$k < [expr [string length $ec] -1]} {
  set right [::math::bignum::fromstr 0]
  set left [::math::bignum::fromstr 0]
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   set k [expr $k+1]
   set right [::math::bignum::bitor $right [::math::bignum::lshift [::math::bignum::fromstr [string first [string index $ec $k] $::B64]] [expr $i*6]]]
  }
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   set k [expr $k+1]
   set left [::math::bignum::bitor $left [::math::bignum::lshift [::math::bignum::fromstr [string first [string index $ec $k] $::B64]] [expr $i*6]]]
  }
  for {set i 0} {$i < 4} {set i [expr $i+1]} {
   set j [expr (3 - $i) * 8]
   append dc [format %c [::math::bignum::tostr [::math::bignum::rshift [::math::bignum::bitand $left [::math::bignum::lshift [::math::bignum::fromstr 255] $j]] $j]]]
  }
  for {set i 0} {$i < 4} {set i [expr $i+1]} {
   set j [expr (3 - $i) * 8]
   append dc [format %c [::math::bignum::tostr [::math::bignum::rshift [::math::bignum::bitand $right [::math::bignum::lshift [::math::bignum::fromstr 255] $j]] $j]]]
  }
 }
 return $dc
}

proc bytetoB64 {ec} {
 set dc ""
 set k -1
 while {$k < [expr [string length $ec]-1]} {
  set k [expr $k+1]
  set left [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 24]
  set k [expr $k+1]
  set left [::math::bignum::add $left [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 16]]
  set k [expr $k+1]
  set left [::math::bignum::add $left [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 8]]
  set k [expr $k+1]
  set left [::math::bignum::add $left [::math::bignum::fromstr [scan [string index $ec $k] %c]]]
  set k [expr $k+1]
  set right [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 24]
  set k [expr $k+1]
  set right [::math::bignum::add $right [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 16]]
  set k [expr $k+1]
  set right [::math::bignum::add $right [::math::bignum::lshift [::math::bignum::fromstr [scan [string index $ec $k] %c]] 8]]
  set k [expr $k+1]
  set right [::math::bignum::add $right [::math::bignum::fromstr [scan [string index $ec $k] %c]]]
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   append dc [string index $::B64 [expr [::math::bignum::tostr $right] & 0x3F]]
   set right [::math::bignum::rshift $right 6]
  }
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   append dc [string index $::B64 [expr [::math::bignum::tostr $left] & 0x3F]]
   set left [::math::bignum::rshift $left 6]
  }
 }
 return $dc
}

bind dcc - start dcc:start
proc dcc:start {hand idx arg} {
 set key [randstring 50]
 set text [randstring 500 "     abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"]
 set start [clock clicks]
 set a [encrypt $key $text]
 putdcc $idx "eggdrop   : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 set start [clock clicks]
 set b [bencrypt $key $text]
 putdcc $idx "crypto.mod: [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 set start [clock clicks]
 set c [encrypt2 $key $text]
 putdcc $idx "pure tcl  : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 if {[string equal $a $b] && [string equal $a $c]} {
  putdcc $idx "encrypt ok"
  set start [clock clicks]
  set c [decrypt $key $a]
  putdcc $idx "eggdrop   : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  set start [clock clicks]
  set d [bdecrypt $key $a]
  putdcc $idx "crypto.mod: [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  set start [clock clicks]
  set e [decrypt2 $key $a]
  putdcc $idx "pure tcl  : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  if {[string equal $c $d] && [string equal $c $e]} { putdcc $idx "decrypt ok" }
 }
}

Some results

Code: Select all

eggdrop   : 212 >> 0ms
crypto.mod: 140 >> 0ms
pure tcl  : 458417 >> 458ms
encrypt ok
eggdrop   : 112 >> 0ms
crypto.mod: 80 >> 0ms
pure tcl  : 640686 >> 640ms
decrypt ok

eggdrop   : 241 >> 0ms
crypto.mod: 147 >> 0ms
pure tcl  : 444290 >> 444ms
encrypt ok
eggdrop   : 99 >> 0ms
crypto.mod: 73 >> 0ms
pure tcl  : 655279 >> 655ms
decrypt ok

eggdrop   : 210 >> 0ms
crypto.mod: 143 >> 0ms
pure tcl  : 453591 >> 453ms
encrypt ok
eggdrop   : 108 >> 0ms
crypto.mod: 73 >> 0ms
pure tcl  : 642180 >> 642ms
decrypt ok

eggdrop   : 213 >> 0ms
crypto.mod: 143 >> 0ms
pure tcl  : 448376 >> 448ms
encrypt ok
eggdrop   : 106 >> 0ms
crypto.mod: 111 >> 0ms
pure tcl  : 641055 >> 641ms
decrypt ok

tsukeh · Post by **tsukeh** » Sat Sep 23, 2006 1:54 pm

I made some changes/fixes to code and it's now slightly faster..

Code: Select all

load crypto.so; # crypto.mod which provides bencrypt/bdecrypt - http://tclcryptography.sourceforge.net/

package require blowfish
package require math::bignum

set B64 "./0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"

proc encrypt2 {key text} {
 return [bytetoB64 [::blowfish::blowfish -mode ecb -dir encrypt -key $key -- $text]]
}

proc decrypt2 {key text} {
 return [string trimright [::blowfish::blowfish -mode ecb -dir decrypt -key $key -- [B64tobyte $text]] \0]
}

proc B64tobyte {ec} {
 set dc ""
 set k -1
 while {$k < [expr [string length $ec] -1]} {
  set right "bignum 0 0"
  set left "bignum 0 0"
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   set k [expr $k+1]
   set p "bignum 0 [string first [string index $ec $k] $::B64]"
   set right [::math::bignum::bitor $right [::math::bignum::lshift $p [expr $i*6]]]
  }
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   set k [expr $k+1]
   set p "bignum 0 [string first [string index $ec $k] $::B64]"
   set left [::math::bignum::bitor $left [::math::bignum::lshift $p [expr $i*6]]]
  }
  for {set i 0} {$i < 4} {set i [expr $i+1]} {
   set j [expr (3 - $i) * 8]
   append dc [format %c [lindex [::math::bignum::rshift [::math::bignum::bitand $left [::math::bignum::lshift "bignum 0 255" $j]] $j] 2]]
  }
  for {set i 0} {$i < 4} {set i [expr $i+1]} {
   set j [expr (3 - $i) * 8]
   append dc [format %c [lindex [::math::bignum::rshift [::math::bignum::bitand $right [::math::bignum::lshift "bignum 0 255" $j]] $j] 2]]
  }
 }
 return $dc
}

proc bytetoB64 {ec} {
 set dc ""
 set k -1
 while {$k < [expr [string length $ec]-1]} {
  set k [expr $k+1]
  set left [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 24]
  set k [expr $k+1]
  set left [::math::bignum::add $left [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 16]]
  set k [expr $k+1]
  set left [::math::bignum::add $left [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 8]]
  set k [expr $k+1]
  set left [::math::bignum::add $left "bignum 0 [scan [string index $ec $k] %c]"]
  set k [expr $k+1]
  set right [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 24]
  set k [expr $k+1]
  set right [::math::bignum::add $right [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 16]]
  set k [expr $k+1]
  set right [::math::bignum::add $right [::math::bignum::lshift "bignum 0 [scan [string index $ec $k] %c]" 8]]
  set k [expr $k+1]
  set right [::math::bignum::add $right "bignum 0 [scan [string index $ec $k] %c]"]
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   append dc [string index $::B64 [expr [lindex $right 2] & 63]]
   set right [::math::bignum::rshift $right 6]
  }
  for {set i 0} {$i < 6} {set i [expr $i+1]} {
   append dc [string index $::B64 [expr [lindex $left 2] & 63]]
   set left [::math::bignum::rshift $left 6]
  }
 }
 return $dc
}

bind dcc - start dcc:start
proc dcc:start {hand idx arg} {
 set key [randstring 50]
 set text [randstring 500 "     abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"]
 set start [clock clicks]
 set a [encrypt $key $text]
 putdcc $idx "eggdrop   : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 set start [clock clicks]
 set b [bencrypt $key $text]
 putdcc $idx "crypto.mod: [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 set start [clock clicks]
 set c [encrypt2 $key $text]
 putdcc $idx "pure tcl  : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
 if {[string equal $a $b] && [string equal $a $c]} {
  putdcc $idx "encrypt ok"
  set start [clock clicks]
  set c [decrypt $key $a]
  putdcc $idx "eggdrop   : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  set start [clock clicks]
  set d [bdecrypt $key $a]
  putdcc $idx "crypto.mod: [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  set start [clock clicks]
  set e [decrypt2 $key $a]
  putdcc $idx "pure tcl  : [set m [expr [clock clicks]-$start]] >> [expr $m/1000]ms"
  if {[string equal $c $d] && [string equal $c $e]} { putdcc $idx "decrypt ok" }
 }
}

Results:

Code: Select all

eggdrop   : 205 >> 0ms
crypto.mod: 153 >> 0ms
pure tcl  : 117292 >> 117ms
encrypt ok
eggdrop   : 104 >> 0ms
crypto.mod: 82 >> 0ms
pure tcl  : 146692 >> 146ms
decrypt ok

eggdrop   : 216 >> 0ms
crypto.mod: 153 >> 0ms
pure tcl  : 115533 >> 115ms
encrypt ok
eggdrop   : 106 >> 0ms
crypto.mod: 82 >> 0ms
pure tcl  : 149397 >> 149ms
decrypt ok

eggdrop   : 207 >> 0ms
crypto.mod: 144 >> 0ms
pure tcl  : 116060 >> 116ms
encrypt ok
eggdrop   : 105 >> 0ms
crypto.mod: 80 >> 0ms
pure tcl  : 145388 >> 145ms
decrypt ok

eggdrop   : 215 >> 0ms
crypto.mod: 152 >> 0ms
pure tcl  : 115100 >> 115ms
encrypt ok
eggdrop   : 105 >> 0ms
crypto.mod: 75 >> 0ms
pure tcl  : 145903 >> 145ms
decrypt ok

I also made patch for crypto.mod which fixes some memory leaks, but I still have some problems with it.

crypto.patch:

Code: Select all

--- module.c    2003-08-05 20:28:16.000000000 +0300
+++ module.c.new        2006-09-19 21:16:54.000000000 +0300
@@ -53,15 +53,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)twofish_encrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = twofish_encrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)twofish_encrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = twofish_encrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }
@@ -75,15 +80,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)twofish_decrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = twofish_decrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)twofish_decrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = twofish_decrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }
@@ -110,15 +120,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)blowfish_encrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = blowfish_encrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)blowfish_encrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = blowfish_encrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }
@@ -132,15 +147,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)blowfish_decrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = blowfish_decrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)blowfish_decrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = blowfish_decrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }
@@ -167,15 +187,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)rijndael_encrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = rijndael_encrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)rijndael_encrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = rijndael_encrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }
@@ -189,15 +214,20 @@
                return TCL_ERROR;
        }

+       char *p;
        if(argc > 2) {
                if(strlen(argv[1]) > 512) {
                        Tcl_SetResult(interp, "Error, Maximum key length is 512 characters.", TCL_STATIC);
                        return TCL_ERROR;
                }
-               Tcl_SetResult(interp, (char *)rijndael_decrypt_string(argv[1], argv[2]), TCL_STATIC);
+               p = rijndael_decrypt_string(argv[1], argv[2]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        } else {
-               Tcl_SetResult(interp, (char *)rijndael_decrypt_string(DEFAULTKEY, argv[1]), TCL_STATIC);
+               p = rijndael_decrypt_string(DEFAULTKEY, argv[1]);
+               Tcl_AppendResult(interp, p, TCL_STATIC);
+               free(p);
                return TCL_OK;
        }
 }

Any help and ideas are still welcome!

demond · Post by **demond** » Sat Sep 23, 2006 2:51 pm

tsukeh wrote: So is there any way to make that 'pure tcl' code faster??

sure, write better code

for example, instead of explicit loops and external proc invokations, use simple table lookup & substitution, like this: (courtesy of RS from the Tcl'ers Wiki)

Code: Select all

 proc b64en str {
    binary scan $str B* bits
    switch [expr {[string length $bits]%6}] {
        0 {set tail ""}
        2 {append bits 0000; set tail ==}
        4 {append bits 00; set tail =}
    }
    return [string map {
        000000 A 000001 B 000010 C 000011 D 000100 E 000101 F
        000110 G 000111 H 001000 I 001001 J 001010 K 001011 L
        001100 M 001101 N 001110 O 001111 P 010000 Q 010001 R
        010010 S 010011 T 010100 U 010101 V 010110 W 010111 X
        011000 Y 011001 Z 011010 a 011011 b 011100 c 011101 d
        011110 e 011111 f 100000 g 100001 h 100010 i 100011 j
        100100 k 100101 l 100110 m 100111 n 101000 o 101001 p
        101010 q 101011 r 101100 s 101101 t 101110 u 101111 v
        110000 w 110001 x 110010 y 110011 z 110100 0 110101 1
        110110 2 110111 3 111000 4 111001 5 111010 6 111011 7
        111100 8 111101 9 111110 + 111111 /
    } $bits]$tail
 }

tsukeh · Post by **tsukeh** » Sat Sep 23, 2006 3:27 pm

That standard base64 is not compatible with encrypt/decrypt commands in eggdrop/crypto.mod..

egghelp/eggheads community

encrypt and decrypt commands

encrypt and decrypt commands

Re: encrypt and decrypt commands