# crypto.tcl --
#
#       This file is a part of the Off-the-Record messaging protocol
#       implementation. It contains the OTR cryptography procedures.
#
# Copyright (c) 2014 Sergei Golovan <sgolovan@nes.ru>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAMER OF ALL WARRANTIES.
#
# $Id$

package require Tcl 8.5
package require sha1
package require sha256
package require aes
package require otr::data

package provide otr::crypto 0.1

##############################################################################

namespace eval ::otr::crypto {
    # Useful constants

    set Prime \
        0x[join {FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1
                 29024E08 8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD
                 EF9519B3 CD3A431B 302B0A6D F25F1437 4FE1356D 6D51C245
                 E485B576 625E7EC6 F44C42E9 A637ED6B 0BFF5CB6 F406B7ED
                 EE386BFB 5A899FA5 AE9F2411 7C4B1FE6 49286651 ECE45B3D
                 C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8 FD24CF5F
                 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
                 670C354E 4ABC9804 F1746C08 CA237327 FFFFFFFF FFFFFFFF} ""]
    set G 2

    if {![file readable /dev/urandom]} {
        package require Memchan
        # Random channel from Memchan uses the ISAAC algorithm which is
        # supposedly cryptographically secure
        set randomfd [::random]
    }
}

##############################################################################
#
#       Diffie-Hellman key exchange auxiliary procedures

# ::otr::crypto::DHGx --
#
#       Return the DIffie-Hellman public key.
#
# Arguments:
#       x           Private key.
#
# Result:
#       D-H public key (G**x mod P).
#
# Side effects:
#       Modulus and generator are taken from global variables.

proc ::otr::crypto::DHGx {x} {
    variable Prime
    variable G

    Power $Prime $G $x
}

# ::otr::crypto::DHCheck --
#
#       Check if the Diffie-Hellman public key is correct.
#
# Arguments:
#       gy          Public key.
#
# Result:
#       1 if gy is correct (1 < gy < P-1).
#
# Side effects:
#       Modulus is taken from a global variable.

proc ::otr::crypto::DHCheck {gy} {
    variable Prime

    expr {$gy > 1 && $gy < $Prime-1}
}

# ::otr::crypto::DHSecret --
#
#       Return the common Diffie-Hellman secret.
#
# Arguments:
#       gy          Public key.
#       x           Private key.
#
# Result:
#       The D-H secret (gy**x mod P).
#
# Side effects:
#       Modulus is taken from a global variable.

proc ::otr::crypto::DHSecret {gy x} {
    variable Prime

    Power $Prime $gy $x
}

# ::otr::crypto::AKEKeys --
#
#       Return the set of AKE keys.
#
# Arguments:
#       gy          Public key.
#       x           Private key.
#
# Result:
#       List of SSID and set of keys which are used in AKE.
#
# Side effects:
#       Modulus is taken from a global variable.

proc ::otr::crypto::AKEKeys {gy x} {
    set s [DHSecret $gy $x]
    set secbytes [::otr::data::encode MPI $s]
    set ssid [string range [::sha2::sha256 -bin \x00$secbytes] 0 7]
    set ccp [::sha2::sha256 -bin \x01$secbytes]
    set c [string range $ccp 0 15]
    set cp [string range $ccp 16 31]
    set m1 [::sha2::sha256 -bin \x02$secbytes]
    set m2 [::sha2::sha256 -bin \x03$secbytes]
    set m1p [::sha2::sha256 -bin \x04$secbytes]
    set m2p [::sha2::sha256 -bin \x05$secbytes]
    set extrakey [::sha2::sha256 -bin \xff$secbytes]
    list $ssid $c $cp $m1 $m2 $m1p $m2p $extrakey
}

# ::otr::crypto::AESKeys --
#
#       Return the set of DES keys to encrypt/decrypt and hash/verify
#       data messages.
#
# Arguments:
#       gy          Public key.
#       x           Private key.
#
# Result:
#       List of keys which are used to exchange data messages.
#
# Side effects:
#       Modulus is taken from a global variable.

proc ::otr::crypto::AESKeys {gy x} {
    set s [DHSecret $gy $x]
    set secbytes [::otr::data::encode MPI $s]
    set gx [DHGx $x]

    if {$gx > $gy} {
        # We're on the high end
        set sendbyte \x01
        set recvbyte \x02
    } else {
        # We're on the low end
        set sendbyte \x02
        set recvbyte \x01
    }
    set skey [string range [::sha1::sha1 -bin $sendbyte$secbytes] 0 15]
    set rkey [string range [::sha1::sha1 -bin $recvbyte$secbytes] 0 15]
    set smac [::sha1::sha1 -bin $skey]
    set rmac [::sha1::sha1 -bin $rkey]
    list $skey $smac $rkey $rmac
}

##############################################################################
#
#       AES128-CTR

# ::otr::crypto::aes --
#
#       Encrypt or decrypt (these operations are the same) binary data using
#       AES128-CTR method.
#
# Arguments:
#       data        Binary data to encrypt/decrypt.
#       key         128-bit binary key.
#       ctrtop      64-bit integer top counter.
#       ctrbot      (optional, 0 by default) 64-bit integer bottom counter.
#
# Result:
#       Encrypted/decrypted binary data.
#
# Side effects:
#       None.

proc ::otr::crypto::aes {data key ctrtop {ctrbot 0}} {
        set res ""
        set ctr [expr {$ctrtop*(2**64) + $ctrbot}]

        while {[string length $data] > 0} {
            # Make binary counter
            set binctr [Int2Octets $ctr 128]
            # Encrypt $binctr using $key
            set binectr [::aes::aes -mode ecb -dir encrypt -key $key $binctr]
            # XOR the data chunk with the encrypted counter
            set chunk [string range $data 0 15]
            set len [string length $chunk]
            set binectr [string range $binectr 0 [expr {$len-1}]]
            append res [Xor $binectr $chunk]
            set data [string range $data 16 end]
            incr ctr
        }
        return $res
}

# ::otr::crypto::Xor --
#
#       Return bitwize XOR between two binary strings of equal length.
#
# Arguments:
#       data1       Binary to XOR.
#       data2       Binary to XOR.
#
# Result:
#       Bitwise XOR of the supplied binaries or error if their lengths differ.
#
# Side effects:
#       None.

proc ::otr::crypto::Xor {data1 data2} {
    set res ""
    binary scan $data1 cu* clist1
    binary scan $data2 cu* clist2
    foreach c1 $clist1 c2 $clist2 {
        append res [binary format cu [expr {$c1 ^ $c2}]]
    }
    return $res
}

##############################################################################
#
#       DSA signing and verifying

# ::otr::crypto::DSAFingerprint --
#
#       Return the DSA public key fingerprint.
#
# Arguments:
#       key         DSA public key {p q g y}.
#
# Result:
#       The binary SHA-1 hash of the binary representation of the key.
#
# Side effects:
#       None.

proc ::otr::crypto::DSAFingerprint {key} {
    set bytes [::otr::data::encode PUBKEY $key]
    return [::sha1::sha1 -bin [string range $bytes 2 end]]
}

# ::otr::crypto::sign --
#
#       Sign binary data using the DSA algorithm.
#
# Arguments:
#       data            Binary data to sign.
#       key             DSA private key (list {p q g y x}).
#       -hash proc      (optional, default is no hash) Hash function
#                       (::sha1::sha1 or ::sha2::sha256 works) to apply to the
#                       signed data.
#       -random num     (optional, useful for testing only) Random number to
#                       add to the signature.
#
# Result:
#       The DSA signature (list {r s}).
#
# Side effects:
#       The side effects of ::otr::crypto::random in case if there's no
#       -random or -hmac options.

proc ::otr::crypto::sign {data key args} {
    lassign $key p q g y x

    set random 0
    set h1 $data
    set hmac ""
    foreach {opt val} $args {
        switch -- $opt {
            -random { set random $val }
            -hash { set h1 [$val -bin $data] }
            -hmac { set hmac $val }
        }
    }

    set qlen [BitLength $q]
    set h [Bits2Int $h1]

    set r 0
    set s 0
    set k 0
    while {$r == 0 || $s == 0} {
        if {$random == 0} {
            while {$k == 0} {
                set k [expr {[random [expr {$qlen+64}]] % ($q-1) + 1}]
            }
        } else {
            set k $random ; # For testing purposes only
        }

        set r [expr {[Power $p $g $k] % $q}]
        set s [Mult $q [Inverse $q $k] [expr {$h + $x*$r}]]
    }
    list $r $s
}

# ::otr::crypto::verify --
#
#       Verify binary data DSA signature.
#
# Arguments:
#       data            Binary data.
#       sig             DSA signature to verify.
#       key             DSA public key (list {p q g y}).
#       -hash proc      (optional, default is no hash) Hash function
#                       (::sha1::sha1 or ::sha2::sha256 works) to apply to the
#                       signed data.
#
# Result:
#       1 if the signature is correct, 0 otherwise.
#
# Side effects:
#       None.

proc ::otr::crypto::verify {data sig key args} {
    lassign $sig r s
    lassign $key p q g y

    if {$r <= 0 || $r >= $q || $s <= 0 || $s >= $q} {
        return 0
    }

    set data1 $data
    foreach {opt val} $args {
        switch -- $opt {
            -hash { set data1 [$val -bin $data] }
        }
    }

    set hash [Bits2Int $data1]
    set w [Inverse $q $s]
    set u1 [Mult $q $hash $w]
    set u2 [Mult $q $r $w]
    set v0 [Mult $p [Power $p $g $u1] [Power $p $y $u2]]
    set v [expr {$v0 % $q}]
    expr {$v == $r}
}

# ::otr::crypto::BitLength --
#
#       Return the bit length of the given number x (minimum l such that
#       2**l is greater than x).
#
# Arguments:
#       x           Non-negative nteger.
#
# Result:
#       Bit length of x.
#
# Side effects:
#       None.

proc ::otr::crypto::BitLength {x} {
    set len 0
    while {$x >= 2**$len} {
        incr len
    }
    set len
}

# ::otr::crypto::Bits2Int --
#
#       Convert binary into an unsigned integer treating binary as a big
#       endian byte array.
#
# Arguments:
#       data        Binary to convert.
#       len         Number of leftmost bits to convert. If 0 then all bits
#                   are to be converted.
#
# Result:
#       Arbitrary length integer which corresponds to the first $len bits of
#       the given binary. Bits are taken in big endian way.
#
# Side effects:
#       None.

proc ::otr::crypto::Bits2Int {data {len 0}} {
    binary scan $data cu* clist
    set int [lindex $clist 0]
    set olen [expr {($len - 1) / 8}]
    foreach c [lrange $clist 1 end] {
        if {$olen == 0} break
        set int [expr {$int*256 + $c}]
        incr olen -1
    }
    if {$len > 0} {
        set int [expr {$int & ((2**($len+1)) - 1)}]
    }
    set int
}

# ::otr::crypto::Int2Octests --
#
#       Convert integer to the sequence of octets of the given length (left
#       zero padded).
#
# Arguments:
#       int         Non-negative integer.
#       len         (optional, by default the hole x is converted into minimum
#                   length binary) How many bits to convert (in fact the
#                   number of bits would be 8*ceil(len/8).
#
# Result:
#       Binary which represents the given integer.
#
# Side effects:
#       None.

proc ::otr::crypto::Int2Octets {int {len 0}} {
    if {$int == 0} {
        return \00
    }
    set bin ""
    set olen [expr {($len - 1) / 8}]
    while {($len == 0 && $int > 0) || $olen >= 0} {
        set bin [binary format cu [expr {$int % 256}]]$bin
        set int [expr {$int / 256}]
        incr olen -1
    }
    set bin

}

# ::otr::crypto::Bits2Octets --
#
#       Convert binary into another binary as described in RFC-6979 section
#       2.3.4.
#
# Arguments:
#       data        Binary to convert.
#       q           Modulus.
#
# Result:
#       Binary.
#
# Side effects:
#       None.

proc ::otr::crypto::Bits2Octets {data q} {
    set len [BitLength $q]
    set z1 [Bits2Int $data $len]
    set z2 [expr {$z1 % $q}]
    Int2Octets $z2 $len
}

##############################################################################
#
#       Generating random number

# ::otr::crypto::random --
#
#       Return random number which is not shorter than the required number
#       of bits.
#
# Arguments:
#       bits        Number of random bits to generate.
#
# Result:
#       The generated random number.
#
# Side effects:
#       Some entropy from /dev/urandom is used.

proc ::otr::crypto::random {bits} {
    set bytes [expr {($bits + 7) / 8}]
    set rnd ""
    if {[file readable /dev/urandom]} {
        set fd [open /dev/urandom r]
    } else {
        variable randomfd
        set fd $randomfd
    }
    catch {
        fconfigure $fd -translation binary -buffering none
        set rnd [read $fd $bytes]
        close $f
    }
    Bits2Int $rnd $bits
}

##############################################################################
#
#       Generating DSA private key (see FIPS 186-4)

# ::otr::crypto::getFirstSeed --
#
#       Return the first seed for DSA parameters (p, q) generator (see
#       appendix A.1.2.1.1 in FIPS 186-4).
#
# Arguments:
#       N           Length of q in bits.
#       seedlen     Length of the returned first seed (seedlen >= N)
#
# Result:
#       Tuple {status, seedlen} where status is 0 in case of failure (in this
#       case the seedlen is undefined) and 1 in case of success.
#
# Side effects:
#       The random number of seeldlen bits is used.

proc ::otr::crypto::getFirstSeed {N seedlen} {
    switch -- $N {
        160 - 224 - 256 {}
        default { return {0} }
    }

    if {$seedlen < $N} {
        return {0}
    }

    set firstseed [random $seedlen]
    if {$firstseed < 2**($N-1)} {
        incr firstseed [expr {2**($N-1)}]
    }
    return [list 1 $firstseed]
}

# ::otr::crypto::genPrimes --
#
#       Return the DSA parameters (p, q) (see appendix A.1.2.1.2 in FIPS
#       186-4).
#
# Arguments:
#       L               Length of p in bits.
#       N               Length of q in bits.
#       firstseed       The first seed to be used (the length of firstseed is
#                       to be not less then N).
#
# Result:
#       Tuple {status, p, q, pseed, qseed, pgen_counter, qgen_counter} where
#       status is 0 in case of failure (in this case all the other values
#       are unassigned) or 1 in case of success. p and q are the generated
#       DSA primes, pseed and qseed are the new seed values, pgen_counter and
#       qgen_counter show how many iterations were used.
#
# Side effects:
#       None.

proc ::otr::crypto::genPrimes {L N firstseed} {
    switch -- $L/$N {
        1024/160 - 2048/224 - 2048/256 - 3072/256 {}
        default {
            return {0}
        }
    }

    lassign [randomPrime $N $firstseed] \
            qstatus q qseed qgen_counter
    if {!$qstatus} {
        return {0}
    }

    lassign [randomPrime [expr {[Ceil $L 2]+1}] $qseed] \
            pstatus p0 pseed pgen_counter
    if {!$pstatus} {
        return {0}
    }

    set outlen 256
    set iterations [expr {[Ceil $L $outlen]-1}]
    set old_counter $pgen_counter
    set x 0
    set mult 1
    for {set i 0} {$i <= $iterations} {incr i} {
        incr x [expr {[Bits2Int [::sha2::sha256 \
                                        -bin [Int2Octets $pseed]]] * $mult}]
        incr pseed
        set mult [expr {$mult * 2**$outlen}]
    }
    set x [expr {2**($L-1) + ($x % (2**($L-1)))}]
    set t [Ceil $x [expr {2*$q*$p0}]]

    while {$pgen_counter <= 4*$L+$old_counter} {
        lassign [GenPrimesIteration $L $t $q $p0 $pseed $pgen_counter] \
                status t p pseed pgen_counter
        if {$status} {
            return [list 1 $p $q $pseed $qseed $pgen_counter $qgen_counter]
        }
    }
    return {0}
}

# ::otr::crypto::genGenerator --
#
#       Return the DSA generator g (see appendix A.2.1 of FIPS 186-4).
#
# Arguments:
#       p               DSA prime p.
#       q               DSA prime q.
#
# Result:
#       The generator g of the DSA key.
#
# Side effects:
#       A random number of bitlength at least L is used.

proc ::otr::crypto::genGenerator {p q} {
    set e [expr {($p-1)/$q}]
    set g 1
    set l [BitLength $p]
    while {$g == 1} {
        set h [expr {2+([random $l] % ($p-3))}]
        set g [Power $p $h $e]
    }
    set g
}

# ::otr::crypto::genKeyPair --
#
#       Return the DSA private and public key pair for given parameters
#       p, q and g (see appendix B.1.1 of FIPS 186-4).
#
# Arguments:
#       p               DSA prime p.
#       q               DSA prime q.
#       g               DSA generator g.
#
# Result:
#       Tuple {status, x, y} where status is 0 in case of failure (in this
#       case the x and y are unassigned), or 1 in case of success (in this
#       case x is a private key, y is a g^x mod p - public key.
#
# Side effects:
#       A random number of bitlength N+64 is used.

proc ::otr::crypto::genKeyPair {p q g} {
    set L [BitLength $p]
    set N [BitLength $q]

    switch -- $L/$N {
        1024/160 - 2048/224 - 2048/256 - 3072/256 {}
        default {
            return {0}
        }
    }

    set c [random [expr {$N+64}]]
    set x [expr {$c % ($q-1) + 1}]
    set y [Power $p $g $x]
    return [list 1 $x $y]
}

# ::otr::crypto::randomPrime --
#
#       Generate a prime number of a given bitlength using the Shawe-Taylor
#       algorithm (see Appendix C.6 from FIPS 186-4).
#
# Arguments:
#       length      Bitlength of a number to generate.
#       input_seed  The seed to be used for the generation.
#
# Result:
#       Tuple {status, prime, prime_seed, prime_gen_counter} where status is
#       1 if the generation is successful and 0 otherwise. If status is 0 then
#       the other values aren't assigned. If status is 1 then prime is the
#       generated prime number, prime_seed is a new seed value,
#       prime_gen_counter shows hom many iterations were made.
#
# Side effects:
#       None.

proc ::otr::crypto::randomPrime {length input_seed} {
    if {$length < 2} {
        return {0}
    }
    if {$length < 33} {
        set prime_seed $input_seed
        set prime_gen_counter 0
        while {$prime_gen_counter <= 4*$length} {
            set c [Bits2Int [Xor [::sha2::sha256 -bin [Int2Octets $prime_seed]] \
                                 [::sha2::sha256 -bin [Int2Octets [expr {$prime_seed+1}]]]]]
            set c [expr {2**($length-1) + ($c % (2**($length-1)))}]
            set c [expr {($c % 2 == 0)? $c+1 : $c}]
            incr prime_gen_counter
            incr prime_seed 2
            if {[TestPrime $c]} {
                return [list 1 $c $prime_seed $prime_gen_counter]
            }
        }
        return {0}
    } else {
        lassign [randomPrime [Ceil $length 2] $input_seed] \
                status c0 prime_seed prime_gen_counter
        if {!$status} {
            return {0}
        }
        set outlen 256
        set iterations [expr {[Ceil $length $outlen]-1}]
        set old_counter $prime_gen_counter
        set x 0
        set mult 1
        for {set i 0} {$i <= $iterations} {incr i} {
            incr x [expr {[Bits2Int [::sha2::sha256 \
                                    -bin [Int2Octets $prime_seed]]] * $mult}]
            incr prime_seed
            set mult [expr {$mult * 2**$outlen}]
        }
        set x [expr {2**($length-1) + ($x % (2**($length-1)))}]
        set t [Ceil $x [expr {2*$c0}]]

        while {$prime_gen_counter < 4*$length+$old_counter} {
            lassign [GenPrimesIteration \
                            $length $t 1 $c0 $prime_seed $prime_gen_counter] \
                    status t c prime_seed prime_gen_counter
            if {$status} {
                return [list 1 $c $prime_seed $prime_gen_counter]
            }
        }
        return {0}
    }
}

# ::otr::crypto::GenPrimesIteration --
#
#       Private procedure which implements a common iteration part for
#       [randomPrime] (steps 23-34 in appendix C.6) and [genPrimes]
#       (steps 11-22 in appendix A.1.2.1.2) routines (see FIPS 186-4).
#
# Arguments:
#       L               Length of the generated prime p in bits.
#       t               Candidate for a (p-1) factor.
#       q               Number which p-1 is to be divisible by.
#       p0              Prime number which is to be a factor of (p-1).
#       pseed           Seed.
#       pgen_counter    Value of the global iteration counter.
#
# Result:
#       Tuple {status, t, p, pseed, pgen_counter} where status equals 0
#       if iterations are to be continued (in this case p is not prime
#       and has to be ignored), or 1 in case if p is prime. t is the next
#       auxiliary factor of p-1, pseed is nes seed, pgen_counter is the
#       next counter value.
#
# Side effects:
#       None.

proc ::otr::crypto::GenPrimesIteration {L t q p0 pseed pgen_counter} {
    if {2*$t*$q*$p0+1 > 2**$L} {
        set t [Ceil [expr {2**($L-1)}] [expr {2*$q*$p0}]]
    }
    set p [expr {2*$t*$q*$p0+1}]
    incr pgen_counter

    set outlen 256
    set iterations [expr {[Ceil $L $outlen]-1}]
    set a 0
    set mult 1
    for {set i 0} {$i <= $iterations} {incr i} {
        incr a [expr {[Bits2Int [::sha2::sha256 -bin [Int2Octets $pseed]]] * $mult}]
        incr pseed
        set mult [expr {$mult * 2**$outlen}]
    }
    set a [expr {2+($a % ($p-3))}]
    set z [Power $p $a [expr {2*$t*$q}]]

    lassign [EGCD $p [expr {$z-1}]] xx yy
    set pow [Power $p $z $p0]
    if {$xx*$p + $yy*($z-1) == 1 && $pow == 1} {
        return [list 1 $t $p $pseed $pgen_counter]
    }
    incr t
    return [list 0 $t $p $pseed $pgen_counter]
}

# ::otr::crypto::TestPrime --
#       Private procedure which tests the given positive integer number for
#       primality. It does that by division on 2 and all odd numbers up to
#       the square root of the tested number trials, so it's supposed to
#       work only with sufficiently short numbers (32 bit).
#
# Arguments:
#       n           Positive integer to test.
#
# Result:
#       1 if it is a prime number, 0 otherwise.
#
# Side effects:
#       None.

proc ::otr::crypto::TestPrime {n} {
    if {$n < 2} {
        return 0
    }
    if {$n > 2 && $n % 2 == 0} {
        return 0
    }
    for {set k 3} {$k*$k <= $n} {incr k 2} {
        if {$n % $k == 0} {
            return 0
        }
    }
    return 1
}

# ::otr::crypto::Ceil --
#
#       Private procedure which computes ceiling of the ratio of two positive
#       integers.
#
# Arguments:
#       k           Positive integer umerator.
#       n           Positive integer denominator.
#
# Result:
#       ceil(k/n).
#
# Side effects:
#       None.

proc ::otr::crypto::Ceil {k n} {
    expr {($k+$n-1)/$n}
}

##############################################################################
#
#       Useful procedures implementing arithmetics modulo some prime number.

# ::otr::crypto::Mult --
#
#       Multiplication modulo some positive integer.
#
# Arguments:
#       prime       Modulus (usually it's a prime number).
#       x           The first multiplier.
#       y           The second multiplier.
#
# Result:
#       x*y mod p.
#
# Side effects:
#       None.

proc ::otr::crypto::Mult {prime x y} {
    expr {($x * $y) % $prime}
}

# ::otr::crypto::Inverse --
#
#       Inverse modulo some prime number. It's found using the Euclid GCD
#       algorithm.
#
# Arguments:
#       prime       Modulus (must be a prime number, or result will not be
#                   the inversion.
#       x           Number to inverse.
#
# Result:
#       Number y such that x*y mod p = 1.
#
# Side effects:
#       None.

proc ::otr::crypto::Inverse {prime x} {
    lassign [EGCD $prime $x] x1 y1
    expr {$y1 % $prime}
}

# ::otr::crypto::Power --
#
#       Power modulo some integer. It's implemented using the exponentiation
#       by squaring algorithm.
#
# Arguments:
#       prime       Modulus (usually it's a prime number).
#       x           Exponentiation base.
#       n           Exponentiation index.
#
# Result:
#       x**n mod p.
#
# Side effects:
#       None.

proc ::otr::crypto::Power {prime x n} {
    set y 1
    while {$n > 0} {
        if {$n % 2 == 0} {
            set n [expr {$n / 2}]
            set x [Mult $prime $x $x]
        } else {
            incr n -1
            set y [Mult $prime $y $x]
        }
    }
    return $y
}

# ::otr::crypto::EGCD --
#
#       Perform the Euclid algorithm to find the Greatest Common Divisor.
#
# Arguments:
#       a           Positive integer.
#       b           Positive integer.
#
# Result:
#       Tuple {x y} where x*a+y*b = GCD(a,b).
#
# Side effects:
#       None.

proc ::otr::crypto::EGCD {a b} {
    set r [expr {$a % $b}]
    if {$r == 0} {
        return {0 1}
    } else {
        lassign [EGCD $b $r] x y
        return [list $y [expr {$x - $y * ($a / $b)}]]
    }
}

# vim:ts=8:sw=4:sts=4:et
