Tk Library Source Code

Artifact 219a21d0643ddeb1d7303105368dc98b3db255e2:

Attachment "key-related-1.14rc0.tcl" to ticket [3440058fff] added by anonymous 2011-11-19 08:26:38.

---

# Original source taken from tcllib1.14RC0

proc ::pki::pkcs::parse_key {key {password ""}} {
	array set parsed_key [::pki::_parse_pem $key "-----BEGIN RSA PRIVATE KEY-----" "-----END RSA PRIVATE KEY-----" $password]

	set key_seq $parsed_key(data)

	::asn::asnGetSequence key_seq key
	::asn::asnGetBigInteger key version
	::asn::asnGetBigInteger key ret(n)
	::asn::asnGetBigInteger key ret(e)
	::asn::asnGetBigInteger key ret(d)
	::asn::asnGetBigInteger key ret(p)
	::asn::asnGetBigInteger key ret(q)
	::asn::asnGetBigInteger key ret(e1)
	::asn::asnGetBigInteger key ret(e2)
	::asn::asnGetBigInteger key ret(c)

	set ret(n) [::math::bignum::tostr $ret(n)]
	set ret(e) [::math::bignum::tostr $ret(e)]
	set ret(d) [::math::bignum::tostr $ret(d)]
	set ret(p) [::math::bignum::tostr $ret(p)]
	set ret(q) [::math::bignum::tostr $ret(q)]
	set ret(e1) [::math::bignum::tostr $ret(e1)]
	set ret(e2) [::math::bignum::tostr $ret(e2)]
	set ret(c) [::math::bignum::tostr $ret(c)]
	set ret(l) [expr {int([::pki::_bits $ret(n)] / 8) * 8}]
	set ret(type) rsa

	return [array get ret]
}

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

	set p 0
	set q 0
	while 1 {
		set plen [::pki::_bits $p]
		set qlen [::pki::_bits $q]
		if {$plen >= $componentbitlen && $qlen >= $componentbitlen} {
			break
		}

		set x [::pki::_random]
		set y [::pki::_random]

		set xlen [expr {[::pki::_bits $x] / 2}]
		set ylen [expr {[::pki::_bits $y] / 2}]

		set xmask [expr {(1 << $xlen) - 1}]
		set ymask [expr {(1 << $ylen) - 1}]

		set plen [::pki::_bits $p]
		set qlen [::pki::_bits $q]

		if {$plen < $componentbitlen} {
			set p [expr {($p << $xlen) + ($x & $xmask)}]
		}
		if {$qlen < $componentbitlen} {
			set q [expr {($q << $ylen) + ($y & $ymask)}]
		}
	}

	set bitmask [expr {(1 << $componentbitlen) - 1}]
	set p [expr {$p & $bitmask}]
	set q [expr {$q & $bitmask}]

	# Step 2. Verify that "p" and "q" are useful
	## Step 2.a. Verify that they are not too close
	### Where "too close" is defined as 2*n^(1/4)
	set quadroot_of_n [expr {isqrt(isqrt($p * $q))}]
	set min_distance [expr {2 * $quadroot_of_n}]
	set distance [expr {abs($p - $q)}]

	if {$distance < $min_distance} {
		#### Try again.

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

	# Step 3. Convert the numbers into prime numbers
	if {$p % 2 == 0} {
		incr p -1
	}
	while {![::pki::_isprime $p]} {
		incr p -2
	}

	if {$q % 2 == 0} {
		incr q -1
	}
	while {![::pki::_isprime $q]} {
		incr q -2
	}

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

proc ::pki::x509::privkey2pem {k {pass ""}} {
	array set key $k

	set begin [list]
	lappend begin "-----BEGIN RSA PRIVATE KEY-----"

	set privkey [::asn::asnSequence \
		[::asn::asnBigInteger [::math::bignum::fromstr 0]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(n)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(e)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(d)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(p)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(q)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(e1)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(e2)]] \
		[::asn::asnBigInteger [::math::bignum::fromstr $key(c)]] \
	]

	if {$pass != ""} {
		package require des

		set iv ""
		while {[string length $iv] < 16} {
		  append iv [string index 01234567890ABCDEF [expr int(rand() * 16)]]
		}

		lappend begin "Proc-Type: 4,ENCRYPTED"
		lappend begin "DEK-Info: DES-EDE3-CBC,$iv"
		lappend begin {}

		set iv [binary format H* $iv]
		set password_key [::pki::_getopensslkey $pass $iv 24]

		set privkey [DES::des -dir encrypt -mode cbc -iv $iv -key $password_key $privkey]
	}

	set r [::pki::_encode_pem $privkey [join $begin \n] "-----END RSA PRIVATE KEY-----"]
	return $r
}