# message.tcl --
#
#       This file is a part of the Off-the-Record messaging protocol
#       implementation. It contains the OTR Data packets serializing and
#       deserializing 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 sha1
package require otr::data
package require otr::crypto
package require otr::smp

package provide otr::message 0.1

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

namespace eval ::otr::message {
    array set Flags {IGNORE_UNREADABLE 0x01}
}

# ::otr::message::createDataMessage --
#
#       Assemble the OTR data message, the only message type which is to be
#       sent after AKE succeedes.
#
# Arguments:
#       version         Protocol version (2 or 3).
#       flags           List of message flags (currently either {} or
#                       {IGNORE_UNREADABLE}).
#       skeyid          Sender D-H key serial ID (for x1).
#       rkeyid          Recipient D-H key serial ID (for gy).
#       x1              Current D-H private key.
#       x2              Next D-H private key.
#       gy              Peer's current D-H public key.
#       ctrtop          Top 64 bit of the counter for AES128-CTR cipher.
#       humanreadable   Human readable message.
#       tlvlist         List of even number of items, integer TLV types and
#                       their binary payloads.
#       -sinstance num  (only for version 3) Sender instance tag.
#       -rinstance num  (only for version 3) Receiver instance tag.
#
# Result:
#       BASE64 encoded OTR packet with the data message inside.
#
# Side effects:
#       None.

proc ::otr::message::createDataMessage {version flags skeyid rkeyid skey smac x
                                        ctrtop humanreadable tlvlist
                                        oldmackeys args} {
    variable Flags

    set sinstance 0x100
    set rinstance 0
    foreach {key val} $args {
        switch -- $key {
            -sinstance { set sinstance $val }
            -rinstance { set rinstance $val }
        }
    }
    set res ""
    append res [::otr::data::encode SHORT $version]
    append res [::otr::data::encode BYTE 0x03]
    if {$version > 2} {
        append res [::otr::data::encode INT $sinstance]
        append res [::otr::data::encode INT $rinstance]
    }
    set binflags 0
    foreach f $flags {
        if {[info exists Flags($f)]} {
            set binflags [expr {$binflags | $Flags($f)}]
        }
    }
    append res [::otr::data::encode BYTE $binflags]
    append res [::otr::data::encode INT $skeyid]
    append res [::otr::data::encode INT $rkeyid]
    set gx [::otr::crypto::DHGx $x]
    append res [::otr::data::encode MPI $gx]
    append res [::otr::data::encode CTR $ctrtop]

    set plaintext [createDataMessagePlaintext $humanreadable $tlvlist]

    set cryptotext [::otr::crypto::aes $plaintext $skey $ctrtop]
    append res [::otr::data::encode DATA $cryptotext]

    set hmac [::sha1::hmac -bin -key $smac $res]
    append res [::otr::data::encode MAC $hmac]

    append res [::otr::data::encode DATA [join $oldmackeys ""]]
    ::otr::data::encodeMessage $res
}

# ::otr::message::processDataMessage --
#
#       Process received OTR data message. Check its validity, decode and
#       process the TLVs if any.
#
# Arguments:
#       version         Protocol version.
#       msgstate        OTR message state.
#       smpstate        OTR SMP state.
#       data            Unparsed yet message data (encrypted text, HMAC and
#                       old keys for revelation).
#       flags           Message flags.
#       skeyid          Sender's (peer's) key serial ID.
#       rkeyid          Receiver's (your) key serial ID.
#       gy              Next sender's public key.
#       ctrtop          Top 8 bytes of AES counter.
#       rkey            Receiver's key for decrypting.
#       rmac            Receiver's key for verification.
#       -smpcommand cmd Callback to call when some SMP state data are to be
#                       stored or retrieved.
#       -sinstance tag  The sender's instance tag (for version 3)
#       -rinstance tag  The receiver's instance tag (for version 3)
#
# Result:
#       Serialized array with the following fields (not all of them may be
#       present): info - info message to show to theh user, replyerr -
#       error message to reply, debug - debug message, message - the message
#       body, msgstate - new message state, smpstate - new smp state,
#       smpprogress - the progress of SMP procedure, secret - ask user the
#       SMP secret, question - show user the SMP question, reply - send
#       the given data message.
#
# Side effects:
#       SMP data may be stored or retrieved via callback.

proc ::otr::message::processDataMessage {version msgstate smpstate data
                                         flags skeyid rkeyid gy ctrtop
                                         rkey rmac args} {
    variable Flags

    set sinstance 0x100
    set rinstance 0x100
    foreach {key val} $args {
        switch -- $key {
            -smpcommand { set smpcommand $val }
            -sinstance { set sinstance $val }
            -rinstance { set rinstance $val }
        }
    }

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

    if {"IGNORE_UNREADABLE" in $flags} {
        set err {}
    } else {
        set err [list info "Encrypted message can't be deciphered" \
                      replyerr [list [::otr::data::errorMessage \
                                    "Encrypted message can't be deciphered"]]]
    }

    if {[catch {parseDataMessage $data} res]} {
        return [linsert $err 0 debug "Parsing data message failed: $res"]
    }

    lassign $res cryptotext hmac oldmackeys

    # Reassemble the message and verify its hash

    set msg ""
    append msg [::otr::data::encode SHORT $version]
    append msg [::otr::data::encode BYTE 0x03]
    if {$version > 2} {
        append msg [::otr::data::encode INT $sinstance]
        append msg [::otr::data::encode INT $rinstance]
    }
    set binflags 0
    foreach f $flags {
        if {[info exists Flags($f)]} {
            set binflags [expr {$binflags | $Flags($f)}]
        }
    }
    append msg [::otr::data::encode BYTE $binflags]
    append msg [::otr::data::encode INT $skeyid]
    append msg [::otr::data::encode INT $rkeyid]
    append msg [::otr::data::encode MPI $gy]
    append msg [::otr::data::encode CTR $ctrtop]
    append msg [::otr::data::encode DATA $cryptotext]

    set myhmac [::sha1::hmac -bin -key $rmac $msg]

    if {$myhmac ne $hmac} {
        return [linsert $err 0 debug "Data message hash verification failed"]
    }

    # Decrypt the payload and parse it

    set plaintext [::otr::crypto::aes $cryptotext $rkey $ctrtop]

    if {[catch {parseDataMessagePlaintext $plaintext} res]} {
        return [linsert $err 0 debug \
                               "Data message plaintext decoding failed: $res"]
    }

    lassign $res message tlvlist

    if {$message eq ""} {
        set msg {}
    } else {
        set msg [list message $message]
    }

    # Store the extra symmetric key usage info if it's present

    foreach {type value} $tlvlist {
        switch -- $type {
            8 {
                # Extra symmetric key
                # TODO
            }
        }
    }

    # Finish the OTR conversation if the peer asked to

    foreach {type value} $tlvlist {
        switch -- $type {
            1 {
                # Disconnected
                # There's no point to continue SMP if any in progress
                set msgstate MSGSTATE_FINISHED
                set smpstate SMPSTATE_EXPECT1
                {*}$smpcommand clear
                return [list msgstate    $msgstate \
                             smpstate    $smpstate \
                             smpprogress SMP_ABORT \
                             {*}$msg]
            }
        }
    }

    # Consider only the first SMP TLV, ignore the rest

    foreach {type value} $tlvlist {
        switch -- $type {
            0 {
                # Padding
            }
            2 {
                # SMP message 1
                # Don't process it immediately, just store and go
                # after the user will supply the shared secret

                {*}$smpcommand set data1     $value

                return [list secret ""]
            }
            3 {
                # SMP message 2

                set x  [{*}$smpcommand get x]
                set a2 [{*}$smpcommand get a2]
                set a3 [{*}$smpcommand get a3]
                lassign [::otr::smp::processSMPMessage2 \
                                    $smpstate $value $x $a2 $a3] \
                        smpstate tlv payload g3b PaPb QaQb Ra
                if {$tlv == 6} {
                    {*}$smpcommand clear
                    set answer SMP_CHEATING
                } else {
                    {*}$smpcommand set g3b  $g3b
                    {*}$smpcommand set PaPb $PaPb
                    {*}$smpcommand set QaQb $QaQb
                    {*}$smpcommand set Ra   $Ra
                    set answer SMP_PROGRESS
                }
                return [list msgstate    $msgstate \
                             smpstate    $smpstate \
                             smpprogress $answer \
                             reply       [list "" [list $tlv $payload]] \
                             {*}$msg]
            }
            4 {
                # SMP message 3

                set g3a [{*}$smpcommand get g3a]
                set g2  [{*}$smpcommand get g2]
                set g3  [{*}$smpcommand get g3]
                set b3  [{*}$smpcommand get b3]
                set Pb  [{*}$smpcommand get Pb]
                set Qb  [{*}$smpcommand get Qb]
                lassign [::otr::smp::processSMPMessage3 \
                                $smpstate $value $g3a $g2 $g3 $b3 $Pb $Qb] \
                        smpstate tlv payload res
                if {$tlv == 6} {
                    {*}$smpcommand clear
                    set answer SMP_CHEATING
                } else {
                    if {$res} {
                        set answer SMP_SUCCESS
                    } else {
                        set answer SMP_FAILURE
                    }
                }
                return [list msgstate    $msgstate \
                             smpstate    $smpstate \
                             smpprogress $answer \
                             reply       [list "" [list $tlv $payload]] \
                             {*}$msg]
            }
            5 {
                # SMP message 4

                set a3   [{*}$smpcommand get a3]
                set g3b  [{*}$smpcommand get g3b]
                set PaPb [{*}$smpcommand get PaPb]
                set QaQb [{*}$smpcommand get QaQb]
                set Ra   [{*}$smpcommand get Ra]
                lassign [::otr::smp::processSMPMessage4 \
                                $smpstate $value $a3 $g3b $PaPb $QaQb $Ra] \
                        smpstate tlv payload res
                
                {*}$smpcommand clear
                if {$tlv == 6} {
                    set answer SMP_CHEATING
                    set tlvp [list $tlv $payload]
                } else {
                    if {$res} {
                        set answer SMP_SUCCESS
                    } else {
                        set answer SMP_FAILURE
                    }
                    set tlvp {}
                }
                return [list msgstate    $msgstate \
                             smpstate    $smpstate \
                             smpprogress $answer \
                             reply       [list "" $tlvp] \
                             {*}$msg]
            }
            6 {
                # SMP abort message

                set smpstate SMPSTATE_EXPECT1
                {*}$smpcommand clear
                return [list msgstate    $msgstate \
                             smpstate    $smpstate \
                             smpprogress SMP_ABORT \
                             {*}$msg]
            }
            7 {
                # SMP message 1Q
                # Don't process it immediately, just store and go
                # after the user will supply the shared secret

                set idx [string first \x00 $value]
                if {$idx < 0} {
                    set smpstate SMPSTATE_EXPECT1
                    {*}$smpcommand clear
                    return [list msgstate    $msgstate \
                                 smpstate    $smpstate \
                                 smpprogress SMP_CHEATING \
                                 reply       {"" {6 ""}} \
                                 {*}$msg]
                }
                set question [encoding convertfrom utf-8 \
                                       [string range $value 0 [expr {$idx-1}]]]
                set value [string range $value [expr {$idx+1}] end]

                {*}$smpcommand set data1     $value

                return [list question $question]
            }
        }
    }
    return [list msgstate $msgstate \
                 smpstate $smpstate \
                 {*}$msg]
}

# ::otr::message::parseDataMessage --
#
#       Parse the OTR data message (without version, packet type, sender
#       and receiver instance tags, flags and sender and receiver keyids
#       which were extracted earlier).
#
# Arguments:
#       data            Payload to parse.
#
# Result:
#       Tuple {cryptotext, hmac, oldmackeys} where cryptotext is the
#       encrypted message body (possibly with TLV attached), hmac is
#       a message HMAC for verifiction, and oldmackeys is a set of old
#       receiver's MAC keys for revelation.
#
# Side effects:
#       Error is raised if decoding is failed for some reason.

proc ::otr::message::parseDataMessage {data} {
    variable Flags

    lassign [::otr::data::decode DATA $data] cryptotext data
    lassign [::otr::data::decode MAC $data] hmac data
    lassign [::otr::data::decode DATA $data] oldmackeys
    list $cryptotext $hmac $oldmackeys
}

# ::otr::message::getDataMessageKeyids --
#
#       Return message flags, D-H key serial IDs, the peer's next public key,
#       counter, encoded in the data message (with stripped out protocol
#       version, message type, sender and receiver instance tags).
#
# Arguments:
#       data            Payload to parse.
#
# Result:
#       Tuple {flags, skeyid, rkeyid, gy, ctrtop, data} with the message
#       flags, sender and recipient key serials, peer's public key, the top
#       8 bytes of the AES counter, and rest of the message, or tuple
#       {{}, 0, 0, 0, 0, ""} if decoding fails.
#
# Side effects:
#       None.

proc ::otr::message::getDataMessageKeyids {data} {
    variable Flags

    if {![catch {
            lassign [::otr::data::decode BYTE $data] binflags data
            set flags {}
            foreach f [array names Flags] {
                if {[expr {$binflags & $Flags($f)}]} {
                    lappend flags $f
                }
            }
            lassign [::otr::data::decode INT $data] skeyid data
            lassign [::otr::data::decode INT $data] rkeyid data
            lassign [::otr::data::decode MPI $data] gy data
            lassign [::otr::data::decode CTR $data] ctrtop data
            list $flags $skeyid $rkeyid $gy $ctrtop $data
         } res]} {
        return $res
    } else {
        return {{} 0 0 0 0 ""}
    }
}

# ::otr::message::createDataMessagePlaintext --
#
#       Assemble the plaintext part of OTR data message.
#
# Arguments:
#       humanreadable       Human readable part (message body).
#       tlvlist             List with an even items number with TLV types
#                           and payloads.
#
# Result:
#       Encoded plaintext part of OTR data message.
#
# Side effects:
#       None.

proc ::otr::message::createDataMessagePlaintext {humanreadable tlvlist} {
    set res [encoding convertto utf-8 [escapeHTML $humanreadable]]
    if {[string first \x00 $res] >= 0} {
        return -code error "Zero byte in the human readable message part"
    }

    if {[llength $tlvlist] > 0} {
        append res \x00
    }

    foreach {type data} $tlvlist {
        append res [::otr::data::encodeTLV $type $data]
    }
    set res
}

# ::otr::message::escapeHTML --
#
#       Return a text message with escaped HTML entities.
#
# Arguments:
#       message         Text message.
#
# Result:
#       Text with HTML entities.
#
# Side effects:
#       None.

proc ::otr::message::escapeHTML {message} {
    string map {& &amp; < &lt; > &gt; \" &quot; \n <br>} $message
}

# ::otr::message::parseDataMessagePlaintext --
#
#       Parse an OTR data message plaintest part.
#
# Arguments:
#       data            Plaintext part of OTR data message.
#
# Result:
#       Tuple {body, tlvlist} where body is a human readable message, and
#       tlvlist is an even items number list of TLV types and payloads.

proc ::otr::message::parseDataMessagePlaintext {data} {
    set tlvlist {}
    set idx [string first \x00 $data]
    if {$idx < 0} {
        set hrutf8 $data
        set data ""
    } else {
        set hrutf8 [string range $data 0 [expr {$idx-1}]]
        set data [string range $data [expr {$idx+1}] end]
    }
    while {[string length $data] > 0} {
        lassign [::otr::data::decodeTLV $data] type value data
        lappend tlvlist $type $value
    }
    list [stripHTML [encoding convertfrom utf-8 $hrutf8]] $tlvlist
}

# ::otr::message::stripHTML --
#
#       Remove HTML tags from a message.
#
# Arguments:
#       message         Message to remove HTML tags from.
#
# Result:
#       The plain text message.
#
# Side effects:
#       None.
#
# Bugs:
#       The tag stripper is very basic. Should really use htmlparse or so.

proc ::otr::message::stripHTML {message} {
    set message [regsub -all {<br[^>]*>} $message "\n"]
    set message [regsub -all {<[^>]*>} $message ""]
    string map {&lt; < &gt; > &quot; \" &apos; ' &amp; &} $message
}

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