## Version 26 of RSA in tcl

Updated 2007-07-10 23:54:03 by colin

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
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
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
}

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
}

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]
}```