20040608 [CMcC] - This is the [RSA] crypto algorithm in pure Tcl, requiring the [bignum] package. ====== package require bignum # Key is an array with at least the following # n - public modulus # e - public exponent # d - exponent # and optionally these elements # p - prime p. # q - prime q. # u - inverse of p mod q. namespace eval rsa { namespace import ::bigint::* proc rsa_encrypt {input skey} { upvar $skey key if {[bitsize $key(n)] < [bitsize $input]} { error "keysize [bitsize $key(n)] must be greater than text [bitsize $input]/$input" } return [powm $input $key(e) $key(n)] } # fast RSA decryption # translated from gnupg # # ptext = ctext^d mod n # # Or faster: # # m1 = ctext ^ (d mod (p-1)) mod p # m2 = ctext ^ (d mod (q-1)) mod q # h = u * (m2 - m1) mod q # ptext = m1 + h * p # # Where m is OUTPUT, c is INPUT and d,n,p,q,u are elements of SKEY. proc rsa_decrypt {input skey} { upvar $skey key if {[bitsize $key(n)] < [bitsize $input]} { error "keysize [bitsize $key(n)] must be greater than text [bitsize $input]/$input" } if {![info exists key(p)]} { return [rsa_slow_decrypt $input key] } # m1 = c ^ (d mod (p-1)) mod p set m1 [powm $input [fdiv_r $key(d) [sub_ui $key(p) 1]] $key(p)] # m2 = c ^ (d mod (q-1)) mod q set m2 [powm $input [fdiv_r $key(d) [sub_ui $key(q) 1]] $key(q)] # h = u * ( m2 - m1 ) mod q set h [sub $m2 $m1] if {[cmp_si $h 0] < 0} { set h [add $h $key(q)] } set h [fdiv_r [mul $key(u) $h] $key(q)] # m = m2 + h * p set m [add $m1 [mul $h $key(p)]] return $m } # Public key operation. decrypt INPUT with PKEY and put result into OUTPUT. # # c = m^d mod n # # Where c is OUTPUT, m is INPUT and e,n are elements of PKEY. proc rsa_slow_decrypt {input pkey} { upvar $pkey key if {[bitsize $key(n)] < [bitsize $input]} { error "keysize [bitsize $key(n)] must be greater than text [bitsize $input]/$input" } if {[catch {set ptext [powm $input $key(d) $key(n)]}]} { puts "rsa_slow_decrypt: $input [hex $key(d)] [hex $key(n)]" error "powm error" } return $ptext } proc pack_text {ptext keylen} { # pack ptext with md5 while {[string length $ptext] < ($keylen - 16)} { append ptext [binary format H* [::md5::md5 $ptext]] } if {[string length $ptext] < $keylen} { set md5 [binary format H* [::md5::md5 $ptext]] append ptext [string range $md5 0 [expr $keylen - [string length $ptext] - 1]] } # convert the string to a hex number binary scan $ptext H* hex return [convert 0x$hex] } # encrypt a string - pad it out to full string size proc encrypt {ptext pkey} { upvar $pkey key set keylen [bytesize $key(n)] set en [pack_text $ptext $keylen] set en [rsa_encrypt $en key] append ctext [hex $en] set ctext [binary format H* $ctext] return $ctext } # encrypt a packet # packet format: [md5][length][payload][padding] proc encrypt_packet {ptext pkey} { upvar $pkey key set plen [binary format I [string length $ptext]] set md5 [binary format H32 [::md5::md5 $ptext]] set ptext ${md5}${plen}$ptext return [encrypt $ptext key] } proc decrypt {ctext pkey} { upvar $pkey key set keylen [bytesize $key(n)] binary scan $ctext H* block append ptext [hex [rsa_decrypt 0x$block key]] return [binary format H* $ptext] } # decrypt a packet # packet format: [md5][length][payload][padding] proc decrypt_packet {ctext pkey} { upvar $pkey key set ptext [decrypt $ctext key] binary scan $ptext a16I md5 plen set ptext [string range $ptext 20 end] set ptext [string range $ptext 0 [expr $plen - 1]] set md5calc [binary format H* [::md5::md5 $ptext]] if {$md5calc != $md5} { error "packet checksum failed $md5calc != $md5: $plen / $ptext" } return $ptext } namespace export encrypt* decrypt* } # gpg --gen-key --debug=4 ====== Here is a test of the rsa package: ====== array set key { name sample5 e 0x010001 d 0x036C3A32890E163000E25FAC522E1B3BAB6086837E6EF01CADCB4AA6DBDF0267D695FABA49ABB04B359E051DCE72FC377FE5C999D79D543861938233481E0D49D1 n 0x057CA8F6CA506C64FC8BB83482F6EDD6C9AF6EF2EB235217680F7B76072CE320196355C89C0670B37D6F294FA4817EE1E7022566F17C8FB24C8B5ADA1A9BA115A7 } proc do_key {} { global key foreach {var val} [array get key] { if {$var != "name"} { set key($var) [convert $val] } } } do_key #mod_tsts set t "now is the winter of our discontent" set ct [rsa::encrypt $t key] set pt [rsa::decrypt $ct key] puts $pt ====== ---- [SSCH] - What/Where is the "convert" command? [NEM] - What/where are the "do_key" and "mod_tsts" commands? [CMcC] - The original test code was 200 lines, do_key converts the key components to binary (added) mod_tsts compares the result of several different decrypt techniques. [Zarutian] - Is there any implemention of the RSA crypto without using a extension? [CMcC] - nope. It involves arithmetic operation over thousand-bit integers, which would be fairly slow. [Zarutian] - I am mainly asking because of portability issues. See wish nr #70 on the [Tcl 9.0 WishList]. [LV] If someone could point us to the original algorithm, the missing function might be able to be written. ---- ====== load ~/Tcl/mpexpr10.dll package require Mpexpr proc powm5 { x n m } { set result 1 while { [mpexpr { $n != 0 }] } { if { [mpexpr { $n % 2 } == 1] } { set result [mpexpr { ( $result * $x ) % $m }] } set x [mpexpr { ($x * $x) % $m }] set n [mpexpr { $n >> 1 }] } return $result } array set key { name sample5 e 0x010001 d 0x036C3A32890E163000E25FAC522E1B3BAB6086837E6EF01CADCB4AA6DBDF0267D695FABA49ABB04B359E051DCE72FC377FE5C999D79D543861938233481E0D49D1 n 0x057CA8F6CA506C64FC8BB83482F6EDD6C9AF6EF2EB235217680F7B76072CE320196355C89C0670B37D6F294FA4817EE1E7022566F17C8FB24C8B5ADA1A9BA115A7 } binary scan "now is the winter of our discontent" h* t set plaintext 0x$t set plaintext [mpexpr $plaintext] puts $plaintext set cypher [powm5 $plaintext $key(e) $key(n)] puts $cypher set plain2 [powm5 $cypher $key(d) $key(n)] puts $plain2 puts "encrypt: [time {powm5 $plaintext $key(e) $key(n)} 10]" puts "decrypt: [time {powm5 $plaintext $key(d) $key(n)} 10]" ====== ---- [Zarutian] 4.august 2004: maybe a little slower than the orginal implemention and it is a little more portable 20041109 [Twylite] - You could also look at [bignum in pure Tcl], and [Tcllib] now has a pure Tcl math::bignum package (I don't know if these two are related). 1-26-2005 [mdd]: How do you generate the keys? Do GPG keys work? 2006-05-10: What is [[convert 0x$hex] and [[convert $val] ? I can't find a convert procedure anywhere. 2007-02-25: [JET]: Where is the convert function? It does not seem to have ever been provided.. Even just a description of what it is supposed to do would be vrey helpful. 2007-07-09: [Sarnold]: 'convert' seems to convert an hex integer into a binary string (an array of byte). [[convert 0x20] should give a space ' '. It seems that the [binary] command should be able to provide the same functionality. 2007-07-10: [Googie]: And what about bytesize and bitsize? I've defined them as following: ====== proc bytesize {arg} { set v [math::bignum::fromstr [string tolower $arg]] return [string bytelength [math::bignum::tostr $v]] } proc bitsize {arg} { set v [expr {[bytesize $arg]*8}] return $v } ====== but it doesn't work correctly :/ What should their bodies be like? ---- 2007-07-11 [CMcC] The [bignum] package contains the necessary routines. ====== critcl::cproc convert {Tcl_Interp* interp Tcl_Obj* obj} ok { if (doSetMPZ(obj)) { Tcl_SetObjResult(interp, obj); return TCL_OK; } return TCL_ERROR; } ====== and ====== proc bytesize {x} { return [expr [sizeinbase $x 16] /2 ] } proc bitsize {x} { return [expr [sizeinbase $x 16] * 4] } ====== ---- 2008-01-02 [Googie] Since Tcl 8.5 supports [http://www.tcl.tk/cgi-bin/tct/tip/237] big integers I guess it's pretty easy to write pure-Tcl [RSA] extension which would fit into [Tcllib] perfectly, isn't it? 2008-09-22 [Twylite] Indeed it does; here is a expr extension for bignum modular exponentiation: ====== #** ::tcl::mathfunc::modexp b e n # Adds a modexp() function to expr. Modular exponentiation (modexp) raises # the base b to a power e modulo n. This function supports bignums. # Returns the result ((b ** e) % n) # # Use 'format %llX $bignum' to display a bignum as a hex string proc ::tcl::mathfunc::modexp {b e n} { # This is a straight-forward square-and-multiply implementation that relies # on Tcl's bignum support (based on LibTomMath) for speed. set r 1 while { 1 } { if { $e & 1 } { set r [::tcl::mathop::% [::tcl::mathop::* $r $b] $n] } set e [::tcl::mathop::>> $e 1] if { $e == 0 } break set b [::tcl::mathop::% [::tcl::mathop::** $b 2] $n] } return $r } ====== And here's how you use it: ====== set d 0x1FEFB2B8F2F18AE7B7AC4036A363FA074DA7C53B9CE4E6223243BC917A2EE0E8E0D0E20D9780EB048B9C5F8BCB963BF643ACDA5D5A1E2E2DB3C7EAF47195DC13 set e 0x3 set n 0xBF9E3055B1A9416E4E098147D457DC2BD1EE9F65AD5D64CD2D966B68DD1945770371F7E1881F8178E1A53E109272E0953660A74008684964FA23E2988F6402CB set base 0x55555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555 set expected 0x3901C53B355237DE90BE1DC8F6043A62BF5179234D164E1DAF3DBCEB0CAEF9E2435773344444E20E5B5B186542BCBF2B2C07A568F9A77EB1EFAC932272288428 set sign 0x[format %llx [tcl::mathfunc::modexp $base $e $n]] set unsign 0x[format %llx [expr { modexp( $expected, $d, $n ) }]] ====== In performance comparisons against a C program performing the same calculations using libTomCrypt's mp_exptmod this function achieved 50% - 85% of the speed of C. ---- Tcllib has a [PKI] module which includes RSA support. <> Package | Cryptography