## Version 36 of RSA in tcl

Updated 2013-02-21 06:53:46 by pooryorick

CMcC 2004-06-08: 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 [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]
}```

Googie 2008-01-02: Since Tcl 8.5 supports big integers I guess it's pretty easy to write pure-Tcl RSA extension which would fit into Tcllib perfectly, isn't it?

Twylite 2008-09-22: 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 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.

DKF: A somewhat faster version (about 20% faster in my simple tests with data of the sorts of sizes seen in RSA) is this:

```proc tcl::mathfunc::modexp {a b n} {
for {set c 1} {\$b} {set a [expr {\$a*\$a%\$n}]} {
if {\$b & 1} {
set c [expr {\$c*\$a%\$n}]
}
set b [expr {\$b >> 1}]
}
return \$c
}```

The difference in speed seems to be mainly due to avoiding the use of the ** operator.

Key generation will require generation of prime numbers. In addition, the primeCheckLucas implements a Lucas prime check as per fips186-3 (rwm)

 Category Package Category Cryptography