Tk Library Source Code

Artifact 5b328b32e17051b8e0ed9e2d71c1b656fe331bbf:

Attachment "rsa_generate.tcl" to ticket [3440115fff] added by anonymous 2011-11-21 14:49:08.

---

proc ::pki::get_prime {bits} {
	set d 1
	for {set n 1} {[string length $d] < $bits} {incr n} {
		append d [expr int(rand() * 2)]
	}
	set d [expr 0b$d]
	set d [expr $d % 2?$d:$d - 1]
	while {![::pki::_isprime $d]} {
		incr d 2
	}
	return $d
}


proc ::pki::rsa::generate {bitlength {exponent 0x10001}} {
	set e $exponent

	# Step 1. Pick 2 numbers that when multiplied together will give a number with the appropriate length
	set componentbitlen [expr {$bitlength / 2}]

	if {$bitlength % 2} {
		return -code error "bitlength must be an even number"
	}

	# Step 2. Convert the numbers into prime numbers
	# Step 3. Compute N by multiplying P and Q
	while {1} {
		set p [::pki::get_prime $componentbitlen]
		set q [::pki::get_prime $componentbitlen]

		set n [expr $q * $p]
		set quadroot_of_n [expr {isqrt(isqrt($n))}]
		set min_distance [expr {2 * $quadroot_of_n}]
		set distance [expr {abs($n)}]

		if {$distance < $min_distance} {
			#### Try again.
		} elseif {[::pki::_bits $n] != $bitlength} {
			#### Try again.
		} else {
			break
		}
	}

	# Step 4. Compute N by multiplying P and Q
	set n [expr {$p * $q}]
	set retkey(n) $n

	set retkey(p) $p
	set retkey(q) $q


	# Step 5. Compute D ...
	## Step 5.a. Generate D
	set d [::pki::rsa::_generate_private $p $q $e $bitlength]
	set retkey(d) $d

	## Step 5.b. Verify D is large enough
	### Verify that D is greater than (1/3)*n^(1/4) 
	set quadroot_of_n [expr {isqrt(isqrt($n))}]
	set min_d [expr {$quadroot_of_n / 3}]
	if {$d < $min_d} {
		#### Try again.

		return [::pki::rsa::generate $bitlength $exponent]
	}

	# Step 6. Compute Exponents 1 and 2 ...
	set retkey(e1) [expr $retkey(d) % ($p-1)]
	set retkey(e2) [expr $retkey(d) % ($q-1)]

	# Step 7. Compute Coefficient ...
	set d 1
	set r $q
	for {set c 0} {$c < $p} {incr c} {
		set d [expr (($p / $r + 1) * $d) % $p]
		set r [expr ($d * $q) % $p]
		if {$r == 1} {
			set retkey(c) $d
			break
		}
	}

	# Step 8. Encode key information
	set retkey(type) rsa
	set retkey(e) $e
	set retkey(l) $bitlength

	return [array get retkey]
}