# otr.tcl --
#
#       This file is a part of Off-the-record messaging plugin for
#       the Tkabebr XMPP client. It implements the interface with
#       Tkabber.

namespace eval otr {
    # Prepare to load the local TclOTR library

    variable scriptdir [file dirname [info script]]
    variable tclotr [file join $scriptdir tclotr]

    if {[file isdirectory $tclotr]} {
        lappend ::auto_path $scriptdir
        package forget otr
    }

    # Load message catalogs:

    package require msgcat
    ::msgcat::mcload [file join $scriptdir msgs]
    ::trans::load [file join $scriptdir trans]

    # Check if Tkabber is sufficiently new

    if {[hook::is_empty send_normal_message_hook]} {
        puts stderr [::msgcat::mc "Tkabber is too old for the OTR plugin"]
        # Clean up what's already here and bail out:
        namespace delete [namespace current]
        return
    }

    # Attempt to load TclOTR. Warn and quit loading plugin if we can't:

    variable err
    if {[catch { package require otr } err]} {
        puts stderr $err
        puts stderr [::msgcat::mc "Problem loading TclOTR. The OTR\
                                   functionality will be disabled.\nRefer\
                                   to the README file of the OTR plugin."]
        # Clean up what's already here and bail out:
        namespace delete [namespace current]
        return
    }

    # Load DSA keys and authenticaton infrastructure

    source [file join $scriptdir auth.tcl]
    source [file join $scriptdir key.tcl]

    # Auxiliary namespace. Rewrite_message_hook will use it to add some
    # supplemetary info.

    variable ns tkabber:otr

    # PLugin's options

    variable options

    variable themes
    variable dirs \
        [glob -nocomplain -directory [file join [file dirname [info script]] \
                                                pixmaps] *]
    variable dir
    foreach dir $dirs {
        pixmaps::load_theme_name [namespace current]::themes $dir
    }
    variable values {}
    variable theme
    foreach theme [lsort [array names themes]] {
        lappend values $theme $theme
    }

    variable options

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
        -group Tkabber

    custom::defgroup OTR \
        [::msgcat::mc "Off-the-record messaging plugin options."] \
        -group Plugins

    custom::defvar options(theme) OTR \
        [::msgcat::mc "OTR icons theme."] -group OTR \
        -type options -values $values \
        -command [namespace current]::load_stored_theme

    custom::defvar options(allow-encryption) 1 \
        [::msgcat::mc "Allow Tkabber to use Off-the-Record protocol\
                       (version 2 or 3)."] \
        -group OTR -type boolean \
        -command [namespace current]::update_default_policy

    custom::defvar options(require-encryption) 0 \
        [::msgcat::mc "Refuse to send unencrypted messages. Note that if this\
                       option is enabled and the previous one is not then you\
                       will not be able to send any chat or normal messages\
                       at all"] \
        -group OTR -type boolean \
        -command [namespace current]::update_default_policy

    custom::defvar options(send-whitespace-tag) 1 \
        [::msgcat::mc "Advertise your support of OTR using the\
                       whitespace tag."] \
        -group OTR -type boolean \
        -command [namespace current]::update_default_policy

    custom::defvar options(whitespace-or-error-start-ake) 1 \
        [::msgcat::mc "Start the OTR authenticated key exchange when you\
                       receive a whitespace tag or an OTR error message."] \
        -group OTR -type boolean \
        -command [namespace current]::update_default_policy

    custom::defvar options(heartbeat-interval) 60 \
        [::msgcat::mc "If the interval between two consecutive incoming OTR\
                       messages exceeds the specified interval (in minutes,\
                       zero means no heartbeat at all) the heartbeat message\
                       will be sent to change the session keys."] \
        -group OTR -type integer -command [namespace current]::update_heartbeat

    custom::defvar options(dont-log-otr-messages) 0 \
        [::msgcat::mc "Do not log OTR messages."] \
        -group OTR -type boolean

    # Hidden option for storing contacts' personal preferences
    # {myjid1 {jid1 {allow-encryption 0 ...} jid2 {...}}
    #  myjid2 {jid1 {...} jid2 {...}}}

    custom::defvar options(personal-preferences) {} \
        [::msgcat::mc "Personal OTR preferences."] \
        -type string -group Hidden

    # Correspondence between GUI options and OTR policy flags

    variable PolicyFlags
    array set PolicyFlags {allow-encryption {ALLOW_V2 ALLOW_V3}
                           require-encryption {REQUIRE_ENCRYPTION}
                           send-whitespace-tag {SEND_WHITESPACE_TAG}
                           whitespace-or-error-start-ake
                                    {WHITESPACE_START_AKE ERROR_START_AKE}}
}

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

proc otr::load_stored_theme {args} {
    variable options
    variable themes

    pixmaps::load_dir $themes($options(theme))
}

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

proc otr::draw_encrypted {chatid from type body x} {
    variable ns
    variable ctx

    if {$type ne "chat"} return

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    set chatw [chat::chat_win $chatid]

    if {[::xmpp::jid::equal $jid $from]} {
        # Incoming message

        foreach xe $x {
            ::xmpp::xml::split $xe tag xmlns attrs cdata subels

            if {$tag eq "" && $xmlns eq $ns} {
                $chatw image create end -image [::xmpp::xml::getAttr $attrs icon]
                break
            }
        }
    } elseif {$from ne ""} {
        # Outgoing message

        set draw 1
        foreach xe $x {
            ::xmpp::xml::split $xe tag xmlns attrs cdata subels

            # Don't draw the icon for the messages from the log
            # TODO: store the OTR attribute in the log and draw
            # the icon for these messages as well
            if {$tag eq "" && $xmlns eq "tkabber:x:nolog"} {
                set draw 0
                break
            }
        }

        if {$draw && [msgstate:index $xlib $jid] > 0} {
            $chatw image create end -image [msgstate:icon $xlib $jid]
        }
    }
}

hook::add draw_message_hook [namespace current]::otr::draw_encrypted 5.4

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

proc otr::process_x_encrypted {rowvar bodyvar f x xlib from id type replyP} {
    variable ns
    variable ctx
    upvar 2 $rowvar row
    upvar 2 $bodyvar body

    if {$type eq "error" || $type eq "groupchat" || $type eq "headline"} return

    if {$body eq ""} return

    foreach xe $x {
        ::xmpp::xml::split $xe tag xmlns attrs cdata subels

        if {$tag eq "" && $xmlns eq $ns} {
            set lb [join [lrange [split $f .] 0 end-1] .].title.otrmsgstate
            if {[winfo exists $lb]} {
                destroy $lb
            }
            Label $lb -image [::xmpp::xml::getAttr $attrs icon]
            grid $lb -row 1 -column 4 -sticky e
            break
        }
    }
}

hook::add message_process_x_hook \
          [namespace current]::otr::process_x_encrypted 21

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

proc otr::once_only {xlib jid} {
    variable options
    variable ctx

    if {[info exists ctx($xlib,$jid)]} {
        return 1
    }

    debugmsg otr "ONCE_ONLY $xlib $jid"

    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
    set privkey [key::get_key $key::Keys $myjid]
    if {[llength $privkey] == 0} {
        return 0
    }

    set ctx(msgstate,$xlib,$jid) MSGSTATE_PLAINTEXT
    msgstate:trace {} $xlib $jid

    set ctx($xlib,$jid) \
        [::otr::new $privkey \
                -policy [get_policy $xlib $jid] \
                -heartbeat $options(heartbeat-interval) \
                -authstatecommand [namespace code [list on_authstate_change \
                                                        $xlib $jid]] \
                -msgstatecommand [namespace code [list on_msgstate_change \
                                                       $xlib $jid]] \
                -smpstatecommand [namespace code [list on_smpstate_change \
                                                       $xlib $jid]] \
                -smpprogresscommand [namespace code [list progress_smp \
                                                          $xlib $jid]] \
                -infocommand [namespace code [list show_info $xlib $jid]] \
                -errorcommand [namespace code [list show_error $xlib $jid]] \
                -sendcommand [namespace code [list send $xlib $jid]] \
                -discardcommand [namespace code [list discard $xlib $jid]] \
                -resendcommand [namespace code [list resend $xlib $jid]]]
    return 1
}

proc otr::clear {xlib jid} {
    variable ctx

    if {[info exists ctx($xlib,$jid)]} {
        finish_session $xlib $jid ""
        ::otr::free $ctx($xlib,$jid)
        unset ctx(authstate,$xlib,$jid)
        unset ctx(msgstate,$xlib,$jid)
        unset ctx(smpstate,$xlib,$jid)
        unset ctx($xlib,$jid)

        set chatid [chat::chatid $xlib $jid]
        set chatw [chat::chat_win $chatid]
        if {![winfo exists $chatw]} return

        if {[key::get_key $key::Keys \
                [::xmpp::jid::removeResource [connection_jid $xlib]]] eq ""} {
            chat::add_message $chatid $jid info \
                      "[::msgcat::mc {OTR Info:}]\
                       [::msgcat::mc {OTR is disabled because you have deleted\
                                      your OTR key. Generate or import a new\
                                      one if you want to enable it again.}]" {}
        } else {
            chat::add_message $chatid $jid info \
                      "[::msgcat::mc {OTR Info:}]\
                       [::msgcat::mc {OTR conversation is lost because you\
                                      have changed your OTR key. The next\
                                      private chat will use the new key.}]" {}
        }
    }
}

proc otr::clear_all {xlib} {
    variable ctx

    foreach idx [array names ctx $xlib,*] {
        regexp {[^,]*,(.*)} $idx -> jid
        clear $xlib $jid
    }
}

proc otr::clear_all_jid {myjid} {
    foreach xlib [connections] {
        if {[::xmpp::jid::equal $myjid \
                [::xmpp::jid::removeResource [connection_jid $xlib]]]} {
            clear_all $xlib
        }
    }
}

proc otr::reset_auth {myjid} {
    variable ctx

    foreach xlib [connections] {
        if {![::xmpp::jid::equal $myjid \
                [::xmpp::jid::removeResource [connection_jid $xlib]]]} continue

        foreach idx [array names ctx msgstate,$xlib,*] {
            regexp {msgstate,[^,]*,(.*)} $idx -> fjid
            on_msgstate_change $xlib $fjid $ctx($idx)
        }
    }

}

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

proc otr::on_authstate_change {xlib jid authstate} {
    variable ctx

    set ctx(authstate,$xlib,$jid) $authstate
}

proc otr::on_msgstate_change {xlib jid msgstate} {
    variable ctx

    set ctx(msgstate,$xlib,$jid) $msgstate
}

proc otr::on_smpstate_change {xlib jid smpstate} {
    variable ctx

    set ctx(smpstate,$xlib,$jid) $smpstate
}

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

proc otr::show_info {xlib jid info} {
    set chatid [::chat::chatid $xlib $jid]
    chat::add_message $chatid $jid info \
                      "[::msgcat::mc {OTR Info:}] [::msgcat::mc $info]" {}
}

proc otr::show_error {xlib jid error} {
    set chatid [::chat::chatid $xlib $jid]
    chat::add_message $chatid $jid error \
                      "[::msgcat::mc {OTR Error:}] $error" {}
}

proc otr::send {xlib jid message} {
    upvar 2 type type

    debugmsg otr "SEND: $xlib; $jid; $message;"

    # Dirty hack to recover message type
    for {set i 1} {$i < 12} {incr i} {
        if {[catch {upvar $i type type}]} break
        if {[info exists type] && $type eq "chat"} break
    }

    # Another dirty hack to translate OTR error messages
    if {![catch {::otr::data::findErrorMessage $message} error]} {
        set lang [get_jid_presence_info lang $xlib $jid]

        set message [::otr::data::errorMessage [::trans::trans $lang $error]]
    }

    if {[info exists type] && $type eq "chat"} {
        set targs [list -type $type]
    } else {
        set targs {}
    }
    ::xmpp::sendMessage $xlib $jid -body $message {*}$targs
}

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

proc otr::store {xlib jid isid id istype type issubject subject
                 isbody body iserr err isthread thread isx x} {
    variable ctx

    if {[info exists ctx($xlib,$jid)]} {
        # Store only the last message

        set ctx(stored,$xlib,$jid) \
            [list $isid $id $istype $type $issubject $subject \
                  $isbody $body $iserr $err $isthread $thread $isx $x]
    }
}

proc otr::discard {xlib jid} {
    variable ctx

    if {[info exists ctx($xlib,$jid)]} {
        set ctx(stored,$xlib,$jid) {}
    }
}

proc otr::resend {xlib jid} {
    variable ctx

    if {[info exists ctx($xlib,$jid)] && [info exists ctx(stored,$xlib,$jid)]} {
        set opts {}
        foreach {isid id istype type issubject subject isbody body
                 iserr err isthread thread isx x} $ctx(stored,$xlib,$jid) {
            if {$isid} {
                lappend opts -id $id
            }
            if {$istype} {
                lappend opts -type $type
            }
            if {$issubject} {
                lappend opts -subject $subject
            }
            if {$isbody} {
                lappend opts -body $body
            }
            if {$iserr} {
                lappend opts -error $err
            }
            if {$isthread} {
                lappend opts -thread $thread
            }
            if {$isx} {
                lappend opts -xlist $x
            }
            ::message::send_msg $xlib $jid {*}$opts
        }
    }
}

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

proc otr::update_heartbeat {args} {
    variable options
    variable ctx

    foreach idx [array names ctx ::*] {
        ::otr::configure $ctx($idx) -heartbeat $options(heartbeat-interval)
    }
}

proc otr::get_policy {xlib jid} {
    variable options
    variable PolicyFlags

    set njid [::xmpp::jid::normalize $jid]

    set policy {}
    foreach key {allow-encryption require-encryption
                 send-whitespace-tag whitespace-or-error-start-ake} {
        if {[info exists options($key,$xlib,$njid)]} {
            set flag $options($key,$xlib,$njid)
        } else {
            set flag $options($key)
        }
        if {$flag} {
            lappend policy {*}$PolicyFlags($key)
        }
    }
    debugmsg otr "GET_POLICY $xlib $jid $policy"
    set policy
}

proc otr::update_default_policy {args} {
    update_policy
}

proc otr::update_policy {{xlib ""} {jid ""}} {
    variable ctx

    if {$xlib eq ""} {
        set xlibs [connections]
    } else {
        set xlibs [list $xlib]
    }
    foreach xl $xlibs {
        if {$jid eq ""} {
            set jids {}
            foreach idx [array names ctx $xl,*] {
                regexp "$xl,(.*)" $idx -> j
                lappend jids $j
            }
        } else {
            if {[info exists ctx($xl,$jid)]} {
                set jids [list $jid]
            } else {
                set jids {}
            }
        }
        foreach j $jids {
            ::otr::configure $ctx($xl,$j) -policy [get_policy $xl $j]
        }
    }
}

proc otr::reset_policy {xlib jid} {
    variable options

    set njid [::xmpp::jid::normalize $jid]

    foreach key {allow-encryption require-encryption
                 send-whitespace-tag whitespace-or-error-start-ake} {
        if {[info exists options($key,$xlib,$njid)]} {
            unset options($key,$xlib,$njid)
        }
    }

    update_policy $xlib $jid
}

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

proc otr::get_personal_prefs {xlib} {
    variable options

    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
    array set p $options(personal-preferences)

    if {[info exists p($connjid)]} {
        foreach {jid prefs} $p($connjid) {
            foreach {key val} $prefs {
                set options($key,$xlib,$jid) $val
            }
        }
    }
}

hook::add connected_hook [namespace current]::otr::get_personal_prefs 1

proc otr::set_personal_prefs {xlib} {
    variable options

    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
    array set p $options(personal-preferences)

    set p($connjid) {}
    set jids {}
    foreach idx [array names options *,$xlib,*] {
        lappend jids [join [lrange [split $idx ,] 2 end] ,]
    }
    set jids [lsort -unique $jids]

    foreach j $jids {
        set prefs {}
        foreach key {allow-encryption require-encryption send-whitespace-tag
                     whitespace-or-error-start-ake dont-log-otr-messages} {
            if {[info exists options($key,$xlib,$j)] && \
                    $options($key,$xlib,$j) != $options($key)} {
                lappend prefs $key $options($key,$xlib,$j)
            }
        }
        if {[llength $prefs] > 0} {
            lappend p($connjid) $j $prefs
        }
    }

    if {[llength $p($connjid)] == 0} {
        unset p($connjid)
    }

    set options(personal-preferences) [array get p]
}

hook::add disconnected_hook [namespace current]::otr::set_personal_prefs 40

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

proc otr::request_session {xlib jid type} {
    variable ctx

    once_only $xlib $jid

    set lang [get_jid_presence_info lang $xlib $jid]

    ::otr::requestConversation $ctx($xlib,$jid) \
          \n[::trans::trans $lang \
                    "I has requested an Off-the-Record private conversation.\
                    However, you do not have a plugin to support that (or\
                    the plugin is disabled, or you don't have an OTR private\
                    key to use it).\nSee http://otr.cypherpunks.ca/ for more\
                    information."] \
}

proc otr::finish_session {xlib jid type} {
    variable ctx

    once_only $xlib $jid

    ::otr::finishConversation $ctx($xlib,$jid)
}

proc otr::toggle_session {xlib jid type} {
    if {[msgstate:index $xlib $jid] == 0} {
        request_session $xlib $jid $type
    } else {
        finish_session $xlib $jid $type
    }
}

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

proc otr::peer_jid {xlib jid} {
    set bjid [::xmpp::jid::removeResource $jid]
    if {![chat::is_groupchat [chat::chatid $xlib $bjid]]} {
        return $bjid
    } else {
        return $jid
    }
}

proc otr::begin_smp_dialog {xlib jid} {
    variable ctx

    set w .otrstartauth[jid_to_tag $jid]

    Dialog $w -title [::msgcat::mc "Authenticate %s" [peer_jid $xlib $jid]] \
              -anchor e -default 0 -cancel 1

    wm resizable $w 0 0

    $w add -text [::msgcat::mc "Authenticate"] \
           -command [namespace code [list begin_smp $w $xlib $jid]]
    $w add -text [::msgcat::mc "Cancel"] \
           -command [list destroy $w]

    bind $w <Destroy> \
         [namespace code [clear_dialog [double% $xlib] [double% $jid]]]
    bind $w <<Copy>> \
         [namespace code [add_to_clipboard [double% $xlib] [double% $jid]]]

    set f [$w getframe]

    set m [Message $f.header \
                   -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
                                        a peer helps ensure that\
                                        the person you are talking to is who\
                                        he or she claims to be.\n\nHow would\
                                        you like to authenticate your peer?" \
                                       $jid] \
                             -width 12c]
    grid $m -row 1 -column 0 -sticky nswe
    tk_optionMenu $f.choice [namespace current]::ctx(authmethod,$xlib,$jid) \
                         [::msgcat::mc "Question and answer"] \
                         [::msgcat::mc "Shared secret"] \
                         [::msgcat::mc "Manual fingerprint verification"]
    trace add variable [namespace current]::ctx(authmethod,$xlib,$jid) \
          write [namespace code [list smp_dialog_switch_page $w $xlib $jid]]

    grid $f.choice -row 2 -column 0 -sticky nswe

    set pm [PagesManager $f.method]
    grid $pm -row 3 -column 0 -sticky nswe

    $pm add qa
    set pf1 [$pm getframe qa]
    set m1 [Message $pf1.instr \
                    -text [::msgcat::mc "To authenticate using a question,\
                                         pick a question whose answer is known\
                                         only to you and your peer. Enter this\
                                         question and this answer, then wait\
                                         for your peer to enter the answer\
                                         too. If the answers don't match then\
                                         you may be talking to an imposter."] \
                              -width 12c]
    grid $m1 -row 0 -column 0 -sticky nswe
    set l1 [Label $pf1.l1 -text [::msgcat::mc "Enter question here:"]]
    grid $l1 -row 1 -column 0 -sticky nsw
    set e1 [Entry $pf1.e1]
    grid $e1 -row 2 -column 0 -sticky nswe
    set l2 [Label $pf1.l2 -text [::msgcat::mc "Enter secret answer here\
                                               (case sensitive):"]]
    grid $l2 -row 3 -column 0 -sticky nsw
    set e2 [Entry $pf1.e2]
    grid $e2 -row 4 -column 0 -sticky nswe
    Progressbar $pf1.pb \
            -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
    grid $pf1.pb -row 5 -column 0 -sticky ew
    set l4 [Label $pf1.l4 \
            -textvariable [namespace current]::ctx(status,$xlib,$jid)]
    grid $l4 -row 6 -column 0

    $pm add ss
    set pf2 [$pm getframe ss]
    set m2 [Message $pf2.instr \
                    -text [::msgcat::mc "To authenticate, pick a secret known\
                                         only to you and your peer. Enter this\
                                         secret, then wait for your peer to\
                                         enter it too. If the secrets don't\
                                         match then you may be talking to an\
                                         imposter."] \
                              -width 12c]
    grid $m2 -row 0 -column 0 -sticky nswe
    set l3 [Label $pf2.l3 \
                  -text [::msgcat::mc "Enter secret here (case sensitive):"]]
    grid $l3 -row 1 -column 0 -sticky nsw
    set e3 [Entry $pf2.e3]
    grid $e3 -row 2 -column 0 -sticky nswe
    Progressbar $pf2.pb \
            -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
    grid $pf2.pb -row 3 -column 0 -sticky ew
    set l4 [Label $pf2.l4 \
            -textvariable [namespace current]::ctx(status,$xlib,$jid)]
    grid $l4 -row 4 -column 0

    set ctx(progress,$xlib,$jid) 0
    set ctx(status,$xlib,$jid) ""
    set ctx(smpdialog,$xlib,$jid) $w

    $pm add mfv
    set pf3 [$pm getframe mfv]
    set m3 [Message $pf3.instr \
                    -text [::msgcat::mc "To verify the fingerprint, contact\
                                         your peer via some other\
                                         authenticated channel, such as the\
                                         phone or GPG-signed email. Each of\
                                         you should tell your fingerprint to\
                                         the other. if everything matches up,\
                                         you should indicate in this dialog\
                                         that you have verified the\
                                         fingerprint."] \
                              -width 12c]
    grid $m3 -row 0 -column 0 -columnspan 2 -sticky nswe
    set m4 [Message $pf3.mefp \
                    -text [::msgcat::mc "Fingerprint for you, %s:\n%s" \
                                    [connection_jid $xlib] \
                                    [::otr::fingerprint $ctx($xlib,$jid) 1]] \
                              -width 12c]
    grid $m4 -row 1 -column 0 -columnspan 2 -sticky nswe
    set m5 [Message $pf3.hefp \
                    -text [::msgcat::mc "Purported fingerprint for %s:\n%s" \
                                    $jid \
                                    [::otr::fingerprint $ctx($xlib,$jid) 0]] \
                              -width 12c]
    grid $m5 -row 2 -column 0 -columnspan 2 -sticky nswe
    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
    set tjid [peer_jid $xlib $jid]
    if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
        set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have not verified"]
    } else {
        set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have verified"]
    }
    tk_optionMenu $pf3.ihave [namespace current]::ctx(ihave,$xlib,$jid) \
                         [::msgcat::mc "I have not verified"] \
                         [::msgcat::mc "I have verified"]
    grid $pf3.ihave -row 3 -column 0 -sticky nwe
    set m6 [Message $pf3.ver -text [::msgcat::mc "that this is in fact the\
                                                  correct fingerprint for %s" \
                                                  $jid] \
                             -width 8c]
    grid $pf3.ver -row 3 -column 1 -sticky nw
    grid columnconfigure $pf3 0 -minsize 4c

    $pm compute_size
    $pm raise qa

    $w draw
}

proc otr::clear_dialog {xlib jid} {
    variable ctx

    unset -nocomplain ctx(status,$xlib,$jid)
    unset -nocomplain ctx(progress,$xlib,$jid)
    unset -nocomplain ctx(authmethod,$xlib,$jid)
    unset -nocomplain ctx(ihave,$xlib,$jid)
    unset -nocomplain ctx(smpdialog,$xlib,$jid)
}

proc otr::add_to_clipboard {xlib jid} {
    variable ctx

    clipboard clear
    if {![once_only $xlib $jid]} return

    clipboard append [::otr::fingerprint $ctx($xlib,$jid) 1]
    clipboard append \n
    clipboard append [::otr::fingerprint $ctx($xlib,$jid) 0]
}

proc otr::smp_dialog_switch_page {w xlib jid name1 name2 op} {
    variable ctx

    set f [$w getframe]
    set pm $f.method

    if {$ctx(authmethod,$xlib,$jid) eq [::msgcat::mc "Question and answer"]} {
        $pm raise qa
    } elseif {$ctx(authmethod,$xlib,$jid) eq [::msgcat::mc "Shared secret"]} {
        $pm raise ss
    } else {
        $pm raise mfv
    }
}

proc otr::begin_smp {w xlib jid} {
    variable ctx

    if {$ctx(msgstate,$xlib,$jid) ne "MSGSTATE_ENCRYPTED"} {
        MessageDlg .beginsmperr -aspect 50000 -icon error \
            -message [::msgcat::mc "You cannot verify the peer's identity\
                                    using SMP\nif an OTR session is not in\
                                    progress"] \
            -type user -buttons ok -default 0 -cancel 0
        return
    }

    if {$ctx(smpstate,$xlib,$jid) ne "SMPSTATE_EXPECT1"} {
        MessageDlg .beginsmperr -aspect 50000 -icon error \
            -message [::msgcat::mc "SMP verification is in progress. If you\
                                    want to start new one, abort the current\
                                    one first"] \
            -type user -buttons ok -default 0 -cancel 0
        return
    }

    $w itemconfigure 0 -state disabled
    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]

    set f [$w getframe]
    set pm $f.method

    $f.choice configure -state disabled

    set page [$pm raise]

    set pf [$pm getframe $page]
    switch -- $page {
        qa  {
            $pf.e1:cmd configure -state readonly
            $pf.e2:cmd configure -state readonly
            set secret [$pf.e2 get]
            set question [list -question [$pf.e1 get]]
        }
        ss  {
            $pf.e3:cmd configure -state readonly
            set secret [$pf.e3 get]
            set question {}
        }
        mfv {
            if {$ctx(ihave,$xlib,$jid) eq [::msgcat::mc "I have verified"]} {
                set val 1
            } else {
                set val 0
            }
            set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
            set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
            set tjid [peer_jid $xlib $jid]
            auth::set_auth auth::Auth $myjid $tjid $fingerprint $val
            auth::store $auth::Auth
            foreach idx [array names ctx msgstate,$xlib,*] {
                regexp {msgstate,[^,]*,(.*)} $idx -> fjid
                if {[peer_jid $xlib $fjid] eq $tjid} {
                    on_msgstate_change $xlib $fjid $ctx($idx)
                }
            }
            destroy $w
            return
        }
    }

    ::otr::startSMP $ctx($xlib,$jid) $secret {*}$question
}

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

proc otr::reply_smp_dialog_qa {xlib jid question} {
    variable ctx

    set w .otrreplauth[jid_to_tag $jid]

    Dialog $w -title [::msgcat::mc "Authentication from %s" \
                                   [peer_jid $xlib $jid]] \
              -anchor e -default 0 -cancel 1

    wm resizable $w 0 0

    $w add -text [::msgcat::mc "Authenticate"] \
           -command [namespace code [list reply_smp $w $xlib $jid]]
    $w add -text [::msgcat::mc "Cancel"] \
           -command [list destroy $w]

    bind $w <Destroy> [namespace code [clear_dialog [double% $xlib] \
                                                    [double% $jid]]]

    set f [$w getframe]

    set m [Message $f.header \
                   -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
                                        a peer helps ensure that\
                                        the person you are talking to is who\
                                        he or she claims to be." \
                                       $jid] \
                             -width 12c]
    grid $m -row 1 -column 0 -sticky nswe

    set m1 [Message $f.instr \
                    -text [::msgcat::mc "Your peer is attempting to determine\
                                         if he or she is really talking to\
                                         you, or if it's someone pretending to\
                                         be you. Your peer has asked a\
                                         question, indicated below. To\
                                         authenticate to your peer, enter the\
                                         answer and click 'Authenticate'."] \
                              -width 12c]
    grid $m1 -row 2 -column 0 -sticky nswe
    set l1 [Label $f.l1 -text [::msgcat::mc "This is the question asked by\
                                             your peer:"]]
    grid $l1 -row 3 -column 0 -sticky nsw
    set m2 [Message $f.m2 -text $question -width 12c]
    grid $m2 -row 4 -column 0 -sticky nsw
    set l2 [Label $f.l2 -text [::msgcat::mc "Enter secret answer here (case\
                                             sensitive):"]]
    grid $l2 -row 5 -column 0 -sticky nsw
    set e1 [Entry $f.e1]
    grid $e1 -row 6 -column 0 -sticky nswe
    Progressbar $f.pb \
            -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
    grid $f.pb -row 7 -column 0 -sticky ew
    set l4 [Label $f.l4 \
            -textvariable [namespace current]::ctx(status,$xlib,$jid)]
    grid $l4 -row 8 -column 0

    set ctx(progress,$xlib,$jid) 0
    set ctx(status,$xlib,$jid) ""
    set ctx(smpdialog,$xlib,$jid) $w

    $w draw
}

proc otr::reply_smp_dialog_ss {xlib jid} {
    variable ctx

    set w .otrreplauth[jid_to_tag $jid]

    Dialog $w -title [::msgcat::mc "Authentication from %s" \
                                   [peer_jid $xlib $jid]] \
              -anchor e -default 0 -cancel 1

    wm resizable $w 0 0

    $w add -text [::msgcat::mc "Authenticate"] \
           -command [namespace code [list reply_smp $w $xlib $jid]]
    $w add -text [::msgcat::mc "Cancel"] \
           -command [list destroy $w]

    bind $w <Destroy> [namespace code [clear_dialog [double% $xlib] \
                                                    [double% $jid]]]

    set f [$w getframe]

    set m [Message $f.header \
                   -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
                                        a peer helps ensure that the person\
                                        you are talking to is who he\
                                        or she claims to be." \
                                       $jid] \
                             -width 12c]
    grid $m -row 1 -column 0 -sticky nswe

    set m2 [Message $f.instr \
                    -text [::msgcat::mc "Your peer is attempting to determine\
                                         if he or she is really talking to\
                                         you, or if it's someone pretending to\
                                         be you. Your peer has picked a secret\
                                         known only to him or her and you. To\
                                         authenticate to your peer, enter this\
                                         secret and click 'Authenticate'."] \
                              -width 12c]
    grid $m2 -row 2 -column 0 -sticky nswe
    set l3 [Label $f.l3 -text [::msgcat::mc "Enter secret here (case\
                                             sensitive):"]]
    grid $l3 -row 3 -column 0 -sticky nsw
    set e1 [Entry $f.e1]
    grid $e1 -row 4 -column 0 -sticky nswe
    Progressbar $f.pb \
            -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
    grid $f.pb -row 5 -column 0 -sticky ew
    set l4 [Label $f.l4 \
            -textvariable [namespace current]::ctx(status,$xlib,$jid)]
    grid $l4 -row 6 -column 0

    set ctx(status,$xlib,$jid) ""
    set ctx(progress,$xlib,$jid) 0
    set ctx(smpdialog,$xlib,$jid) $w

    $w draw
}

proc otr::reply_smp {w xlib jid} {
    variable ctx

    if {$ctx(msgstate,$xlib,$jid) ne "MSGSTATE_ENCRYPTED"} {
        MessageDlg .beginsmperr -aspect 50000 -icon error \
            -message [::msgcat::mc "You cannot verify the peer's identity\
                                    using SMP\nif an OTR session is not in\
                                    progress"] \
            -type user -buttons ok -default 0 -cancel 0
        return
    }

    if {$ctx(smpstate,$xlib,$jid) ne "SMPSTATE_EXPECT1"} {
        MessageDlg .beginsmperr -aspect 50000 -icon error \
            -message [::msgcat::mc "SMP verification is in progress. If you\
                                    want to start new one, abort the current\
                                    one first"] \
            -type user -buttons ok -default 0 -cancel 0
        return
    }

    $w itemconfigure 0 -state disabled
    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]

    set f [$w getframe]
    $f.e1:cmd configure -state readonly
    set secret [$f.e1 get]

    ::otr::replySMP $ctx($xlib,$jid) $secret
}

proc otr::abort_smp {w xlib jid} {
    variable ctx

    ::otr::abortSMP $ctx($xlib,$jid)

    destroy $w
}

proc otr::result_smp {w xlib jid} {
    if {![winfo exists $w]} return

    $w itemconfigure 0 -state normal -text [::msgcat::mc "OK"] \
                       -command [list destroy $w]
    $w itemconfigure 1 -state disabled -command [list destroy $w]
}

proc otr::progress_smp {xlib jid progress} {
    variable ctx

    if {![info exists ctx(smpdialog,$xlib,$jid)]} return

    set w $ctx(smpdialog,$xlib,$jid)

    switch -- $progress {
        SMP_PROGRESS {
            incr ctx(progress,$xlib,$jid)
        }
        SMP_ABORT {
            set ctx(progress,$xlib,$jid) 3
            set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication aborted"]
            result_smp $w $xlib $jid
        }
        SMP_CHEATING {
            set ctx(progress,$xlib,$jid) 3
            set ctx(status,$xlib,$jid) [::msgcat::mc "Protocol error"]
            result_smp $w $xlib $jid
        }
        SMP_SUCCESS {
            set ctx(progress,$xlib,$jid) 3
            set ctx(status,$xlib,$jid) \
                [::msgcat::mc "Authentication succeeded"]
            result_smp $w $xlib $jid

            set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
            set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
            set tjid [peer_jid $xlib $jid]
            auth::set_auth auth::Auth $myjid $tjid $fingerprint 1
            auth::store $auth::Auth
            foreach idx [array names ctx msgstate,$xlib,*] {
                regexp {msgstate,[^,]*,(.*)} $idx -> fjid
                if {[peer_jid $xlib $fjid] eq $tjid} {
                    on_msgstate_change $xlib $fjid $ctx($idx)
                }
            }
        }
        SMP_FAILURE {
            set ctx(progress,$xlib,$jid) 3
            set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication failed"]
            result_smp $w $xlib $jid

            set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
            set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
            set tjid [peer_jid $xlib $jid]
            auth::set_auth auth::Auth $myjid $tjid $fingerprint 0
            auth::store $auth::Auth
            foreach idx [array names ctx msgstate,$xlib,*] {
                regexp {msgstate,[^,]*,(.*)} $idx -> fjid
                if {[peer_jid $xlib $fjid] eq $tjid} {
                    on_msgstate_change $xlib $fjid $ctx($idx)
                }
            }
        }
    }
}

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

proc otr::rewrite_message_body \
     {vxlib vfrom vid vtype vis_subject vsubject vbody
      verr vthread vpriority vx} {
    upvar 2 $vxlib xlib
    upvar 2 $vfrom from
    upvar 2 $vtype type
    upvar 2 $vbody body
    upvar 2 $verr err
    upvar 2 $vx x
    variable ns
    variable ctx

    # Work only in chats and normal messages
    if {$type ne "" && $type ne "normal" && $type ne "chat"} return

    # We can't distinguish between bodyless message and message with empty
    # body, so be it
    if {$body eq ""} return

    if {![once_only $xlib $from]} {
        if {![catch {::otr::data::binaryMessageFragment $body}] || \
                ![catch {::otr::data::binaryMessage $body}]} {
            show_info $xlib $from \
                      [::msgcat::mc "%s have sent you an OTR encrypted\
                                     message, but you can't decipher it\
                                     because you don't have your OTR private\
                                     key configured." $from]
            set body ""
        } elseif {![catch {::otr::data::findQueryMessage $body}]} {
            show_info $xlib $from \
                      [::msgcat::mc "%s has requested an Off-the-Record\
                                     private conversation, but you can't\
                                     maintain it because you don't have\
                                     your OTR private key configured." $from]
            set body ""
        }
        return
    }

    set result [::otr::incomingMessage $ctx($xlib,$from) $body]

    debugmsg otr "INCOMING MESSAGE: $xlib; $from; $result;"

    array set res $result

    if {[info exists res(message)]} {
        set body $res(message)
        if {[info exists res(warn)]} {
            lappend x [::xmpp::xml::create "" \
                                -xmlns $ns \
                                -attrs {icon otr/notprivate}]
        } elseif {[msgstate:index $xlib $from] != 0} {
            lappend x [::xmpp::xml::create "" \
                                -xmlns $ns \
                                -attrs [list icon [msgstate:icon $xlib $from]]]
        }
    } else {
        lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {discard 1}]
    }

    if {[info exists res(question)]} {
        after idle [namespace code [list reply_smp_dialog_qa \
                                         $xlib $from $res(question)]]
    }

    if {[info exists res(secret)]} {
        after idle [namespace code [list reply_smp_dialog_ss \
                                         $xlib $from]]
    }
    return
}

hook::add rewrite_message_hook \
          [namespace current]::otr::rewrite_message_body 80

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

proc otr::discard_message {xlib from id type is_subject \
                           subject body err thread priority x} {
    variable ns

    foreach xel $x {
        ::xmpp::xml::split $xel tag xmlns attrs cdata subels

        if {$tag eq "" && $xmlns eq $ns && \
                [::xmpp::xml::getAttr $attrs discard] == 1} {
            return -code break
        }
    }
    return
}

hook::add process_message_hook [namespace current]::otr::discard_message 0.1

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

proc otr::store_original_message_body \
     {vxlib vto vid vtype vsubject vbody verr vthread vx} {
    upvar 2 $vxlib xlib
    upvar 2 $vto to
    upvar 2 $vtype type
    upvar 2 $vbody body
    variable ctx

    if {![info exists body]} return
    if {![info exists ctx($xlib,$to)]} return

    set ctx(original_message_body,$xlib,$to) $body
}

hook::add rewrite_outgoing_message_hook \
          [namespace current]::otr::store_original_message_body 1

proc otr::rewrite_outgoing_message_body \
     {vxlib vto vid vtype vsubject vbody verr vthread vx} {
    variable ctx
    upvar 2 $vtype type

    # Only chat and normal messages are subject to OTR
    if {[info exists type] &&
        $type ne "" && $type ne "normal" && $type ne "chat"} return

    # Only messages with body are subject to OTR
    upvar 2 $vbody body

    if {![info exists body]} return

    upvar 2 $vxlib xlib
    upvar 2 $vto to

    if {![once_only $xlib $to]} return

    # Disable sending the message in case of error in the OTR code
    hook::unset_flag rewrite_outgoing_message_hook send

    # Only the message body is encrypted if appropriate
    set result [::otr::outgoingMessage $ctx($xlib,$to) $body]

    debugmsg otr "OUTGOING MESSAGE: $xlib; $to; $result;"

    array set res $result

    if {[info exists res(store)] && $res(store)} {
        upvar 2 $vid id
        upvar 2 $vsubject subject
        upvar 2 $verr err
        upvar 2 $vthread thread
        upvar 2 $vx x

        foreach v {id type subject err thread x} {
            if {[info exists $v]} {
                set is$v 1
                set n$v [set $v]
            } else {
                set is$v 0
                set n$v ""
            }
        }

        store $xlib $to $isid $nid $istype $ntype $issubject $nsubject \
              1 $ctx(original_message_body,$xlib,$to) \
              $iserr $nerr $isthread $nthread $isx $nx
    }

    if {[info exists res(message)]} {
        # Enable sending the message back
        hook::set_flag rewrite_outgoing_message_hook send

        set body $res(message)
    } else {
        # Don't show this message in the chat log window
        # This flag makes sense only for chat messages, but causes no harm for
        # normal ones
        hook::unset_flag chat_send_message_hook draw
    }
    return
}

hook::add rewrite_outgoing_message_hook \
          [namespace current]::otr::rewrite_outgoing_message_body 10

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

proc otr::disable_log {chatid from type body x} {
    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    if {[log_is_disabled $xlib $jid]} {
        hook::unset_flag draw_message_hook log
    }
    return
}

hook::add draw_message_hook [namespace current]::otr::disable_log 10

proc otr::disable_archive_in \
     {xlib from id type is_subject subject body err thread priority x} {
    if {[log_is_disabled $xlib $from]} {
        hook::unset_flag process_message_hook log
    }
    return
}

hook::add process_message_hook [namespace current]::otr::disable_archive_in 10

proc otr::disable_archive_out {xlib to subject body thread} {
    if {[log_is_disabled $xlib $to]} {
        hook::unset_flag send_normal_message_hook log
    }
    return
}

hook::add send_normal_message_hook \
          [namespace current]::otr::disable_archive_out 10

proc otr::log_is_disabled {xlib jid} {
    variable options
    variable ctx

    if {![info exists ctx($xlib,$jid)]} {
        return 0
    }

    set njid [::xmpp::jid::normalize $jid]

    switch -- $ctx(msgstate,$xlib,$jid) {
        MSGSTATE_ENCRYPTED {
            if {[info exists options(dont-log-otr-messages,$xlib,$njid)]} {
                return $options(dont-log-otr-messages,$xlib,$njid)
            } else {
                return $options(dont-log-otr-messages)
            }
        }
    }
    return 0
}

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

proc otr::msgstate:trace {script xlib jid} {
    variable trace

    if {![info exists trace(msgstate,$xlib,$jid)]} {
        set trace(msgstate,$xlib,$jid) {}
    }

    if {[list write [namespace current]::trace] ni
            [trace info variable \
                   [namespace current]::ctx(msgstate,$xlib,$jid)]} {
        trace add variable \
              [namespace current]::ctx(msgstate,$xlib,$jid) write \
              [namespace current]::tracevar
    }

    if {$script ne {} && ($script ni $trace(msgstate,$xlib,$jid))} {
        lappend trace(msgstate,$xlib,$jid) $script
    }
}

proc otr::tracevar {name1 name2 op} {
    variable trace

    set new {}
    foreach script $trace($name2) {
        if {[catch { {*}$script } result]} {
            debugmsg otr "$result -- $script"
        } else {
            lappend new $script
        }
    }
    set trace($name2) $new
}

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

proc otr::message_button {mw xlib jid} {
    set bbox [ButtonBox $mw.bottom.otrbutton -spacing 0]

    set b [$bbox add \
                 -image [msgstate:icon $xlib $jid] \
                 -helptype balloon \
                 -helptext [msgstate:helptext $xlib $jid] \
                 -relief link \
                 -state [msgstate:enabled $xlib $jid] \
                 -command [namespace code [list toggle_session $xlib $jid ""]]]

    msgstate:trace \
            [list [namespace current]::msgstate:button_conf $b $xlib $jid] \
            $xlib $jid

    pack $bbox -side left -fill x -padx 2m -pady 2m
}

hook::add open_message_post_hook [namespace current]::otr::message_button 55

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

proc otr::chat_window_button {chatid type} {
    if {$type ne "chat"} {
        return
    }

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    set cw [chat::winid $chatid]

    set b [Button $cw.status.otrmsgstate \
                  -relief link \
                  -image [msgstate:icon $xlib $jid] \
                  -helptype balloon \
                  -helptext [msgstate:helptext $xlib $jid] \
                  -state [msgstate:enabled $xlib $jid] \
                  -command [namespace code [list toggle_session \
                                                 $xlib $jid $type]]]

    msgstate:trace \
            [list [namespace current]::msgstate:button_conf $b $xlib $jid] \
            $xlib $jid

    pack $b -side left -before $cw.status.mb
}

hook::add open_chat_post_hook [namespace current]::otr::chat_window_button 55

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

proc otr::msgstate:button_conf {b xlib jid} {
    $b configure -image [msgstate:icon $xlib $jid] \
                 -helptext [msgstate:helptext $xlib $jid] \
                 -state [msgstate:enabled $xlib $jid]
}

proc otr::msgstate:icon {xlib jid} {
    lindex [list otr/notprivate \
                 otr/unverified \
                 otr/private \
                 otr/finished] \
           [msgstate:index $xlib $jid]
}

proc otr::msgstate:helptext {xlib jid} {
    variable ctx

    set text [::msgcat::mc "State:"]
    append text " " [msgstate:state $xlib $jid]
    switch -- [msgstate:index $xlib $jid] {
        1 - 2 {
            append text \n [::msgcat::mc "Fingerprint:"] " " \
                        [::otr::fingerprint $ctx($xlib,$jid)] \
                        \n [::msgcat::mc "SSID:"] " " \
                        [::otr::ssid $ctx($xlib,$jid)]
        }
    }
    set text
}

proc otr::msgstate:state {xlib jid} {
    lindex [list [::msgcat::mc "Not private"] \
                 [::msgcat::mc "Unverified"] \
                 [::msgcat::mc "Private"] \
                 [::msgcat::mc "Finished"]] \
           [msgstate:index $xlib $jid]
}

proc otr::msgstate:index {xlib jid} {
    variable ctx

    if {[info exists ctx($xlib,$jid)]} {
        switch -- $ctx(msgstate,$xlib,$jid) {
            MSGSTATE_PLAINTEXT {
                return 0
            }
            MSGSTATE_ENCRYPTED {
                set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
                set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
                set tjid [peer_jid $xlib $jid]
                if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
                    return 1
                } else {
                    return 2
                }
            }
            MSGSTATE_FINISHED {
                return 3
            }
        }
    }
    return 0
}

proc otr::msgstate:enabled {xlib jid} {
    if {[lsearch -exact [connections] $xlib] < 0
            || [::xmpp::jid::equal [my_jid $xlib $jid] $jid]
            || ![once_only $xlib $jid]} {
        return disabled
    } else {
        return normal
    }
}

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

proc otr::enable_disable_buttons {xlib} {
    variable ctx

    foreach chatid [chat::opened $xlib] {
        set jid [chat::get_jid $chatid]
        if {[info exists ctx(msgstate,$xlib,$jid)]} {
            on_msgstate_change $xlib $jid $ctx(msgstate,$xlib,$jid)
        } else {
            on_msgstate_change $xlib $jid MSGSTATE_PLAINTEXT
        }
    }
}

hook::add connected_hook [namespace current]::otr::enable_disable_buttons
hook::add disconnected_hook [namespace current]::otr::enable_disable_buttons

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

proc otr::user_popup_info {infovar xlib jid} {
    variable ctx

    upvar 0 $infovar info

    if {[info exists ctx($xlib,$jid)]} {
        append info [::msgcat::mc "\n\tOTR:"]
        append info \
               [regsub -all {\n} \n[msgstate:helptext $xlib $jid] "\n\t    "]
    }
}

hook::add roster_user_popup_info_hook \
          [namespace current]::otr::user_popup_info 99

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

proc otr::userinfo {tab xlib jid editable} {
    variable ctx

    if {$editable} return

    set bjid [::xmpp::jid::removeResource $jid]
    set chatid [chat::chatid $xlib $bjid]
    if {[chat::is_groupchat $chatid]} {
        if {[info exists ctx(authstate,$xlib,$jid)]} {
            set jids [list authstate,$xlib,$jid]
        } else {
            set jids [list]
        }
    } else {
        set bjpat [regsub -all {(.)} $bjid {\\\1}]
        set jids [array names ctx authstate,$xlib,$bjpat/*]
    }
    if {[llength $jids] > 0} {
        set otrinfo [$tab insert end otrinfo \
                              -text [::msgcat::mc "OTR"]]

        set sw [ScrolledWindow $otrinfo.sw -scrollbar vertical]
        pack $sw -fill both -expand yes
        set sf [ScrollableFrame $otrinfo.sf -constrainedwidth 1]
        $sw setwidget $sf

        set i 0
        foreach j $jids {
            regexp {authstate,[^,]*,(.*)} $j -> fjid
            set x [userinfo::pack_frame [$sf getframe].otr_$i $fjid]

            userinfo::pack_entry $jid $x 1 otr_state_$i [::msgcat::mc "State:"]
            set ::userinfo::userinfo(otr_state_$i,$jid) \
                [msgstate:state $xlib $fjid]

            userinfo::pack_entry $jid $x 2 otr_fingerprint_$i \
                                 [::msgcat::mc "Fingerprint:"]
            set ::userinfo::userinfo(otr_fingerprint_$i,$jid) \
                [::otr::fingerprint $ctx($xlib,$fjid)]

            userinfo::pack_entry $jid $x 3 otr_ssid_$i [::msgcat::mc "SSID:"]
            set ::userinfo::userinfo(otr_ssid_$i,$jid) \
                [::otr::ssid $ctx($xlib,$fjid)]

            bindscrolldeep $sf $sf
            incr i
        }
    }
}

hook::add userinfo_hook [namespace current]::otr::userinfo 90

proc otr::bindscrolldeep {w f} {
    bindscroll $w $f
    foreach sw [winfo children $w] {
        bindscrolldeep $sw $f
    }
}

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

proc otr::main_menu {} {
    variable options

    catch {
        set m [.mainframe getmenu tkabber]
        set ind [$m index [::msgcat::mc "View"]]
        incr ind -1

        set mm .otr_menu
        menu $mm -tearoff $::ifacetk::options(show_tearoffs)
        $mm add command -label [::msgcat::mc "Manage private keys"] \
            -command [namespace code key::manage_keys_dialog]
        $mm add command -label [::msgcat::mc "Edit authentication"] \
            -command [namespace code auth::edit_auth_dialog]
        $mm add separator
        $mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
            -variable [namespace current]::options(allow-encryption)
        $mm add checkbutton -label [::msgcat::mc "Require encryption"] \
            -variable [namespace current]::options(require-encryption)
        $mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
            -variable [namespace current]::options(send-whitespace-tag)
        $mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag\
                                                  or OTR error"] \
            -variable \
                [namespace current]::options(whitespace-or-error-start-ake)
        $mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
            -variable [namespace current]::options(dont-log-otr-messages)

        $m insert $ind cascade -label [::msgcat::mc "OTR"] \
            -menu $mm
    }
}

hook::add finload_hook [namespace current]::otr::main_menu 55

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

proc otr::user_menu {type m xlib jid} {
    variable options
    variable ctx

    set njid [::xmpp::jid::normalize $jid]

    foreach key {allow-encryption require-encryption send-whitespace-tag
                 whitespace-or-error-start-ake dont-log-otr-messages} {
        if {![info exists options($key,$xlib,$njid)]} {
            set options($key,$xlib,$njid) $options($key)
        }
    }

    if {[::xmpp::jid::equal [my_jid $xlib $jid] $jid] ||
                    ![once_only $xlib $jid]} {
        set state disabled
        set qstate disabled
        set rstate disabled
        set fstate disabled
        set astate disabled
    } else {
        switch -- $ctx(msgstate,$xlib,$jid) {
            MSGSTATE_PLAINTEXT {
                set qstate normal
                set rstate disabled
                set fstate disabled
                set astate disabled
            }
            MSGSTATE_ENCRYPTED {
                set qstate disabled
                set rstate normal
                set fstate normal
                set astate normal
            }
            MSGSTATE_FINISHED {
                set qstate disabled
                set rstate normal
                set fstate normal
                set astate disabled
            }
        }
    }

    if {![info exists state] && [lsearch -exact [connections] $xlib] >= 0} {
        set state normal
    } else {
        set state disabled
    }

    set mm $m.otr_menu
    menu $mm -tearoff 0
    $mm add command -label [::msgcat::mc "Start OTR session"] \
        -command [list [namespace current]::request_session $xlib $jid $type] \
        -state $qstate
    $mm add command -label [::msgcat::mc "Refresh OTR session"] \
        -command [list [namespace current]::request_session $xlib $jid $type] \
        -state $rstate
    $mm add command -label [::msgcat::mc "End OTR session"] \
        -command [list [namespace current]::finish_session $xlib $jid $type] \
        -state $fstate
    $mm add separator
    $mm add command -label [::msgcat::mc "Authenticate peer..."] \
        -command [list [namespace current]::begin_smp_dialog $xlib $jid] \
        -state $astate
    $mm add separator
    $mm add command -label [::msgcat::mc "Reset to default policy"] \
        -command [list [namespace current]::reset_policy $xlib $jid]
    $mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
        -variable [namespace current]::options(allow-encryption,$xlib,$njid) \
        -command [list [namespace current]::update_policy $xlib $jid]
    $mm add checkbutton -label [::msgcat::mc "Require encryption"] \
        -variable \
            [namespace current]::options(require-encryption,$xlib,$njid) \
        -command [list [namespace current]::update_policy $xlib $jid]
    $mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
        -variable \
            [namespace current]::options(send-whitespace-tag,$xlib,$njid) \
        -command [list [namespace current]::update_policy $xlib $jid]
    $mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag or\
                                              OTR error"] \
        -variable \
      [namespace current]::options(whitespace-or-error-start-ake,$xlib,$njid) \
        -command [list [namespace current]::update_policy $xlib $jid]
    $mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
        -variable \
            [namespace current]::options(dont-log-otr-messages,$xlib,$njid) \
        -command [list [namespace current]::update_policy $xlib $jid]

    $m add cascade -label [::msgcat::mc "OTR"] -menu $mm -state $state
}

hook::add chat_create_user_menu_hook \
          [list [namespace current]::otr::user_menu chat] 43.8
hook::add roster_jid_popup_menu_hook \
          [list [namespace current]::otr::user_menu ""] 43.8
hook::add message_dialog_menu_hook \
          [list [namespace current]::otr::user_menu ""] 43.8
hook::add roster_create_groupchat_user_menu_hook \
          [list [namespace current]::otr::user_menu ""] 43.8

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