# otr.tcl --
#
#       This file is a part of the Off-the-Record messaging protocol
#       implementation. It contains the OTR instance implementation. Only
#       versions 2 and 3 are implemented, any support for version 1 is
#       omitted.
#
# 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 otr::data
package require otr::key
package require otr::crypto
package require otr::auth
package require otr::smp
package require otr::message

package provide otr 0.1

namespace eval ::otr {
#   AuthState {
#       AUTHSTATE_NONE
#       AUTHSTATE_AWAITING_DHKEY
#       AUTHSTATE_AWAITING_REVEALSIG
#       AUTHSTATE_AWAITING_SIG
#   }
#   MsgState {
#       MSGSTATE_PLAINTEXT
#       MSGSTATE_ENCRYPTED
#       MSGSTATE_FINISHED
#   }
#   SMPState {
#       SMPSTATE_EXPECT1
#       SMPSTATE_EXPECT2
#       SMPSTATE_EXPECT3
#       SMPSTATE_EXPECT4
#   }
#   Policy {
#       ALLOW_V1
#       ALLOW_V2
#       ALLOW_V3
#       REQUIRE_ENCRYPTION
#       SEND_WHITESPACE_TAG
#       WHITESPACE_START_AKE
#       ERROR_START_AKE
#   }

    variable debug 0
}

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

# ::otr::new --
#
#       Create new OTR instance.
#
# Arguments:
#       privkey                 Private key (tuple {p q g y x}).
#       -policy policy          List of policy flags.
#       -heartbeat time         (minutes) Interval before which a heartbeat
#                               message will not be sent.
#       -maxsize size           (ASCII chars) Max message size to send (not
#                               implemented yet (TODO)).
#       -sendcommand cmd        Callback which is called to send a message
#                               to user's peer.
#       -authstatecommand cmd   Callback which is called on every authstate
#                               change.
#       -msgstatecommand cmd    Callback which is called on every msgstate
#                               change.
#       -smpstatecommand cmd    Callback which is called on every smpstate
#                               change.
#       -smpprogresscommand cmd Callback which is called to track progress of
#                               SMP authentication.
#       -infocommand cmd        Callback which is called to show some info
#                               message to user.
#       -errorcommand cmd       Callback which is called to show some error
#                               message to user.
#
# Result:
#       An OTR token.
#
# Side effects:
#       The state variable is created.

proc ::otr::new {privkey args} {
    variable id

    if {![info exists id]} {
        set id 0
    }

    set policy    {}
    set heartbeat 0
    set maxsize   0
    set authstatecommands   {}
    set msgstatecommands    {}
    set smpstatecommands    {}
    set smpprogresscommands {}
    set infocommands        {}
    set errorcommands       {}
    foreach {key val} $args {
        switch -- $key {
            -policy             { set policy    $val }
            -heartbeat          { set heartbeat $val }
            -maxsize            { set maxsize   $val }
            -sendcommand        { set sendcommands        [list $val] }
            -authstatecommand   { set authstatecommands   [list $val] }
            -msgstatecommand    { set msgstatecommands    [list $val] }
            -smpstatecommand    { set smpstatecommands    [list $val] }
            -smpprogresscommand { set smpprogresscommands [list $val] }
            -infocommand        { set infocommands        [list $val] }
            -errorcommand       { set errorcommands       [list $val] }
            default {
                return -code error "Invalid option '$key'"
            }
        }
    }

    if {"ALLOW_V1" in $policy} {
        return -code error "OTR version 1 is not supported"
    }

    if {![info exists sendcommands]} {
        return -code error "Option -sendcommand is mandatory"
    }

    set token [namespace current]::[incr id]
    variable $token
    upvar 0 $token state

    array unset state

    set state(privatekey) $privkey
    while {[set state(sinstance) [::otr::crypto::random 32]] < 0x100} {}

    set state(policy)    $policy
    set state(heartbeat) $heartbeat
    set state(maxsize)   $maxsize

    set state(sendcommands)        $sendcommands
    set state(authstatecommands)   $authstatecommands
    set state(msgstatecommands)    $msgstatecommands
    set state(smpstatecommands)    $smpstatecommands
    set state(smpprogresscommands) $smpprogresscommands
    set state(infocommands)        $infocommands
    set state(errorcommands)       $errorcommands

    set state(storedmessages)    {}
    set state(receivedplaintext) 0
    set state(lastmessage)       [clock seconds]

    # Init vars for fragmented message

    set state(k) 0
    set state(n) 0
    set state(f) ""

    # Generate DH private keys (key management 1)

    InitDHKeys $token

    # Track state changes

    trace add variable ${token}(authstate) write \
                [namespace code [list TrackAuthState $token]]
    trace add variable ${token}(msgstate) write \
                [namespace code [list TrackMsgState $token]]
    trace add variable ${token}(smpstate) write \
                [namespace code [list TrackSMPState $token]]
    trace add variable ${token}(smpprogress) write \
                [namespace code [list TrackSMPProgress $token]]

    set state(storedauthstate) ""
    set state(storedmsgstate)  ""
    set state(storedsmpstate)  ""
    set state(authstate)   AUTHSTATE_NONE
    set state(msgstate)    MSGSTATE_PLAINTEXT
    set state(smpstate)    SMPSTATE_EXPECT1
    set state(smpprogress) SMP_NONE

    set token
}

# ::otr::configure --
#
#       Get or set OTR token option.
#
# Arguments:
#       token               OTR token.
#       key                 Option to query or set (see ::otr::new for the
#                           comprehensive list).
#       args                If empty, then the current option value is
#                           returned, if not then the first item is used to
#                           set the specified option.
#
# Result:
#       The current value of the specified option if args are empty.
#       Otherwise, an empty string.
#
# Side effects:
#       Error is raised if invalid option is queried or set.

proc ::otr::configure {token key args} {
    variable $token
    upvar 0 $token state

    if {![info exists state(privatekey)]} return

    if {[llength $args] == 0} {
        switch -- $key {
            -policy    { return $state(policy) }
            -heartbeat { return $state(heartbeat) }
            -maxsize   { return $state(maxsize) }
            -sendcommand        { return [lindex $state(sendcommands) 0] }
            -authstatecommand   { return [lindex $state(authstatecommands) 0] }
            -msgstatecommand    { return [lindex $state(msgstatecommands) 0] }
            -smpstatecommand    { return [lindex $state(smpstatecommands) 0] }
            -smpprogresscommand { return [lindex $state(smpprogresscommands) 0] }
            -infocommand        { return [lindex $state(infocommands) 0] }
            -errorcommand       { return [lindex $state(errorcommands) 0] }
            default {
                return -code error "Invalid option '$key'"
            }
        }
    }

    set val [lindex $args 0]

    switch -- $key {
        -policy {
            if {"ALLOW_V1" in $val} {
                return -code error "OTR version 1 is not supported"
            }
        
            set state(policy) $val
        }
        -heartbeat { set state(heartbeat) $val }
        -maxsize   { set state(maxsize)   $val }
        -sendcommand        { set state(sendcommands)        [list $val] }
        -authstatecommand   { set state(authstatecommands)   [list $val] }
        -msgstatecommand    { set state(msgstatecommands)    [list $val] }
        -smpstatecommand    { set state(smpstatecommands)    [list $val] }
        -smpprogresscommand { set state(smpprogresscommands) [list $val] }
        -infocommand        { set state(infocommands)        [list $val] }
        -errorcommand       { set state(errorcommands)       [list $val] }
        default {
            return -code error "Invalid option '$key'"
        }
    }
    return
}

# ::otr::free --
#
#       Destroys an OTR token and clears its state array.
#
# Arguments:
#       token           OTR token.
#
# Result:
#       Empty string.
#
# Side effects:
#       The token associated array is unset.

proc ::otr::free {token} {
    variable $token
    upvar 0 $token state

    unset -nocomplain state
}

# ::otr::fingerprint --
#
#       Return the nicely formatted DSA public key fingerprint.
#
# Arguments:
#       key         DSA public key {p q g y}.
#       me          (optional, 0 is default) If 1, then our fingerprint
#                   is returned, if 0, then the peer's one.
#
# Result:
#       The hex SHA-1 hash of the binary representation of the key split
#       into five chunks.
#
# Side effects:
#       None.

proc ::otr::fingerprint {token {me 0}} {
    variable $token
    upvar 0 $token state

    if {$me} {
        if {[info exists state(privatekey)]} {
            set key $state(privatekey)
        } else {
            return ""
        }
    } else {
        if {[info exists state(publickey)]} {
            set key $state(publickey)
        } else {
            return ""
        }
    }

    binary scan [::otr::crypto::DSAFingerprint $key] Iu* nums
    set res {}
    foreach n $nums {
        lappend res [format %X $n]
    }
    join $res
}

# ::otr::ssid --

proc ::otr::ssid {token} {
    variable $token
    upvar 0 $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            return $state(displayssid)
        }
        default {
            return ""
        }
    }
}

# ::otr::requestConversation --
#
#       Send the OTR query message to the peer.
#
# Arguments:
#       token           OTR token.
#       suffix          (optional, default is "") A short clarification
#                       message to be appended to the OTR query message.
#
# Result:
#       Empty string.
#
# Side effects:
#       The OTR query message is sent, it's formed using the stored
#       policy flags.

proc ::otr::requestConversation {token {suffix ""}} {
    variable $token
    upvar $token state

    CallBack $token send [::otr::data::queryMessage $state(policy)]$suffix
}

# ::otr::finishConversation --
#
#       Send the finishing conversation OTR message.
#
# Arguments:
#       token           OTR token.
#
# Result:
#       Empty string.
#
# Side effects:
#       The message is not sent if the current message state is 'plaintext'
#       or 'finished'. The message state is switched to 'plaintext'

proc ::otr::finishConversation {token} {
    variable $token
    upvar $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            set message [CreateEncryptedMessage $token {} "" {1 ""}]
            CallBack $token send $message
            InitDHKeys $token
        }
    }
    set state(msgstate) MSGSTATE_PLAINTEXT
    return
}

# ::otr::startSMP --
#
#       Start the SMP authentication procedure.
#
# Arguments:
#       token           OTR token.
#       secret          The secret common to the user and his peer.
#       -question qu    (optional, default to no question) Question to ask.
#
# Result:
#       Empty string.
#
# Side effects:
#       SMP message 1 or 1Q is sent to the peer if the message state is
#       'encrypted'. Also, SMP state and progress callbacks are invoked.

proc ::otr::startSMP {token secret args} {
    variable $token
    upvar $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            lassign [CreateSMP1 $token $secret {*}$args] \
                    smpstate smpprogress flags body tlvlist
            set message [CreateEncryptedMessage $token $flags $body $tlvlist]
            CallBack $token send $message
            set state(smpstate) $smpstate
            set state(smpprogress) $smpprogress
        }
        default {
            set state(smpprogress) SMP_ABORT
        }
    }
    return
}

# ::otr::replySMP --
#
#       Reply to the SMP authentication procedure.
#
# Arguments:
#       token           OTR token.
#       secret          The secret common to the user and his peer.
#
# Result:
#       Empty string.
#
# Side effects:
#       SMP message 2 is sent to the peer if the message state is 'encrypted'.
#       Also, SMP state and progress callbacks are invoked.

proc ::otr::replySMP {token secret} {
    variable $token
    upvar $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            lassign [CreateSMP2 $token $secret] \
                    smpstate smpprogress flags body tlvlist
            set message [CreateEncryptedMessage $token $flags $body $tlvlist]
            CallBack $token send $message
            set state(smpstate) $smpstate
            set state(smpprogress) $smpprogress
        }
        default {
            set state(smpprogress) SMP_ABORT
        }
    }
    return
}

# ::otr::abortSMP --
#
#       Abort the SMP authentication procedure in progress.
#
# Arguments:
#       token           OTR token.
#
# Result:
#       Empty string.
#
# Side effects:
#       SMP abort message is sent to the peer if the message state is
#       'encrypted'. Also, SMP state and progress callbacks are invoked.

proc ::otr::abortSMP {token} {
    variable $token
    upvar $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            set message [CreateEncryptedMessage $token {} "" {6 ""}]
            CallBack $token send $message
            set state(smpstate) SMPSTATE_EXPECT1
            set state(smpprogress) SMP_ABORT
        }
        default {
            set state(smpprogress) SMP_ABORT
        }
    }
    return
}

# ::otr::outgoingMessage --
#
#       Take an outgoing user message and either encrypt it and return or
#       swallow and return -code break to signal that this message is not
#       to be sent.
#
# Arguments:
#       token           OTR token.
#       message         Message to process.
#
# Result:
#       Serialized array with one possible element 'message'.
#
# Side effects:
#       Query message may be sent.

proc ::otr::outgoingMessage {token message} {
    variable $token
    upvar 0 $token state

    switch -- $state(msgstate) {
        MSGSTATE_PLAINTEXT {
            if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
                # TODO: Think about resending message after AKE
                #Store $token $message
                CallBack $token info "Message is not sent because encryption\
                                      is required. Trying to start private\
                                      conversation..."
                CallBack $token send [::otr::data::queryMessage $state(policy)]
                return {}
            } elseif {[QueryPolicy $token SEND_WHITESPACE_TAG] &&
                      ([QueryPolicy $token ALLOW_V2] ||
                       [QueryPolicy $token ALLOW_V3]) &&
                      !$state(receivedplaintext)} {
                return [list message \
                             $message[::otr::data::whitespaceTag $state(policy)]]
            } else {
                return [list message $message]
            }
        }
        MSGSTATE_ENCRYPTED {
            Store $token $message
            # Store the time of last message sent
            set state(lastmessage) [clock seconds]
            set message [CreateEncryptedMessage $token {} $message {}]
            return [list message $message]
        }
        MSGSTATE_FINISHED {
            # TODO: Think about resending message after AKE
            #Store $token $message
            CallBack $token info "Message is not sent. Either end your private\
                                  conversation, or restart it"
            return {}
        }
    }
}

# ::otr::incomingMessage --
#
#       Take an incoming message from the peer and decrypt it if appropriate.
#
# Arguments:
#       token               OTR token.
#       message             Message to process.
#
# Result:
#       Serialized array with optional 'message' item (message to show) and
#       'warn' item (warn the user about publicly readable message).
#
# Side effects:
#       Change of the OTR states, error or info messages may be shown to the
#       uesr, etc.

proc ::otr::incomingMessage {token message} {
    variable $token
    upvar 0 $token state

    if {![catch {::otr::data::binaryMessageFragment $message} data]} {
        # Binary OTR message fragment

        Debug $token 2 "OTR binary message fragment"

        return [AssembleBinaryMessage $token $data]
    } elseif {![catch {::otr::data::binaryMessage $message} data]} {
        # Binary OTR message

        Debug $token 2 "OTR binary message"

        # Delete stored message only if type==3
        return [DispatchBinaryMessage $token $data]
    } elseif {![catch {::otr::data::findErrorMessage $message} error]} {
        # OTR error message

        Debug $token 2 "OTR error message"

        # Don't delete stored message
        CallBack $token error $error
        if {[QueryPolicy $token ERROR_START_AKE] &&
            ([QueryPolicy $token ALLOW_V2] || [QueryPolicy $token ALLOW_V3])} {
            CallBack $token send [::otr::data::queryMessage $state(policy)]

            # Undocumented in the protocol, but it's pointless to keep
            # encrypting after the error message has been received
            set state(authstate) AUTHSTATE_NONE
            set state(msgstate) MSGSTATE_PLAINTEXT
        }
        return {}
    } elseif {![catch {::otr::data::findQueryMessage $message} versions] && \
                    [set version [FindVersion $token $versions]]} {
        # OTR query message of a suitable version

        Debug $token 2 "OTR query message"

        Delete $token

        lassign [NewSession $token $version] authstate msgstate message
        CallBack $token send $message
        set state(authstate) $authstate
        set state(msgstate) $msgstate
        return {}
    } else {
        # Plaintext message

        Debug $token 2 "Plaintext message"

        Delete $token
        if {![catch {::otr::data::findWhitespaceTag $message} versions]} {
            # Plaintext with the whitespace tag

            Debug $token 2 "... with the whitespace tag"

            set message [::otr::data::removeWhitespaceTag $message]

            if {[QueryPolicy $token WHITESPACE_START_AKE] && \
                    [set version [FindVersion $token $versions]]} {

                lassign [NewSession $token $version] authstate msgstate reply
                CallBack $token send $reply
                set state(authstate) $authstate
                set state(msgstate) $msgstate
            }
        }
        set ret [list message $message]
        switch -- $state(msgstate) {
            MSGSTATE_PLAINTEXT {
                set state(receivedplaintext) 1
                if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
                    lappend ret warn 1
                }
            }
            MSGSTATE_ENCRYPTED -
            MSGSTATE_FINISHED {
                lappend ret warn 1
            }
        }
        return $ret
    }
}

# ::otr::AssembleBinaryMessage --
#
#       Auxiliary proc which appends received binary message part to the
#       already assembled parts. Process the message if it is whole.
#
# Arguments:
#       token           OTR data.
#       data            Message part.
#
# Result:
#       Either empty list (show the user that the message is to be ignored),
#       or the result of [incomingMessage] if all parts are received.
#
# Side effects:
#       Internal assemble message state is updated. If it is complete then
#       the side effects of [incomingMessage].

proc ::otr::AssembleBinaryMessage {token data} {
    variable $token
    upvar 0 $token state

    # Here sinstance is a remote instance tag, rinstance is ours,
    # because the message is incoming

    lassign $data version k n message sinstance rinstance

    Debug $token 2 "$version $k $n $message"

    if {$version >= 3} {
        if {$sinstance < 0x100 ||
                ($rinstance > 0 && $rinstance != $state(sinstance))} {
            return {}
        }
        if {![info exists state(rinstance)]} {
            set state(rinstance) $sinstance
        } elseif {$sinstance != $state(rinstance)} {
            return {}
        }
    } else {
        # Fake rinstance for version 2
        set state(rinstance) 0x100
    }

    if {$k == 0 || $n == 0 || $k > $n} {
        # Do nothing
    } elseif {$k == 1} {
        set state(f) $message
        set state(k) $k
        set state(n) $n
    } elseif {$n == $state(n) && $k == $state(k)+1} {
        append state(f) $message
        incr state(k)
    } else {
        set state(f) ""
        set state(k) 0
        set state(n) 0
    }

    if {$state(n) > 0 && $state(k) == $state(n)} {
        set data $state(f)
        set state(f) ""
        set state(k) 0
        set state(n) 0
        return [incomingMessage $token $data]
    } else {
        return {}
    }
}

# ::otr::DispatchBinaryMessage --
#
#       Auxiliary proc which looks at the OTR binary message type and calls
#       appropriate handler.
#
# Arguments:
#       token           OTR token
#       data            List {version, type, binary, sinstance, rinstance}
#
# Result:
#       The result of handler for the given message type.
#
# Side effects:
#       The side effects of handler for the given message type.

proc ::otr::DispatchBinaryMessage {token data} {
    variable $token
    upvar 0 $token state

    # Here sinstance is a remote instance tag, rinstance is ours,
    # because the message is incoming

    lassign $data version type binary sinstance rinstance

    Debug $token 2 "$version $type [::otr::data::Bin2Hex $binary]"

    if {$type == 2} {
        # If this is a D-H Commit message, it specifies the protocol version
        # and the peer's instance tag

        if {$version == 3 && [QueryPolicy $token ALLOW_V3]} {
            set state(version) 3
        } elseif {$version == 2 && [QueryPolicy $token ALLOW_V2]} {
            set state(version) 2
        } else {
            Debug $token 1 "Protocol version $version is disabled"
            return {}
        }

        set state(rinstance) $sinstance
    }

    if {![info exists state(version)]} {
        switch -- $type {
            3 {
                Debug $token 1 "Var state(version) is not set"
                set error "Encrypted message can't be deciphered"
                CallBack $token info $error
                CallBack $token send [::otr::data::errorMessage $error]
                return {}
            }
            default {
                Debug $token 1 "Non-data message and state(version) is not set"
                return {}
            }
        }
    }

    if {$version != $state(version)} {
        set error "Unmatched protocol versions"
        Debug $token 1 $error
        CallBack $token info $error
        CallBack $token send [::otr::data::errorMessage $error]
        return {}
    }

    if {$version >= 3} {
        if {$sinstance < 0x100 ||
                ($rinstance > 0 && $rinstance != $state(sinstance))} {
            Debug $token 1 "sinstance: $sinstance, rinstance: $rinstance,\
                            state(sinstance): $state(sinstance)"
            return {}
        }
        if {![info exists state(rinstance)]} {
            set state(rinstance) $sinstance
        } elseif {$sinstance != $state(rinstance)} {
            Debug $token 1 "sinstance: $sinstance,\
                            state(rinstance): $state(rinstance)"
            return {}
        }
    } else {
        # Fake rinstance for version 2
        set state(rinstance) 0x100
    }

    switch -- $type {
        2 {
            # D-H commit message
            return [ProcessDHCommitMessage $token $binary]
        }
        3 {
            # Data message
            Delete $token
            return [ProcessDataMessage $token $binary]
        }
        10 {
            # D-H key message
            return [ProcessDHKeyMessage $token $binary]
        }
        17 {
            # Reveal signature message
            return [ProcessRevealSignatureMessage $token $binary]
        }
        18 {
            # Signature message
            return [ProcessSignatureMessage $token $binary]
        }
        default {
            return {}
        }
    }
}

# ::otr::ProcessDHCommitMessage --
#
#       Auxiliary procedure which takes the D-H commit message and replies
#       to it.

proc ::otr::ProcessDHCommitMessage {token data} {
    variable $token
    upvar 0 $token state

    switch -- $state(authstate) {
        AUTHSTATE_AWAITING_DHKEY {
            set arg [list -r $state(r)]
        }
        default {
            set arg {}
        }
    }

    set keyid [expr {$state(keyid)-1}]
    lassign [::otr::auth::processDHCommitMessage \
                    $state(version) \
                    $state(authstate) \
                    $state(msgstate) \
                    $data \
                    $state(x,$keyid) \
                    -sinstance $state(rinstance) \
                    -rinstance $state(sinstance) \
                    {*}$arg] \
            state(authstate) state(msgstate) message \
            state(egxmpi) state(hgxmpi)

    if {$message ne ""} {
        CallBack $token send $message
    }
    return {}
}

# ::otr::ProcessDHKeyMessage --

proc ::otr::ProcessDHKeyMessage {token data} {
    variable $token
    upvar 0 $token state

    switch -- $state(authstate) {
        AUTHSTATE_AWAITING_SIG {
            set arg [list -gy $state(gy)]
        }
        default {
            set arg {}
        }
    }

    set keyid [expr {$state(keyid)-1}]
    lassign [::otr::auth::processDHKeyMessage \
                    $state(version) \
                    $state(authstate) \
                    $state(msgstate) \
                    $data \
                    $state(privatekey) \
                    $state(r) \
                    $state(x,$keyid) \
                    $keyid \
                    -sinstance $state(rinstance) \
                    -rinstance $state(sinstance) \
                    {*}$arg] \
            state(authstate) state(msgstate) message state(gy)

    if {$message ne ""} {
        CallBack $token send $message
    }
    return {}
}

# ::otr::ProcessRevealSignatureMessage --

proc ::otr::ProcessRevealSignatureMessage {token data} {
    variable $token
    upvar 0 $token state

    set keyid [expr {$state(keyid)-1}]
    lassign [::otr::auth::processRevealSignatureMessage \
                    $state(version) \
                    $state(authstate) \
                    $state(msgstate) \
                    $data \
                    $state(egxmpi) \
                    $state(hgxmpi) \
                    $state(privatekey) \
                    $state(x,$keyid) \
                    $keyid \
                    -sinstance $state(rinstance) \
                    -rinstance $state(sinstance)] \
            authstate msgstate message state(publickey) gy keyidy

    if {$message ne ""} {
        # Success
        UpdatePeerDHKeysAfterAKE $token $gy $keyidy
        StoreSSID $token 0

        CallBack $token send $message

        switch -- $state(msgstate) {
            MSGSTATE_PLAINTEXT {
                CallBack $token info "Private conversation is started"
            }
            default {
                CallBack $token info "Private conversation is refreshed"
            }
        }

        set state(authstate) $authstate
        set state(msgstate) $msgstate
        Resend $token
    } else {
        set state(authstate) $authstate
        set state(msgstate) $msgstate
    }
    return {}
}

# ::otr::ProcessSignatureMessage --

proc ::otr::ProcessSignatureMessage {token data} {
    variable $token
    upvar 0 $token state

    set keyid [expr {$state(keyid)-1}]
    lassign [::otr::auth::processSignatureMessage \
                    $state(version) \
                    $state(authstate) \
                    $state(msgstate) \
                    $data \
                    $state(gy) \
                    $state(x,$keyid) \
                    -sinstance $state(rinstance) \
                    -rinstance $state(sinstance)] \
            authstate msgstate message state(publickey) keyidy

    if {$keyidy ne ""} {
        # Success
        UpdatePeerDHKeysAfterAKE $token $state(gy) $keyidy
        StoreSSID $token 1

        switch -- $state(msgstate) {
            MSGSTATE_PLAINTEXT {
                CallBack $token info "Private conversation is started"
            }
            default {
                CallBack $token info "Private conversation is refreshed"
            }
        }

        set state(authstate) $authstate
        set state(msgstate) $msgstate
        Resend $token
    } else {
        set state(authstate) $authstate
        set state(msgstate) $msgstate
    }
    return {}
}

# ::otr::UpdatePeerDHKeysAfterAKE --

proc ::otr::UpdatePeerDHKeysAfterAKE {token gy keyidy} {
    variable $token
    upvar 0 $token state

    # Store the peer's D-H public key (key management 2)

    if {$state(keyidy) == $keyidy && $state(gy,$keyidy) == $gy} {
        # Do nothing
    } elseif {$state(keyidy)-1 == $keyidy && $state(gy,$keyidy) == $gy} {
        # Do nothing
    } else {
        array unset state gy,*
        set state(keyidy) $keyidy
        set state(gy,$keyidy) $gy
        incr keyidy -1
        set state(gy,$keyidy) 0
    }
}

# ::otr::StoreSSID --

proc ::otr::StoreSSID {token flag} {
    variable $token
    upvar 0 $token state

    set gy $state(gy,$state(keyidy))
    set x  $state(x,[expr {$state(keyid)-1}])

    lassign [::otr::crypto::AKEKeys $gy $x] state(ssid)
    binary scan $state(ssid) H8H8 left right
    if {$flag} {
        set state(displayssid) "*$left* $right"
    } else {
        set state(displayssid) "$left *$right*"
    }
}

# ::otr::ShowCantDecipherError --

proc ::otr::ShowCantDecipherError {token flags} {
    variable $token
    upvar 0 $token state

    set info "Encrypted message can't be deciphered"
    set reply [list [::otr::data::errorMessage $info]]

    if {"IGNORE_UNREADABLE" ni $flags} {
        CallBack $token info $info
        CallBack $token send $reply
    }
}

# ::otr::ProcessDataMessage --

proc ::otr::ProcessDataMessage {token data} {
    variable $token
    upvar 0 $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            lassign [::otr::message::getDataMessageKeyids $data] \
                    flags skeyid rkeyid nextkey ctrtop rest

            if {$skeyid <= 0 || $rkeyid <= 0} {
                Debug $token 1 "Data message doesn't contain key serial numbers"
                ShowCantDecipherError $token $flags
                return {}
            }

            if {$skeyid != $state(keyidy) && $skeyid != $state(keyidy)-1} {
                Debug $token 1 "The sender's key serial number is unknown"
                ShowCantDecipherError $token $flags
                return {}
            }

            if {$rkeyid != $state(keyid) && $rkeyid != $state(keyid)-1} {
                Debug $token 1 "The recipient's key serial number is unknown"
                ShowCantDecipherError $token $flags
                return {}
            }

            if {$state(gy,$skeyid) <= 0} {
                Debug $token 1 "The sender's key with this serial number doesn't exist"
                ShowCantDecipherError $token $flags
                return {}
            }

            if {[info exists state(ctrtop,$skeyid,$rkeyid)]} {
                if {$state(ctrtop,$skeyid,$rkeyid) >= $ctrtop} {
                    Debug $token 1 "The sender's counter isn't monotonically increasing"
                    ShowCantDecipherError $token $flags
                    return {}
                }
            } else {
                array unset ctrtop,*
            }
            set state(ctrtop,$skeyid,$rkeyid) $ctrtop

            lassign [::otr::crypto::AESKeys $state(gy,$skeyid) $state(x,$rkeyid)] \
                    skey smac rkey rmac
            # Save the receiving MAC key to reveal it later
            set state(oldmackey,$skeyid,$rkeyid) $rmac

            set result [::otr::message::processDataMessage \
                                $state(version) \
                                $state(msgstate) \
                                $state(smpstate) \
                                $rest \
                                $flags \
                                $skeyid \
                                $rkeyid \
                                $nextkey \
                                $ctrtop \
                                $rkey \
                                $rmac \
                                -smpcommand [namespace code [list SMPCallback $token]] \
                                -sinstance $state(rinstance) \
                                -rinstance $state(sinstance)]

            array set res $result

            foreach field {msgstate smpstate smpprogress} {
                if {[info exists res($field)]} {
                    set state($field) $res($field)
                }
            }

            if {[info exists res(debug)]} {
                Debug 2 $token $res(debug)
            }

            set ret {}
            foreach field {message secret question} {
                if {[info exists res($field)]} {
                    lappend ret $field $res($field)
                }
            }
            if {[info exists res(info)]} {
                CallBack $token info $res(info)
            }
            if {[info exists res(error)]} {
                CallBack $token error $res(error)
            }
            if {[info exists res(replyerr)]} {
                CallBack $token send $res(replyerr)
            }

            if {[info exists res(info)] || [info exists res(error)] ||
                    [info exists res(replyerr)]} {
                return $ret
            }

            if {[info exists res(reply)]} {
                switch -- $state(msgstate) {
                    MSGSTATE_ENCRYPTED {
                        # Auto reply makes sense only in encrypted state
                        # The only existing example so far is SMP

                        set repl {}
                        foreach {body tlvlist} $res(reply) {
                            CallBack $token send \
                                     [CreateEncryptedMessage $token {} $body $tlvlist]
                        }

                        # Store the time of last message sent
                        set state(lastmessage) [clock seconds]
                    }
                    default {
                        Debug 1 $token "Trying to autoreply in $state(msgstate) state"
                    }
                }
            }

            if {![info exists res(message)]} {
                Debug 2 $token "Decrypted message is empty"
            }

            switch -- $state(msgstate) {
                MSGSTATE_ENCRYPTED {
                    # Keys rotation (key management 4)

                    if {$rkeyid == $state(keyid)} {
                        incr rkeyid -1
                        unset state(x,$rkeyid)
                        foreach id [array names state oldmackey,*,$rkeyid] {
                            # Add the used receiving MAC keys to the
                            # revealed keys list
                            lappend state(oldmackeys) $state($id)
                            unset state($id)
                        }
                        incr rkeyid 2
                        set state(x,$rkeyid) [::otr::crypto::random 320]
                        incr state(keyid)
                        set state(ctrtop) 0
                    }

                    if {$skeyid == $state(keyidy)} {
                        incr skeyid -1
                        unset state(gy,$skeyid)
                        foreach id [array names state oldmackey,$skeyid,*] {
                            # Add the used receiving MAC keys to the
                            # revealed keys list
                            lappend state(oldmackeys) $state($id)
                            unset state($id)
                        }
                        incr skeyid 2
                        set state(gy,$skeyid) $nextkey
                        incr state(keyidy)
                        set state(ctrtop) 0
                    }

                    # Heartbeat message
                    if {([lsearch -exact $ret reply] % 2) != 0} {
                        set curtime [clock seconds]
                        if {$state(heartbeat) > 0 &&
                                $curtime > $state(lastmessage) + 60*$state(heartbeat)} {
                            set state(lastmessage) [clock seconds]
                            CallBack $token send \
                                     [CreateEncryptedMessage $token \
                                                {IGNORE_UNREADABLE} "" {}]]
                        }
                    }
                }
                default {
                    InitDHKeys $token
                }
            }
            return $ret
        }
        MSGSTATE_PLAIN -
        MSGSTATE_FINISHED {
            ShowCantDecipherError $token {}
            return {}
        }
    }
}

# ::otr::InitDHKeys --

proc ::otr::InitDHKeys {token} {
    variable $token
    upvar 0 $token state

    # Forget the existing keys if any

    array unset state x,*
    array unset state gy,*
    array unset state ctrtop,*
    array unset state oldmackey,*

    # Generate DH private keys (key management 1)

    set state(keyid) 2
    set state(x,1) [::otr::crypto::random 320]
    set state(x,2) [::otr::crypto::random 320]
    set state(keyidy) 0
    set state(gy,0) 0
    set state(gy,-1) 0
    set state(oldmackeys) {}

    # Not exactly D-H related:

    set state(ctrtop) 0
    unset -nocomplain state(version)
}

# ::otr::CreateSMP1 --

proc ::otr::CreateSMP1 {token secret args} {
    variable $token
    upvar $token state

    lassign [::otr::smp::createSMPMessage1 $state(smpstate) \
                                           $state(privatekey) \
                                           $state(publickey) \
                                           $state(ssid) \
                                           $secret \
                                           {*}$args] \
            smpstate type payload x a2 a3
    if {$type == 6} {
        SMPCallback $token clear
        set progress SMP_ABORT
    } else {
        SMPCallback $token set x  $x
        SMPCallback $token set a2 $a2
        SMPCallback $token set a3 $a3
        set progress SMP_PROGRESS
    }
    list $smpstate $progress {} "" [list $type $payload]
}

# ::otr::CreateSMP2 --

proc ::otr::CreateSMP2 {token secret} {
    variable $token
    upvar $token state

    set data1 [SMPCallback $token get data1]
    lassign [::otr::smp::processSMPMessage1 $state(smpstate) \
                                            $data1 \
                                            $state(privatekey) \
                                            $state(publickey) \
                                            $state(ssid) \
                                            $secret] \
            smpstate type payload g3a g2 g3 b3 Pb Qb
    if {$type == 6} {
        SMPCallback $token clear
        set progress SMP_ABORT
    } else {
        SMPCallback $token set g3a $g3a
        SMPCallback $token set g2  $g2
        SMPCallback $token set g3  $g3
        SMPCallback $token set b3  $b3
        SMPCallback $token set Pb  $Pb
        SMPCallback $token set Qb  $Qb
        set progress SMP_PROGRESS
    }
    list $smpstate $progress {} "" [list $type $payload]
}

# ::otr::CreateEncryptedMessage --

proc ::otr::CreateEncryptedMessage {token flags body tlvlist} {
    variable $token
    upvar $token state

    # Key management 3
    set keyid $state(keyid);             # Next private key id
    set keyidx [expr {$state(keyid)-1}]; # Current private key id
    set keyidy $state(keyidy);           # Current public key id

    lassign [::otr::crypto::AESKeys $state(gy,$keyidy) $state(x,$keyidx)] \
            skey smac rkey rmac

    set oldmackeys $state(oldmackeys)
    set state(oldmackeys) {}

    ::otr::message::createDataMessage \
            $state(version) $flags $keyidx $keyidy $skey $smac \
            $state(x,$keyid) [incr state(ctrtop)] $body $tlvlist \
            $oldmackeys \
            -sinstance $state(sinstance) \
            -rinstance $state(rinstance)
}

# ::otr::FindVersion --
#
#       Check if the given versions list contains one of the supported.
#
# Arguments:
#       token           The OTR session token.
#       versions        The OTR protocol versions list (from the received
#                       OTR request or whitespace tag).
#
# Result:
#       Either the preferred version to choose or 0 if there's no supported
#       version in the list.
#
# Side effects:
#       None.

proc ::otr::FindVersion {token versions} {
    variable $token
    upvar 0 $token state

    if {3 in $versions && [QueryPolicy $token ALLOW_V3]} {
        return 3
    } elseif {2 in $versions && [QueryPolicy $token ALLOW_V2]} {
        return 2
    } else {
        return 0
    }
}

# ::otr::NewSession --

proc ::otr::NewSession {token version} {
    variable $token
    upvar 0 $token state

    set state(version) $version
    unset -nocomplain state(rinstance)
    set state(r) [::otr::crypto::Int2Octets [::otr::crypto::random 128] 128]
    set keyid [expr {$state(keyid)-1}]
    ::otr::auth::createDHCommitMessage $state(version) \
                                       $state(authstate) \
                                       $state(msgstate) \
                                       $state(r) \
                                       $state(x,$keyid) \
                                       -sinstance $state(sinstance)
}

# ::otr::Store --

proc ::otr::Store {token message} {
    variable $token
    upvar 0 $token state

    # Store only the last message
    set state(storedmessages) [list $message]
}

# ::otr::Resend --

proc ::otr::Resend {token} {
    variable $token
    upvar 0 $token state

    switch -- $state(msgstate) {
        MSGSTATE_ENCRYPTED {
            foreach message $state(storedmessages) {
                set state(lastmessage) [clock seconds]
                set message [CreateEncryptedMessage \
                                    $token {} "\[resent\] $message" {}]
                CallBack $token send $message
            }
        }
    }
    set state(storedmessages) {}
}

# ::otr::Delete --

proc ::otr::Delete {token} {
    variable $token
    upvar 0 $token state

    set state(storedmessages) {}
}

# ::otr::QueryPolicy --

proc ::otr::QueryPolicy {token item} {
    variable $token
    upvar 0 $token state

    expr {$item in $state(policy)}
}

# ::otr::SMPCallback --

proc ::otr::SMPCallback {token op {name ""} {val ""}} {
    variable $token
    upvar 0 $token state

    switch -- $op {
        clear {
            array unset state smp,*
            return ""
        }
        get {
            switch -- $name {
                privkey {
                    # Our DSA key
                    return $state(privatekey)
                }
                pubkey {
                    # Peer's DSA key
                    return $state(publickey)
                }
                default {
                    if {[info exists state(smp,$name)]} {
                        return $state(smp,$name)
                    } else {
                        return ""
                    }
                }
            }
        }
        set {
            set state(smp,$name) $val
            return $val
        }
    }
}

# ::otr::fragmentMessage --

proc ::otr::fragmentMessage {token data size} {
    variable $token
    upvar 0 $token state

    set len [string length $data]
    switch -- $state(version) {
        2 {
            if {$len <= $size} {
                return [list $data]
            }
            # Compute number of pieces
            set len [string length $data]
            set maxdig 1
            while {1} {
                set psize [expr {$size - 8 - 2*$maxdig}]
                if {$psize <= 0} {
                    return -code error "Too small chunk size"
                }
                set n [expr {($len+$psize-1)/$psize}]
                if {[string length $n] <= $maxdig} break
                incr maxdig
            }
            set res {}
            set k 1
            set id1 0
            set id2 [expr {$psize-1}]
            while {$k <= $n} {
                lappend res [format "?OTR,%hu,%hu,%s," \
                                    $k $n [string range $data $id1 $id2]]
                incr k
                incr id1 $psize
                incr id2 $psize
            }
            return $res
        }
        3 {
            if {$len <= $size} {
                return [list $data]
            }
            set sinstance $state(sinstance)
            set rinstance [expr {[info exists state(rinstance)]? \
                                 $state(rinstance) : 0}]
            set fsinstance [format %x $sinstance]
            set frinstance [format %x $rinstance]
            set slen [string length $fsinstance]
            set rlen [string length $frinstance]
            # Compute number of pieces
            set len [string length $data]
            set maxdig 1
            while {1} {
                set psize [expr {$size - 10 - $slen - $rlen - 2*$maxdig}]
                if {$psize <= 0} {
                    return -code error "Too small chunk size"
                }
                set n [expr {($len+$psize-1)/$psize}]
                if {[string length $n] <= $maxdig} break
                incr maxdig
            }
            set res {}
            set k 1
            set id1 0
            set id2 [expr {$psize-1}]
            while {$k <= $n} {
                lappend res [format "?OTR|%s|%s,%hu,%hu,%s," \
                                    $fsinstance $frinstance \
                                    $k $n [string range $data $id1 $id2]]
                incr k
                incr id1 $psize
                incr id2 $psize
            }
            return $res
        
        }
        default {
            return -code error "Unsupported protocol version $state(version)"
        }
    }
}

# ::otr::TrackAuthState --

proc ::otr::TrackAuthState {token name1 name2 op} {
    variable $token
    upvar 0 $token state

    if {$state(storedauthstate) eq $state(authstate)} return

    set state(storedauthstate) $state(authstate)
    CallBack $token authstate $state(authstate)
}

# ::otr::TrackMsgState --

proc ::otr::TrackMsgState {token name1 name2 op} {
    variable $token
    upvar 0 $token state

    if {$state(storedmsgstate) eq $state(msgstate)} return

    switch -- $state(storedmsgstate) {
        MSGSTATE_ENCRYPTED {
            switch -- $state(msgstate) {
                MSGSTATE_FINISHED  -
                MSGSTATE_PLAINTEXT {
                    Delete $token
                    CallBack $token info "Private conversation is finished"
                }
            }
        }
    }

    set state(storedmsgstate) $state(msgstate)
    switch -- $state(msgstate) {
        MSGSTATE_PLAINTEXT {
            set state(receivedplaintext) 0
        }
    }
    CallBack $token msgstate $state(msgstate)

    set state(smpstate) SMPSTATE_EXPECT1
    set state(smpprogress) SMP_NONE
}

# ::otr::TrackSMPState --

proc ::otr::TrackSMPState {token name1 name2 op} {
    variable $token
    upvar 0 $token state

    if {$state(storedsmpstate) eq $state(smpstate)} return

    set state(storedsmpstate) $state(smpstate)
    CallBack $token smpstate $state(smpstate)
}

# ::otr::TrackSMPProgress --

proc ::otr::TrackSMPProgress {token name1 name2 op} {
    variable $token
    upvar 0 $token state

    CallBack $token smpprogress $state(smpprogress)
}

# ::otr::CallBack --

proc ::otr::CallBack {token op args} {
    variable $token
    upvar 0 $token state

    foreach cmd $state(${op}commands) {
        eval $cmd $args
    }
    return
}

# ::otr::Debug --
#
#       Prints debug information.
#
# Arguments:
#       token   OTR instance token.
#       level   A debug level.
#       str     A debug message.
#
# Result:
#       An empty string.
#
# Side effects:
#       A debug message is printed to the console if the value of
#       ::otr::debug variable is not less than num.

proc ::otr::Debug {token level str} {
    variable debug

    if {$debug >= $level} {
        puts "[clock format [clock seconds] -format %T]\
              [lindex [info level -1] 0] $token $str"
    }

    return
}

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