Version 32 of RSA in tcl

Updated 2011-12-23 17:25:57 by dkf

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 [L1 ] 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.


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.