[Tkabber-dev] r2081 - in trunk/tkabber-plugins: . otr otr/tclotr

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Jan 23 18:41:17 MSK 2014


Author: sergei
Date: 2014-01-23 18:41:17 +0400 (Thu, 23 Jan 2014)
New Revision: 2081

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/otr/otr.tcl
   trunk/tkabber-plugins/otr/tclotr/message.tcl
   trunk/tkabber-plugins/otr/tclotr/otr.tcl
Log:
	* otr/otr.tcl, otr/tclotr/message.tcl, otr/tclotr/otr.tcl: Code
	  cleanup. Moved most of the interaction with the calling program to
	  callbacks. Fixed OTR labels for incoming chat messages. Disabled
	  some OTR menu items depending on the current message state.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-22 18:11:33 UTC (rev 2080)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-23 14:41:17 UTC (rev 2081)
@@ -1,3 +1,10 @@
+2014-01-23  Sergei Golovan <sgolovan at nes.ru>
+
+	* otr/otr.tcl, otr/tclotr/message.tcl, otr/tclotr/otr.tcl: Code
+	  cleanup. Moved most of the interaction with the calling program to
+	  callbacks. Fixed OTR labels for incoming chat messages. Disabled
+	  some OTR menu items depending on the current message state.
+
 2014-01-22  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/auth.tcl, otr/otr.tcl, otr/tclotr/otr.tcl: Store the

Modified: trunk/tkabber-plugins/otr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/otr.tcl	2014-01-22 18:11:33 UTC (rev 2080)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-23 14:41:17 UTC (rev 2081)
@@ -122,39 +122,32 @@
     variable ns
     variable ctx
 
+    if {$type ne "chat"} return
+
     set xlib [chat::get_xlib $chatid]
-    set chatw [chat::chat_win $chatid]
+    set jid [chat::get_jid $chatid]
 
-    once_only $xlib $from
+    if {![::xmpp::jid::equal $jid $from]} return
 
-    switch -- $ctx(msgstate,$xlib,$from) {
-	MSGSTATE_PLAIN {
-	    foreach xe $x {
-		::xmpp::xml::split $xe tag xmlns attrs cdata subels
+    foreach xe $x {
+	::xmpp::xml::split $xe tag xmlns attrs cdata subels
 
-		if {$tag eq "" && $xmlns eq $ns} {
-		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
-			$chatw image create end -image otr/notprivate
+	if {$tag eq "" && $xmlns eq $ns} {
+	    set chatw [chat::chat_win $chatid]
+	    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
+		$chatw image create end -image otr/notprivate
+	    } else {
+		once_only $xlib $from
+		switch -- $ctx(msgstate,$xlib,$from) {
+		    MSGSTATE_ENCRYPTED -
+		    MSGSTATE_FINISHED {
+			$chatw image create end \
+			       -image [msgstate:icon $xlib $from]
 		    }
-		    break
 		}
 	    }
+	    break
 	}
-	MSGSTATE_ENCRYPTED -
-	MSGSTATE_FINISHED {
-	    foreach xe $x {
-		::xmpp::xml::split $xe tag xmlns attrs cdata subels
-
-		if {$tag eq "" && $xmlns eq $ns} {
-		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
-			$chatw image create end -image otr/notprivate
-		    } else {
-			$chatw image create end -image otr/unverified
-		    }
-		    break
-		}
-	    }
-	}
     }
 }
 
@@ -168,49 +161,31 @@
     upvar 2 $rowvar row
     upvar 2 $bodyvar body
 
-    if {$type == "error"} {
-	return
-    }
+    if {$type eq "error" || $type eq "groupchat" || $type eq "headline"} return
 
-    once_only $xlib $from
+    if {$body eq ""} return
 
-    switch -- $ctx(msgstate,$xlib,$from) {
-	MSGSTATE_PLAIN {
-	    foreach xe $x {
-		::xmpp::xml::split $xe tag xmlns attrs cdata subels
+    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
-		    }
-		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
-			Label $lb -image otr/notprivate
-			grid $lb -row 1 -column 4 -sticky e
-		    }
-		    break
-		}
+	if {$tag eq "" && $xmlns eq $ns} {
+	    set lb [join [lrange [split $f .] 0 end-1] .].title.otrmsgstate
+	    if {[winfo exists $lb]} {
+		destroy $lb
 	    }
-	}
-	MSGSTATE_ENCRYPTED -
-	MSGSTATE_FINISHED {
-	    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
+	    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
+		Label $lb -image otr/notprivate
+	    } else {
+		once_only $xlib $from
+		switch -- $ctx(msgstate,$xlib,$from) {
+		    MSGSTATE_ENCRYPTED -
+		    MSGSTATE_FINISHED {
+			Label $lb -image [msgstate:icon $xlib $from]
 		    }
-		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
-			Label $lb -image otr/notprivate
-		    } else {
-			Label $lb -image otr/unverified
-		    }
-		    grid $lb -row 1 -column 4 -sticky e
-		    break
 		}
 	    }
+	    grid $lb -row 1 -column 4 -sticky e
+	    break
 	}
     }
 }
@@ -225,9 +200,7 @@
 
     debugmsg otr "ONCE_ONLY $xlib $jid"
 
-    if {[info exists ctx($xlib,$jid)] && $ctx($xlib,$jid) != ""} {
-        return
-    }
+    if {[info exists ctx($xlib,$jid)]} return
 
     set ctx($xlib,$jid) \
 	[::otr::new $::OTRPrivateKey \
@@ -235,7 +208,10 @@
 		-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]]]
+		-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]]]
 }
 
 #############################################################################
@@ -260,6 +236,37 @@
 
 #############################################################################
 
+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
+
+    # Dirty hack to recover message type
+    for {set i 1} {$i < 12} {incr i} {
+	upvar $i type type
+	if {[info exists type] && $type eq "chat"} break
+    }
+
+    if {[info exists type]} {
+	set targs [list -type $type]
+    } else {
+	set targs {}
+    }
+    ::xmpp::sendMessage $xlib $jid -body $message {*}$targs
+}
+
+#############################################################################
+
 proc otr::get_policy {xlib jid} {
     variable options
     variable PolicyFlags
@@ -393,18 +400,12 @@
 
     set lang [get_jid_presence_info lang $xlib $jid]
 
-    set result [::otr::requestConversation $ctx($xlib,$jid)]
-    array set res $result
-    if {[info exists res(body)]} {
-	append res(body) \n \
+    ::otr::requestConversation $ctx($xlib,$jid) \
 	    [format [::trans::trans $lang \
-		"%s has requested an Off-the-Record\ private conversation\
-		 <http://otr.cypherpunks.ca/>. However, you do not have a\
-		 plugin to support that.\nSee http://otr.cypherpunks.ca/\
-		 for more information."] [connection_jid $xlib]]
-    
-	::xmpp::sendMessage $xlib $jid -type $type -body $res(body)
-    }
+		    "%s has requested an Off-the-Record\ private conversation\
+		    <http://otr.cypherpunks.ca/>. However, you do not have a\
+		    plugin to support that.\nSee http://otr.cypherpunks.ca/\
+		    for more information."] [my_jid $xlib $jid]]]
 }
 
 proc otr::finish_session {xlib jid type} {
@@ -412,11 +413,7 @@
 
     once_only $xlib $jid
 
-    set result [::otr::finishConversation $ctx($xlib,$jid)]
-    array set res $result
-    if {[info exists res(body)]} {
-	::xmpp::sendMessage $xlib $jid -type $type -body $res(body)
-    }
+    ::otr::finishConversation $ctx($xlib,$jid)
 }
 
 #############################################################################
@@ -628,17 +625,12 @@
 	    auth::store $auth::Auth
 	    # TODO: change the icons for all chats with this jid
 	    on_msgstate_change $xlib $jid $ctx(msgstate,$xlib,$jid)
-	    $f.choice configure -state normal
-	    $w itemconfigure 0 -state normal
+	    destroy $w
 	    return
 	}
     }
 
-    set result [::otr::startSMP $ctx($xlib,$jid) $secret {*}$question]
-    array set res $result
-    if {[info exists res(body)]} {
-	::xmpp::sendMessage $xlib $jid -body $res(body)
-    }
+    ::otr::startSMP $ctx($xlib,$jid) $secret {*}$question
 }
 
 #############################################################################
@@ -771,23 +763,13 @@
     $f.e1 configure -state readonly
     set secret [$f.e1 get]
 
-    set result [::otr::replySMP $ctx($xlib,$jid) $secret]
-    array set res $result
-    if {[info exists res(body)]} {
-	::xmpp::sendMessage $xlib $jid -body $res(body)
-    }
+    ::otr::replySMP $ctx($xlib,$jid) $secret
 }
 
 proc otr::abort_smp {w xlib jid} {
     variable ctx
 
-    if {$ctx(msgstate,$xlib,$jid) eq "MSGSTATE_ENCRYPTED"} {
-	set result [::otr::abortSMP $ctx($xlib,$jid)]
-	array set res $result
-	if {[info exists res(body)]} {
-	    ::xmpp::sendMessage $xlib $jid -body $res(body)
-	}
-    }
+    ::otr::abortSMP $ctx($xlib,$jid)
 
     destroy $w
 }
@@ -865,47 +847,22 @@
     variable ctx
 
     # Work only in chats and normal messages
+    if {$type ne "" && $type ne "normal" && $type ne "chat"} return
 
-    if {$type ne "chat" && $type ne "normal"} return
-
     # We can't distinguish between bodyless message and message with empty
     # body, so be it
-
     if {$body eq ""} return
 
     once_only $xlib $from
 
     set result [::otr::incomingMessage $ctx($xlib,$from) $body] 
 
-    debugmsg otr "FILTER_INPUT: $xlib; $from; $result"
+    debugmsg otr "INCOMING MESSAGE: $xlib; $from; $result"
 
     array set res $result
 
-    if {[info exists res(reply)]} {
-	foreach message $res(reply) {
-	    set command [list ::xmpp::sendMessage $xlib $from -body $message]
-	    if {[info exists type]} {
-		lappend command -type $type
-	    } 
-	    {*}$command
-	}
-    }
-
-    if {[info exists res(error)]} {
-	set type error
-	set body ""
-	set err [::xmpp::stanzaerror::error otr none -text $res(error)]
-	return
-    }
-
-    if {[info exists res(info)]} {
-	set type info
-	set body "OTR Info: $res(info)"
-	return
-    }
-
-    if {[info exists res(body)]} {
-	set body $res(body)
+    if {[info exists res(message)]} {
+	set body $res(message)
 	if {[info exists res(warn)]} {
 	    lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {warn 1}]
 	} else {
@@ -968,35 +925,31 @@
     upvar 2 $vx x
     variable ctx
 
+    # Only chat and normal messages are subject to OTR
     if {[info exists type] &&
-	($type eq "groupchat" || $type eq "error" || $type eq "headline")} return
+	$type ne "" && $type ne "normal" && $type ne "chat"} return
 
+    # Only messages with body are subject to OTR
     if {![info exists body]} return
 
     once_only $xlib $to
 
     # Only the message body is encrypted if appropriate
-
     set result [::otr::outgoingMessage $ctx($xlib,$to) $body]
 
-    debugmsg otr "FILTER_OUTPUT: $xlib; $to; $result"
+    debugmsg otr "OUTGOING MESSAGE: $xlib; $to; $result"
 
     array set res $result
 
-    if {[info exists res(info)]} {
-	set chatid [::chat::chatid $xlib $to]
-	chat::add_message $chatid $to info $res(info) {}
-	hook::unset_flag chat_send_message_hook draw
-    }
-
-    if {[info exists res(body)]} {
-	set body $res(body)
+    if {[info exists res(message)]} {
+	set body $res(message)
     } else {
-	# Rewrite to JID to disable sending.
+	# Rewrite 'to' JID to disable sending
+	set to ""
 
-	set to ""
+	# Don't show this message in the chat log window
+	hook::unset_flag chat_send_message_hook draw
     }
-
 }
 
 hook::add rewrite_outgoing_message_hook \
@@ -1010,7 +963,8 @@
     if {![info exists trace(msgstate,$xlib,$jid)]} {
         set trace(msgstate,$xlib,$jid) {}
 
-        ::trace variable [namespace current]::ctx(msgstate,$xlib,$jid) w [namespace current]::trace
+        ::trace variable [namespace current]::ctx(msgstate,$xlib,$jid) w \
+			 [namespace current]::trace
     }
 
     lappend trace(msgstate,$xlib,$jid) $script
@@ -1222,6 +1176,7 @@
 
 proc otr::user_menu {type m xlib jid} {
     variable options
+    variable ctx
 
     if {[lsearch -exact [connections] $xlib] >= 0} {
 	set state normal
@@ -1237,17 +1192,44 @@
 	}
     }
 
+    once_only $xlib $jid
+
+    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
+	}
+    }
+
     set mm $m.otr_menu
     menu $mm -tearoff 0
-    $mm add command -label [::msgcat::mc "Request OTR session"] \
-	-command [list [namespace current]::request_session $xlib $jid $type]
+    $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]
-    $mm add command -label [::msgcat::mc "Finish OTR session"] \
-	-command [list [namespace current]::finish_session $xlib $jid $type]
+	-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]
+	-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]

Modified: trunk/tkabber-plugins/otr/tclotr/message.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-22 18:11:33 UTC (rev 2080)
+++ trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-23 14:41:17 UTC (rev 2081)
@@ -173,7 +173,7 @@
     if {$message eq ""} {
         set msg {}
     } else {
-        set msg [list body $message]
+        set msg [list message $message]
     }
 
     # Store the extra symmetric key usage info if it's present

Modified: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-22 18:11:33 UTC (rev 2080)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-23 14:41:17 UTC (rev 2081)
@@ -61,16 +61,24 @@
 # 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.
-#       -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)).
+#       -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.
@@ -85,22 +93,30 @@
         set id 0
     }
 
-    set policy {}
-    set authstatecommands {}
-    set msgstatecommands {}
-    set smpstatecommands {}
+    set policy    {}
+    set heartbeat 0
+    set maxsize   0
+    set authstatecommands   {}
+    set msgstatecommands    {}
+    set smpstatecommands    {}
     set smpprogresscommands {}
-    set heartbeat 0
-    set maxsize 0
+    set infocommands        {}
+    set errorcommands       {}
     foreach {key val} $args {
         switch -- $key {
-            -policy { set policy $val }
-            -authstatecommand { set authstatecommands [list $val] }
-            -msgstatecommand { set msgstatecommands [list $val] }
-            -smpstatecommand { set smpstatecommands [list $val] }
+            -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] }
-            -heartbeat { set heartbeat $val }
-            -maxsize { set maxsize $val }
+            -infocommand        { set infocommands        [list $val] }
+            -errorcommand       { set errorcommands       [list $val] }
+            default {
+                return -code error "Invalid option '$key'"
+            }
         }
     }
 
@@ -108,31 +124,40 @@
         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(AuthStateCommands) $authstatecommands
-    set state(MsgStateCommands) $msgstatecommands
-    set state(SMPStateCommands) $smpstatecommands
-    set state(SMPProgressCommands) $smpprogresscommands
-
-    set state(StoredMessages) {}
-    set state(PrivateKey) $privkey
-    set state(Policy) $policy
-    set state(HeartBeat) $heartbeat
-    set state(LastMessage) [clock seconds]
-    set state(MaxSize) $maxsize
-    set state(ReceivedPlaintext) 0
+    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) ""
+    set state(k) 0
+    set state(n) 0
+    set state(f) ""
 
     # Generate DH private keys (key management 1)
 
@@ -140,37 +165,66 @@
 
     # Track state changes
 
-    trace add variable ${token}(AuthState) write \
+    trace add variable ${token}(authstate) write \
                 [namespace code [list TrackAuthState $token]]
-    trace add variable ${token}(MsgState) write \
+    trace add variable ${token}(msgstate) write \
                 [namespace code [list TrackMsgState $token]]
-    trace add variable ${token}(SMPState) write \
+    trace add variable ${token}(smpstate) write \
                 [namespace code [list TrackSMPState $token]]
-    trace add variable ${token}(SMPProgress) write \
+    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 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(AuthState)]} return
+    if {![info exists state(privatekey)]} return
 
     if {[llength $args] == 0} {
         switch -- $key {
-            -policy { return $state(Policy) }
-            -heartbeat { return $state(HeartBeat) }
-            -maxsize { return $state(MaxSize) }
+            -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'"
+            }
         }
     }
 
@@ -182,13 +236,37 @@
                 return -code error "OTR version 1 is not supported"
             }
         
-            set state(Policy) $val
+            set state(policy) $val
         }
-        -heartbeat { set state(HeartBeat) $val }
-        -maxsize { set state(MaxSize) $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
@@ -196,238 +274,264 @@
     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::QueryPolicy {token item} {
+proc ::otr::fingerprint {token {me 0}} {
     variable $token
     upvar 0 $token state
 
-    expr {$item in $state(Policy)}
-}
+    if {$me} {
+        set key $state(privatekey)
+    } else {
+        set key $state(publickey)
+    }
 
-##############################################################################
-
-# ::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)"
-        }
+    binary scan [::otr::crypto::DSAFingerprint $key] Iu* nums
+    set res {}
+    foreach n $nums {
+        lappend res [format %X $n]
     }
+    join $res
 }
 
-##############################################################################
+# ::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} {
+proc ::otr::requestConversation {token {suffix ""}} {
     variable $token
     upvar $token state
 
-    list body [::otr::data::queryMessage $state(Policy)]
+    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_PLAINTEXT {
-            return {}
-        }
+    switch -- $state(msgstate) {
         MSGSTATE_ENCRYPTED {
             set message [CreateEncryptedMessage $token {} "" {1 ""}]
-            set state(MsgState) MSGSTATE_PLAINTEXT
+            CallBack $token send $message
             InitDHKeys $token
-            return [list body $message]
         }
-        MSGSTATE_FINISHED {
-            set state(MsgState) MSGSTATE_PLAINTEXT
-            return {}
-        }
     }
+    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
 
-    set question \x00
-    foreach {key val} $args {
-        switch -- $key {
-            -question {
-                set question $val
-            }
-        }
-    }
-
-    switch -- $state(MsgState) {
+    switch -- $state(msgstate) {
         MSGSTATE_ENCRYPTED {
-            lassign [CreateSMP1 $question $secret $token] \
-                    state(SMPState) state(SMPProgress) flags body tlvlist
+            lassign [CreateSMP1 $token $secret {*}$args] \
+                    smpstate smpprogress flags body tlvlist
             set message [CreateEncryptedMessage $token $flags $body $tlvlist]
-
-            return [list body $message]
+            CallBack $token send $message
+            set state(smpstate) $smpstate
+            set state(smpprogress) $smpprogress
         }
         default {
-            set state(SMPProgress) SMP_ABORT
-            return {}
+            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) {
+    switch -- $state(msgstate) {
         MSGSTATE_ENCRYPTED {
-            lassign [CreateSMP2 $secret $token] \
-                    state(SMPState) state(SMPProgress) flags body tlvlist
+            lassign [CreateSMP2 $token $secret] \
+                    smpstate smpprogress flags body tlvlist
             set message [CreateEncryptedMessage $token $flags $body $tlvlist]
-
-            return [list body $message]
+            CallBack $token send $message
+            set state(smpstate) $smpstate
+            set state(smpprogress) $smpprogress
         }
         default {
-            set state(SMPProgress) SMP_ABORT
-            return {}
+            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) {
+    switch -- $state(msgstate) {
         MSGSTATE_ENCRYPTED {
             set message [CreateEncryptedMessage $token {} "" {6 ""}]
-
-            set state(SMPState) SMPSTATE_EXPECT1
-            set state(SMPProgress) SMP_ABORT
-            return [list body $message]
+            CallBack $token send $message
+            set state(smpstate) SMPSTATE_EXPECT1
+            set state(smpprogress) SMP_ABORT
         }
         default {
-            set state(SMPProgress) SMP_ABORT
-            return {}
+            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 body} {
+proc ::otr::outgoingMessage {token message} {
     variable $token
     upvar 0 $token state
 
-    switch -- $state(MsgState) {
+    switch -- $state(msgstate) {
         MSGSTATE_PLAINTEXT {
             if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
-                Store $token $body
-                return [list body [::otr::data::queryMessage $state(Policy)] \
-                             info "Message is not sent. Trying to start\
-                                   private conversation..."]
+                Store $token $message
+                CallBack $token info "Message is not sent. 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 body "$body[::otr::data::whitespaceTag \
-                                                    $state(Policy)]"]
+                      !$state(receivedplaintext)} {
+                return [list message \
+                             $message[::otr::data::whitespaceTag $state(policy)]]
             } else {
-                return [list body $body]
+                return [list message $message]
             }
         }
         MSGSTATE_ENCRYPTED {
-            Store $token $body
-
+            Store $token $message
             # Store the time of last message sent
-            set state(LastMessage) [clock seconds]
-
-            set message [CreateEncryptedMessage $token {} $body {}]
-            return [list body $message]
+            set state(lastmessage) [clock seconds]
+            set message [CreateEncryptedMessage $token {} $message {}]
+            return [list message $message]
         }
         MSGSTATE_FINISHED {
-            Store $token $body
-
-            return [list info "Message is not sent. Either end your private\
-                               conversation, or restart it."]
+            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
@@ -439,27 +543,23 @@
         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"
 
         return [DispatchBinaryMessage $token $data]
-
     } elseif {![catch {::otr::data::findErrorMessage $message} error]} {
         # OTR error message
 
         Debug $token 2 "OTR error message"
 
+        CallBack $token error $error
         if {[QueryPolicy $token ERROR_START_AKE] &&
             ([QueryPolicy $token ALLOW_V2] || [QueryPolicy $token ALLOW_V3])} {
-            return [list error $error \
-                         reply [list [::otr::data::queryMessage \
-                                                $state(Policy)]]]
-        } else {
-            return [list error $error]
+            CallBack $token send [::otr::data::queryMessage $state(policy)]
         }
+        return {}
     } elseif {![catch {::otr::data::findQueryMessage $message} versions] && \
                     [set version [FindVersion $token $versions]]} {
         # OTR query message of a suitable version
@@ -471,94 +571,81 @@
         set keyid [expr {$state(keyid)-1}]
         lassign [::otr::auth::createDHCommitMessage \
                         $state(version) \
-                        $state(AuthState) \
-                        $state(MsgState) \
+                        $state(authstate) \
+                        $state(msgstate) \
                         $state(r) \
                         $state(x,$keyid) \
                         -sinstance $state(sinstance)] \
-                        state(AuthState) state(MsgState) message
-        return [list reply [list $message]]
-    } elseif {![catch {::otr::data::findWhitespaceTag $message} versions]} {
-        # Plaintext with the whitespace tag
+                        authstate msgstate message
+        CallBack $token send $message
+        set state(authstate) $authstate
+        set state(msgstate) $msgstate
+        return {}
+    } else {
+        # Plaintext message
 
-        Debug $token 2 "Plaintext with the whitespace tag"
+        Debug $token 2 "Plaintext message"
 
-        set message [::otr::data::removeWhitespaceTag $message]
+        if {![catch {::otr::data::findWhitespaceTag $message} versions]} {
+            # Plaintext with the whitespace tag
 
-        if {[QueryPolicy $token WHITESPACE_START_AKE] && \
+            Debug $token 2 "... with the whitespace tag"
+
+            set message [::otr::data::removeWhitespaceTag $message]
+
+            if {[QueryPolicy $token WHITESPACE_START_AKE] && \
                     [set version [FindVersion $token $versions]]} {
 
-            NewSession $token $version
+                NewSession $token $version
 
-            set keyid [expr {$state(keyid)-1}]
-            lassign [::otr::auth::createDHCommitMessage \
-                            $state(version) \
-                            $state(AuthState) \
-                            $state(MsgState) \
-                            $state(r) \
-                            $state(x,$keyid) \
-                            -sinstance $state(sinstance)] \
-                            state(AuthState) state(MsgState) reply
-            switch -- $state(MsgState) {
-                MSGSTATE_PLAINTEXT {
-                    set ret [list body  $message \
-                                  reply [list $reply]]
-                    if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
-                        return [linsert $ret 0 warn 1]
-                    } else {
-                        return $ret
-                    }
-
-                }
-                MSGSTATE_ENCRYPTED -
-                MSGSTATE_FINISHED {
-                    return [list warn  1 \
-                                 body  $message \
-                                 reply [list $reply]]
-                }
+                set keyid [expr {$state(keyid)-1}]
+                lassign [::otr::auth::createDHCommitMessage \
+                                $state(version) \
+                                $state(authstate) \
+                                $state(msgstate) \
+                                $state(r) \
+                                $state(x,$keyid) \
+                                -sinstance $state(sinstance)] \
+                                authstate msgstate reply
+                CallBack $token send $reply
+                set state(authstate) $authstate
+                set state(msgstate) $msgstate
             }
-        } else {
-            switch -- $state(MsgState) {
-                MSGSTATE_PLAINTEXT {
-                    set state(ReceivedPlaintext) 1
-                    if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
-                        return [list warn 1 \
-                                     body $message]
-                    } else {
-                        return [list body $message]
-                    }
-                }
-                MSGSTATE_ENCRYPTED -
-                MSGSTATE_FINISHED {
-                    return [list warn 1 \
-                                 body $message]
-                }
-            }
         }
-    } else {
-        # Plaintext without a whitespace tag
-
-        Debug $token 2 "Plaintext without a whitespace tag"
-
-        switch -- $state(MsgState) {
+        set ret [list message $message]
+        switch -- $state(msgstate) {
             MSGSTATE_PLAINTEXT {
-                set state(ReceivedPlaintext) 1
+                set state(receivedplaintext) 1
                 if {[QueryPolicy $token REQUIRE_ENCRYPTION]} {
-                    return [list warn 1 \
-                                 body $message]
-                } else {
-                    return [list body $message]
+                    lappend ret warn 1
                 }
             }
             MSGSTATE_ENCRYPTED -
             MSGSTATE_FINISHED {
-                return [list warn 1 \
-                             body $message]
+                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
@@ -588,29 +675,44 @@
     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)
+        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
+        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
+    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
@@ -636,8 +738,9 @@
             3 {
                 Debug $token 1 "Var state(version) is not set"
                 set error "Encrypted message can't be deciphered"
-                return [list info  $error \
-                             reply [list [::otr::data::errorMessage $error]]]
+                CallBack $token info $error \
+                CallBack $token send [::otr::data::errorMessage $error]
+                return {}
             }
             default {
                 return {}
@@ -648,8 +751,9 @@
     if {$version != $state(version)} {
         set error "Unmatched protocol version"
         Debug $token 1 $error
-        return [list info $error \
-                     reply [list [::otr::data::errorMessage $error]]]
+        CallBack $token info $error \
+        CallBack $token send [::otr::data::errorMessage $error]
+        return {}
     }
 
     if {$version >= 3} {
@@ -694,11 +798,16 @@
     }
 }
 
+# ::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) {
+    switch -- $state(authstate) {
         AUTHSTATE_AWAITING_DHKEY {
             set arg [list -r $state(r)]
         }
@@ -710,28 +819,29 @@
     set keyid [expr {$state(keyid)-1}]
     lassign [::otr::auth::processDHCommitMessage \
                     $state(version) \
-                    $state(AuthState) \
-                    $state(MsgState) \
+                    $state(authstate) \
+                    $state(msgstate) \
                     $data \
                     $state(x,$keyid) \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance) \
                     {*}$arg] \
-            state(AuthState) state(MsgState) message \
+            state(authstate) state(msgstate) message \
             state(egxmpi) state(hgxmpi)
 
-    if {$message eq ""} {
-        return {}
-    } else {
-        return [list reply [list $message]]
+    if {$message ne ""} {
+        CallBack $token send $message
     }
+    return {}
 }
 
+# ::otr::ProcessDHKeyMessage --
+
 proc ::otr::ProcessDHKeyMessage {token data} {
     variable $token
     upvar 0 $token state
 
-    switch -- $state(AuthState) {
+    switch -- $state(authstate) {
         AUTHSTATE_AWAITING_SIG {
             set arg [list -gy $state(gy)]
         }
@@ -743,25 +853,26 @@
     set keyid [expr {$state(keyid)-1}]
     lassign [::otr::auth::processDHKeyMessage \
                     $state(version) \
-                    $state(AuthState) \
-                    $state(MsgState) \
+                    $state(authstate) \
+                    $state(msgstate) \
                     $data \
-                    $state(PrivateKey) \
+                    $state(privatekey) \
                     $state(r) \
                     $state(x,$keyid) \
                     $keyid \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance) \
                     {*}$arg] \
-            state(AuthState) state(MsgState) message state(gy)
+            state(authstate) state(msgstate) message state(gy)
 
-    if {$message eq ""} {
-        return {}
-    } else {
-        return [list reply [list $message]]
+    if {$message ne ""} {
+        CallBack $token send $message
     }
+    return {}
 }
 
+# ::otr::ProcessRevealSignatureMessage --
+
 proc ::otr::ProcessRevealSignatureMessage {token data} {
     variable $token
     upvar 0 $token state
@@ -769,34 +880,33 @@
     set keyid [expr {$state(keyid)-1}]
     lassign [::otr::auth::processRevealSignatureMessage \
                     $state(version) \
-                    $state(AuthState) \
-                    $state(MsgState) \
+                    $state(authstate) \
+                    $state(msgstate) \
                     $data \
                     $state(egxmpi) \
                     $state(hgxmpi) \
-                    $state(PrivateKey) \
+                    $state(privatekey) \
                     $state(x,$keyid) \
                     $keyid \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance)] \
-            authstate msgstate message state(PublicKey) gy keyidy
+            authstate msgstate message state(publickey) gy keyidy
 
-    if {$message eq ""} {
-        # Failure
-        set ret {}
-    } else {
+    if {$message ne ""} {
         # Success
         UpdatePeerDHKeysAfterAKE $token $gy $keyidy
         StoreSSID $token
 
         # TODO: Send stored messages
-        set ret [list reply [list $message]]
+        CallBack $token send $message
     }
-    set state(AuthState) $authstate
-    set state(MsgState) $msgstate
-    set ret
+    set state(authstate) $authstate
+    set state(msgstate) $msgstate
+    return {}
 }
 
+# ::otr::ProcessSignatureMessage --
+
 proc ::otr::ProcessSignatureMessage {token data} {
     variable $token
     upvar 0 $token state
@@ -804,28 +914,29 @@
     set keyid [expr {$state(keyid)-1}]
     lassign [::otr::auth::processSignatureMessage \
                     $state(version) \
-                    $state(AuthState) \
-                    $state(MsgState) \
+                    $state(authstate) \
+                    $state(msgstate) \
                     $data \
                     $state(gy) \
                     $state(x,$keyid) \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance)] \
-            authstate msgstate message state(PublicKey) keyidy
+            authstate msgstate message state(publickey) keyidy
 
     if {$keyidy ne ""} {
         # Success
-
         UpdatePeerDHKeysAfterAKE $token $state(gy) $keyidy
         StoreSSID $token
 
         # TODO: Send stored messages
     }
-    set state(AuthState) $authstate
-    set state(MsgState) $msgstate
+    set state(authstate) $authstate
+    set state(msgstate) $msgstate
     return {}
 }
 
+# ::otr::UpdatePeerDHKeysAfterAKE --
+
 proc ::otr::UpdatePeerDHKeysAfterAKE {token gy keyidy} {
     variable $token
     upvar 0 $token state
@@ -845,6 +956,8 @@
     }
 }
 
+# ::otr::StoreSSID --
+
 proc ::otr::StoreSSID {token} {
     variable $token
     upvar 0 $token state
@@ -855,49 +968,61 @@
     lassign [::otr::crypto::DHKeys $gy $x] state(ssid)
 }
 
-proc ::otr::ProcessDataMessage {token data} {
+# ::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]]
 
-    switch -- $state(MsgState) {
+    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 {"IGNORE_UNREADABLE" in $flags} {
-                set err {}
-            } else {
-                set err [list info $info reply $reply]
-            }
-
             if {$skeyid <= 0 || $rkeyid <= 0} {
                 Debug $token 1 "Data message doesn't contain key serial numbers"
-                return $err
+                ShowCantDecipherError $token $flags
+                return {}
             }
 
             if {$skeyid != $state(keyidy) && $skeyid != $state(keyidy)-1} {
                 Debug $token 1 "The sender's key serial number is unknown"
-                return $err
+                ShowCantDecipherError $token $flags
+                return {}
             }
 
             if {$rkeyid != $state(keyid) && $rkeyid != $state(keyid)-1} {
                 Debug $token 1 "The recipient's key serial number is unknown"
-                return $err
+                ShowCantDecipherError $token $flags
+                return {}
             }
 
             if {$state(gy,$skeyid) <= 0} {
                 Debug $token 1 "The sender's key with this serial number doesn't exist"
-                return $err
+                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"
-                    return $err
+                    ShowCantDecipherError $token $flags
+                    return {}
                 }
             } else {
                 array unset ctrtop,*
@@ -911,8 +1036,8 @@
 
             set result [::otr::message::processDataMessage \
                                 $state(version) \
-                                $state(MsgState) \
-                                $state(SMPState) \
+                                $state(msgstate) \
+                                $state(smpstate) \
                                 $rest \
                                 $flags \
                                 $skeyid \
@@ -927,28 +1052,30 @@
 
             array set res $result
 
-            if {[info exists res(msgstate)]} {
-                set state(MsgState) $res(msgstate)
+            foreach field {msgstate smpstate smpprogress} {
+                if {[info exists res($field)]} {
+                    set state($field) $res($field)
+                }
             }
-            if {[info exists res(smpstate)]} {
-                set state(SMPState) $res(smpstate)
-            }
-            if {[info exists res(smpprogress)]} {
-                set state(SMPProgress) $res(smpprogress)
-            }
 
             if {[info exists res(debug)]} {
                 Debug 2 $token $res(debug)
             }
 
             set ret {}
-            foreach field {info error body interaction question} {
+            foreach field {message interaction 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)]} {
-                lappend ret reply $res(replyerr)
+                CallBack $token send $res(replyerr)
             }
 
             if {[info exists res(info)] || [info exists res(error)] ||
@@ -957,32 +1084,31 @@
             }
 
             if {[info exists res(reply)]} {
-                switch -- $state(MsgState) {
+                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) {
-                            lappend repl \
-                                [CreateEncryptedMessage $token {} $body $tlvlist]
+                            CallBack $token send \
+                                     [CreateEncryptedMessage $token {} $body $tlvlist]
                         }
-                        lappend ret reply $repl
 
                         # Store the time of last message sent
-                        set state(LastMessage) [clock seconds]
+                        set state(lastmessage) [clock seconds]
                     }
                     default {
-                        Debug 1 $token "Trying to autoreply in $state(MsgState) state"
+                        Debug 1 $token "Trying to autoreply in $state(msgstate) state"
                     }
                 }
             }
 
-            if {![info exists res(body)]} {
-                Debug 2 $token "Decrypted message body is empty"
+            if {![info exists res(message)]} {
+                Debug 2 $token "Decrypted message is empty"
             }
 
-            switch -- $state(MsgState) {
+            switch -- $state(msgstate) {
                 MSGSTATE_ENCRYPTED {
                     # Keys rotation (key management 4)
 
@@ -1019,11 +1145,11 @@
                     # 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]
-                            lappend ret reply \
-                                [list [CreateEncryptedMessage $token \
+                        if {$state(heartbeat) > 0 &&
+                                $curtime > $state(lastmessage) + 60*$state(heartbeat)} {
+                            set state(lastmessage) [clock seconds]
+                            CallBack $token send \
+                                     [CreateEncryptedMessage $token \
                                                 {IGNORE_UNREADABLE} "" {}]]
                         }
                     }
@@ -1036,11 +1162,14 @@
         }
         MSGSTATE_PLAIN -
         MSGSTATE_FINISHED {
-            return [list info $info reply $reply]
+            ShowCantDecipherError $token {}
+            return {}
         }
     }
 }
 
+# ::otr::InitDHKeys --
+
 proc ::otr::InitDHKeys {token} {
     variable $token
     upvar 0 $token state
@@ -1068,24 +1197,18 @@
     unset -nocomplain state(version)
 }
 
-##############################################################################
+# ::otr::CreateSMP1 --
 
-proc ::otr::CreateSMP1 {question secret token} {
+proc ::otr::CreateSMP1 {token secret args} {
     variable $token
     upvar $token state
 
-    if {$question eq "\x00"} {
-        set quest {}
-    } else {
-        set quest [list -question $question]
-    }
-
-    lassign [::otr::smp::createSMPMessage1 $state(SMPState) \
-                                           $state(PrivateKey) \
-                                           $state(PublicKey) \
+    lassign [::otr::smp::createSMPMessage1 $state(smpstate) \
+                                           $state(privatekey) \
+                                           $state(publickey) \
                                            $state(ssid) \
                                            $secret \
-                                           {*}$quest] \
+                                           {*}$args] \
             smpstate type payload x a2 a3
     if {$type == 6} {
         SMPCallback $token clear
@@ -1099,15 +1222,17 @@
     list $smpstate $progress {} "" [list $type $payload]
 }
 
-proc ::otr::CreateSMP2 {secret token} {
+# ::otr::CreateSMP2 --
+
+proc ::otr::CreateSMP2 {token secret} {
     variable $token
     upvar $token state
 
     set data1 [SMPCallback $token get data1]
-    lassign [::otr::smp::processSMPMessage1 $state(SMPState) \
+    lassign [::otr::smp::processSMPMessage1 $state(smpstate) \
                                             $data1 \
-                                            $state(PrivateKey) \
-                                            $state(PublicKey) \
+                                            $state(privatekey) \
+                                            $state(publickey) \
                                             $state(ssid) \
                                             $secret] \
             smpstate type payload g3a g2 g3 b3 Pb Qb
@@ -1126,7 +1251,7 @@
     list $smpstate $progress {} "" [list $type $payload]
 }
 
-##############################################################################
+# ::otr::CreateEncryptedMessage --
 
 proc ::otr::CreateEncryptedMessage {token flags body tlvlist} {
     variable $token
@@ -1151,8 +1276,6 @@
             -rinstance $state(rinstance)
 }
 
-##############################################################################
-
 # ::otr::FindVersion --
 #
 #       Check if the given versions list contains one of the supported.
@@ -1188,9 +1311,9 @@
     variable $token
     upvar 0 $token state
 
-    set state(AuthState) AUTHSTATE_NONE
-    set state(MsgState) MSGSTATE_PLAINTEXT
-    set state(SMPState) SMPSTATE_EXPECT1
+    set state(authstate) AUTHSTATE_NONE
+    set state(msgstate) MSGSTATE_PLAINTEXT
+    set state(smpstate) SMPSTATE_EXPECT1
 
     set state(version) $version
     set state(r) [::otr::crypto::Int2Octets [::otr::crypto::random 128] 128]
@@ -1203,42 +1326,18 @@
     upvar 0 $token state
 
     # TODO
-    #lappend state(StoredMessages) $message
+    #lappend state(storedmessages) $message
 }
 
-# ::otr::fingerprint --
-#
-#       Return the DSA public key fingerprint.
-#
-# Arguments:
-#       key         DSA public key {p q g y}.
-#
-# Result:
-#       The hex SHA-1 hash of the binary representation of the key.
-#
-# Side effects:
-#       None.
+# ::otr::QueryPolicy --
 
-proc ::otr::fingerprint {token {me 0}} {
+proc ::otr::QueryPolicy {token item} {
     variable $token
     upvar 0 $token state
 
-    if {$me} {
-        set key $state(PrivateKey)
-    } else {
-        set key $state(PublicKey)
-    }
-
-    binary scan [::otr::crypto::DSAFingerprint $key] Iu* nums
-    set res {}
-    foreach n $nums {
-        lappend res [format %X $n]
-    }
-    join $res
+    expr {$item in $state(policy)}
 }
 
-###########################################################################
-
 # ::otr::SMPCallback --
 
 proc ::otr::SMPCallback {token op {name ""} {val ""}} {
@@ -1254,11 +1353,11 @@
             switch -- $name {
                 privkey {
                     # Our DSA key
-                    return $state(PrivateKey)
+                    return $state(privatekey)
                 }
                 pubkey {
                     # Peer's DSA key
-                    return $state(PublicKey)
+                    return $state(publickey)
                 }
                 default {
                     if {[info exists state(smp,$name)]} {
@@ -1276,64 +1375,149 @@
     }
 }
 
-###########################################################################
+# ::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
+    if {$state(storedauthstate) eq $state(authstate)} return
 
-    set state(StoredAuthState) $state(AuthState)
-
-    foreach cmd $state(AuthStateCommands) {
-        {*}$cmd $state(AuthState)
-    }
+    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
+    if {$state(storedmsgstate) eq $state(msgstate)} return
 
-    set state(StoredMsgState) $state(MsgState)
-
-    switch -- $state(MsgState) {
+    set state(storedmsgstate) $state(msgstate)
+    switch -- $state(msgstate) {
         MSGSTATE_PLAINTEXT {
-            set state(ReceivedPlaintext) 0
+            set state(receivedplaintext) 0
         }
     }
-
-    foreach cmd $state(MsgStateCommands) {
-        {*}$cmd $state(MsgState)
-    }
+    CallBack $token msgstate $state(msgstate)
 }
 
+# ::otr::TrackSMPState --
+
 proc ::otr::TrackSMPState {token name1 name2 op} {
     variable $token
     upvar 0 $token state
 
-    if {$state(StoredSMPState) eq $state(SMPState)} return
+    if {$state(storedsmpstate) eq $state(smpstate)} return
 
-    set state(StoredSMPState) $state(SMPState)
-
-    foreach cmd $state(SMPStateCommands) {
-        {*}$cmd $state(SMPState)
-    }
+    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
 
-    foreach cmd $state(SMPProgressCommands) {
-        {*}$cmd $state(SMPProgress)
+    CallBack $token smpprogress $state(smpprogress)
+}
+
+# ::otr::CallBack --
+
+proc ::otr::CallBack {token op args} {
+    variable $token
+    upvar 0 $token state
+
+    foreach cmd $state(${op}commands) {
+        {*}$cmd {*}$args
     }
+    return
 }
 
-###########################################################################
-
 # ::otr::Debug --
 #
 #       Prints debug information.



More information about the Tkabber-dev mailing list