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 [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=4Here 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 $ptSSCH - 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]
}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 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.
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)