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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Jan 18 22:35:20 MSK 2014


Author: sergei
Date: 2014-01-18 22:35:20 +0400 (Sat, 18 Jan 2014)
New Revision: 2059

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/otr/otr.tcl
   trunk/tkabber-plugins/otr/tclotr/data.tcl
   trunk/tkabber-plugins/otr/tclotr/message.tcl
   trunk/tkabber-plugins/otr/tclotr/otr.tcl
   trunk/tkabber-plugins/otr/tclotr/smp.tcl
Log:
	* otr/*: Better error reporting. Continue implementing peer
	  authentication.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-18 18:35:20 UTC (rev 2059)
@@ -1,3 +1,8 @@
+2014-01-18  Sergei Golovan <sgolovan at nes.ru>
+
+	* otr/*: Better error reporting. Continue implementing peer
+	  authentication.
+
 2014-01-17  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/*: Added pre-alpha of the new OTR plugin. No key management,

Modified: trunk/tkabber-plugins/otr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/otr.tcl	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-18 18:35:20 UTC (rev 2059)
@@ -38,6 +38,9 @@
     # supplemetary info.
     set ns tkabber:otr
 
+    # OTR error message
+    ::xmpp::stanzaerror::registerType otr [::msgcat::mc "OTR error"]
+
     variable options
 
     variable themes
@@ -195,8 +198,9 @@
     set result [::otr::new $::OTRPrivateKey [get_policy $xlib $jid]]
     array set res $result
     set ctx($xlib,$jid) $res(token)
-    set ctx(authstate,$xlib,$jid) $res(authstate)
-    set ctx(msgstate,$xlib,$jid) $res(msgstate)
+    foreach state {authstate msgstate smpstate} {
+	set ctx($state,$xlib,$jid) $res($state)
+    }
 }
 
 proc otr::get_policy {xlib jid} {
@@ -352,14 +356,179 @@
     if {$res(action) eq "send"} {
 	::xmpp::sendMessage $xlib $jid -type $type -body $res(body)
     }
-    if {[info exists res(authstate)]} {
-	set ctx(authstate,$xlib,$jid) $res(authstate)
+    foreach state {authstate msgstate smpstate} {
+	if {[info exists res($state)]} {
+	    set ctx($state,$xlib,$jid) $res($state)
+	}
     }
-    if {[info exists res(msgstate)]} {
-	set ctx(msgstate,$xlib,$jid) $res(msgstate)
+}
+
+#############################################################################
+
+proc otr::begin_smp_dialog {xlib jid} {
+    variable ctx
+
+    once_only $xlib $jid
+
+    if {$ctx(msgstate,$xlib,$jid) ne "MSGSTATE_ENCRYPTED"} {
+	MessageDlg .otrautherr -aspect 50000 -icon error \
+	    -message [::msgcat::mc "You cannot authenticate the peer's identity\
+				    if 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 .otrautherr -aspect 50000 -icon error \
+	    -message [::msgcat::mc "Authentication is in progress. If you want to\
+				    start new one, abort the current one first"] \
+	    -type user -buttons ok -default 0 -cancel 0
+	return
+    }
+
+    set w .otrauth
+    set bjid [::xmpp::jid::removeResource $jid]
+
+    Dialog $w -title [::msgcat::mc "Authenticate %s" $bjid] \
+	      -separator 1 -anchor e -default 0 -cancel 1
+
+    wm resizable $w 0 0
+
+    $w add -text [::msgcat::mc "Authenticate"] \
+	   -command [namespace code [list start_smp $w $xlib $jid]]
+    $w add -text [::msgcat::mc "Cancel"] \
+	   -command [list destroy $w]
+
+    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
+
+    $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
+
+    $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
+    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::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
+
+    once_only $xlib $jid
+
+    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
+    }
+}
+
 #############################################################################
 
 proc otr::rewrite_message_body \
@@ -368,6 +537,7 @@
     upvar 2 $vfrom from
     upvar 2 $vtype type
     upvar 2 $vbody body
+    upvar 2 $verr err
     upvar 2 $vx x
     variable ns
     variable ctx
@@ -379,24 +549,16 @@
     debugmsg otr "FILTER_INPUT: $xlib; $from; $result"
 
     array set res $result
-    switch -- $res(action) {
-	display -
-	display_reply {
-	    set body $res(body)
-	    lappend x [::xmpp::xml::create "" -xmlns $ns]
+
+    foreach state {authstate msgstate smpstate} {
+	if {[info exists res($state)]} {
+	    set ctx($state,$xlib,$from) $res($state)
 	}
-	warn -
-	warn_reply {
-	    set body $res(body)
-	    lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {warn 1}]
-	}
     }
 
-    switch -- $res(action) {
-	reply -
-	display_reply -
-	warn_reply {
-	    set command [list ::xmpp::sendMessage $xlib $from -body $res(send)]
+    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
 	    } 
@@ -404,19 +566,28 @@
 	}
     }
 
-    if {[info exists res(authstate)]} {
-	set ctx(authstate,$xlib,$from) $res(authstate)
+    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(msgstate)]} {
-	set ctx(msgstate,$xlib,$from) $res(msgstate)
+    if {[info exists res(info)]} {
+	set type info
+	set body "OTR Info: $res(info)"
+	return
     }
 
-    switch -- $res(action) {
-	reply -
-	discard {
-	    lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {discard 1}]
+    if {[info exists res(body)]} {
+	set body $res(body)
+	if {[info exists res(warn)]} {
+	    lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {warn 1}]
+	} else {
+	    lappend x [::xmpp::xml::create "" -xmlns $ns]
 	}
+    } else {
+	lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {discard 1}]
     }
 
     return
@@ -713,9 +884,14 @@
     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 "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]
     $mm add separator
+    $mm add command -label [::msgcat::mc "Authenticate peer..."] \
+	-command [list [namespace current]::begin_smp_dialog $xlib $jid]
+    $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"] \

Modified: trunk/tkabber-plugins/otr/tclotr/data.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/data.tcl	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/otr/tclotr/data.tcl	2014-01-18 18:35:20 UTC (rev 2059)
@@ -478,4 +478,11 @@
     list $type [string range $data 0 [expr {$length-1}]] [string range $data $length end]
 }
 
+# ::otr::data::Bin2Hex --
+
+proc ::otr::data::Bin2Hex {data} {
+    binary scan $data H* hex
+    set hex
+}
+
 # vim:ts=8:sw=4:sts=4:et

Modified: trunk/tkabber-plugins/otr/tclotr/message.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-18 18:35:20 UTC (rev 2059)
@@ -84,6 +84,7 @@
     append res [::otr::data::encode CTR $ctrtop]
 
     set plaintext [createDataMessagePlaintext $humanreadable $tlvlist]
+    puts "TKABBER PLAINTEXT TO SEND: [::otr::data::Bin2Hex $plaintext]"
 
     lassign [::otr::crypto::AESKeys $gy $x1] skey smac rkey rmac
     set cryptotext [::otr::crypto::aes $plaintext $skey $ctrtop]
@@ -101,28 +102,36 @@
 
 proc ::otr::message::processDataMessage {version msgstate smpstate data
                                          skeyid1 rkeyid1 gy1 x args} {
+    variable Flags
+
     set sinstance 0x100
     set rinstance 0x100
     foreach {key val} $args {
         switch -- $key {
+            -smpcommand { set smpcommand $val }
             -sinstance { set sinstance $val }
             -rinstance { set rinstance $val }
-            -r { set r $val }
         }
     }
 
+    if {![info exists smpcommand]} {
+        return -code error "Option -smpcommand is mandatory"
+    }
+
+    set info "Encrypted message can't be deciphered"
+    set error [list [::otr::data::errorMessage \
+                            "Encrypted message can't be deciphered"]]
+
     if {[catch {parseDataMessage $data} res]} {
-        puts "Parsing data message failed: $res"
-
-        return [list $msgstate $smpstate ""]
+        return [list debug "Parsing data message failed: $res" \
+                     info $info replyerr [list $error]]
     }
 
     lassign $res flags skeyid rkeyid gy ctrtop cryptotext hmac oldmackeys
 
     if {$skeyid != $skeyid1 || $rkeyid != $rkeyid1} {
-        puts "Something wrong, serials must be extracted from the same place"
-
-        return [list $msgstate $smpstate ""]
+        return [list debug "Serials don't match" \
+                     info $info replyerr [list $error]]
     }
 
     # Reassemble the message and verify its hash
@@ -152,74 +161,234 @@
     set myhmac [::sha1::hmac -bin -key $rmac $msg]
 
     if {$myhmac ne $hmac} {
-        puts "Data message hash verification failed"
-        return [list $msgstate $smpstate ""]
+        return [list debug "Data message hash verification failed" \
+                     info $info replyerr [list $error]]
     }
 
+    # Decrypt yhe payload and parse it
+
     set plaintext [::otr::crypto::aes $cryptotext $rkey $ctrtop]
 
     if {[catch {parseDataMessagePlaintext $plaintext} res]} {
-        puts "Data message plaintext encoding failed: $res"
-        return [list $msgstate $smpstate ""]
+        return [list debug "Data message plaintext decoding failed: $res" \
+                     info $info replyerr [list $error]]
     }
 
     lassign $res message tlvlist
 
+    if {$message eq ""} {
+        set msg {}
+    } else {
+        set msg [list body $message]
+    }
+
+    # Store the extra symmetric key usage info if it's present
+
     foreach {type value} $tlvlist {
         switch -- $type {
-            0 {
-                # Padding
+            8 {
+                # Extra symmetric key
+                # TODO
             }
+        }
+    }
+
+    # Finish the OTR conversation if the peer asked to
+
+    foreach {type value} $tlvlist {
+        switch -- $type {
             1 {
                 # Disconnected
+                # There's no point to continue SMP if any in progress
                 set msgstate MSGSTATE_FINISHED
+                set smpstate SMPSTATE_EXPECT1
+                uplevel #0 $smpcommand clear
+                return [list msgstate $msgstate \
+                             smpstate $smpstate \
+                             {*}$msg]
             }
+        }
+    }
+
+    # Consider only the first SMP TLV, ignore the rest
+
+    foreach {type value} $tlvlist {
+        switch -- $type {
+            0 {
+                # Padding
+            }
             2 {
                 # SMP message 1
+                # Don't process it immediately, just store and go
+                # after the user will supply the shared secret
+
                 # TODO
-                #::otr::smp::processSMPMessage1 ...
+                return [list nextkey $gy reply [list "" {6 ""}]]
+
+                set privkey [uplevel #0 $smpcommand get privkey]
+                set pubkey  [uplevel #0 $smpcommand get pubkey]
+                set secret  [uplevel #0 $smpcommand get secret]
+                lassign [::otr::smp::processSMPMessage1 \
+                           $smpstate $value $privkey $pubkey $gy1 $x $secret] \
+                        smpstate tlv payload g3a g2 g3 b3 Pb Qb
+                if {$tlv == 6} {
+                    uplevel #0 $smpcommand clear
+                    set answer SMP_CHEATING
+                } else {
+                    uplevel #0 $smpcommand set g3a $g3a
+                    uplevel #0 $smpcommand set g2  $g2
+                    uplevel #0 $smpcommand set g3  $g3
+                    uplevel #0 $smpcommand set b3  $b3
+                    uplevel #0 $smpcommand set Pb  $Pb
+                    uplevel #0 $smpcommand set Qb  $Qb
+                    set answer SMP_PROGRESS
+                }
+                #TODO
+                return [list $msgstate $smpstate $message $gy $answer $tlv $payload]
             }
             3 {
                 # SMP message 2
-                # TODO
-                #::otr::smp::processSMPMessage2 ...
+
+                set x  [uplevel #0 $smpcommand get x]
+                set a2 [uplevel #0 $smpcommand get a2]
+                set a3 [uplevel #0 $smpcommand get a3]
+                lassign [::otr::smp::processSMPMessage2 \
+                                    $smpstate $value $x $a2 $a3] \
+                        smpstate tlv payload g3b PaPb QaQb Ra
+                if {$tlv == 6} {
+                    uplevel #0 $smpcommand clear
+                    set answer SMP_CHEATING
+                } else {
+                    uplevel #0 $smpcommand set g3b  $g3b
+                    uplevel #0 $smpcommand set PaPb $PaPb
+                    uplevel #0 $smpcommand set QaQb $QaQb
+                    uplevel #0 $smpcommand set Ra   $Ra
+                    set answer SMP_PROGRESS
+                }
+                return [list msgstate $msgstate \
+                             smpstate $smpstate \
+                             nextkey  $gy \
+                             smpprogr $answer \
+                             reply    [list "" [list $tlv $payload]] \
+                             {*}$msg]
             }
             4 {
-                # SMP message 3
-                # TODO
-                #::otr::smp::processSMPMessage3 ...
+                # SMP message 3 g3a g2 g3 b3 Pb Qb
+
+                set g3a [uplevel #0 $smpcommand get g3a]
+                set g2  [uplevel #0 $smpcommand get g2]
+                set g3  [uplevel #0 $smpcommand get g3]
+                set b3  [uplevel #0 $smpcommand get b3]
+                set Pb  [uplevel #0 $smpcommand get Pb]
+                set Qb  [uplevel #0 $smpcommand get Qb]
+                lassign [::otr::smp::processSMPMessage3 \
+                                $smpstate $value $g3a $g2 $g3 $b3 $Pb $Qb] \
+                        smpstate tlv payload res
+                if {$tlv == 6} {
+                    uplevel #0 $smpcommand clear
+                    set answer SMP_CHEATING
+                } else {
+                    if {$res} {
+                        set answer SMP_SUCCESS
+                    } else {
+                        set answer SMP_FAILURE
+                    }
+                }
+                return [list msgstate $msgstate \
+                             smpstate $smpstate \
+                             nextkey  $gy \
+                             spmprogr $answer \
+                             reply    [list "" [list $tlv $payload]] \
+                             {*}$msg]
             }
             5 {
                 # SMP message 4
-                # TODO
-                #::otr::smp::processSMPMessage4 ...
+
+                set a3   [uplevel #0 $smpcommand get a3]
+                set g3b  [uplevel #0 $smpcommand get g3b]
+                set PaPb [uplevel #0 $smpcommand get PaPb]
+                set OaOb [uplevel #0 $smpcommand get QaQb]
+                set Ra   [uplevel #0 $smpcommand get Ra]
+                lassign [::otr::smp::processSMPMessage4 \
+                                $smpstate $value $a3 $g3b $PaPb $QaQb $Ra] \
+                        smpstate tlv payload res
+                
+                uplevel #0 $smpcommand clear
+                if {$tlv == 6} {
+                    set answer SMP_CHEATING
+                    set tlvp [list $tlv $payload]
+                } else {
+                    if {$res} {
+                        set answer SMP_SUCCESS
+                    } else {
+                        set answer SMP_FAILURE
+                    }
+                    set tlvp {}
+                }
+                return [list msgstate $msgstate \
+                             smpstate $smpstate \
+                             nextkey  $gy \
+                             smpprogr $answer \
+                             reply    [list "" $tlvp] \
+                             {*}$msg]
             }
             6 {
                 # SMP abort message
-                # TODO
-                #::otr::smp::processSMPAbortMessage ...
+
+                set smpstate SMPSTATE_EXPECT1
+                uplevel #0 $smpcommand clear
+                return [list msgstate $msgstate \
+                             smpstate $smpstate \
+                             nextkey  $gy \
+                             smpprogr SMP_ABORT \
+                             {*}$msg]
             }
             7 {
-                # SMP message 1Q (for version 3 only)
-                if {$version < 3} {
-                    return [list $msgstate $smpstate $message]
-                }
+                # SMP message 1Q
+                # Don't process it immediately, just store and go
+                # after the user will supply the shared secret
+
                 # TODO
-                #::otr::smp::processSMPMessage1Q ...
-            }
-            8 {
-                # Extra symmetric key (for version 3 only)
-                if {$version < 3} {
-                    return [list $msgstate $smpstate $message]
+                return [list nextkey $gy reply [list "" {6 ""}]]
+
+                set idx [string first \x00 $value]
+                if {$idx < 0} {
+                    set smpstate SMPSTATE_EXPECT1
+                    uplevel #0 $smpcommand clear
+                    return [list $msgstate $smpstate $message $gy SMP_CHEATING 6 ""]
                 }
-                # TODO
+                set question [encoding convertfrom utf-8 \
+                                       [string range $value 0 [expr {$idx-1}]]]
+                set value [string range $value [expr {$idx+1}] end]
+
+                set privkey [uplevel #0 $smpcommand get privkey]
+                set pubkey  [uplevel #0 $smpcommand get pubkey]
+                set secret  [uplevel #0 $smpcommand get secret]
+                lassign [::otr::smp::processSMPMessage1 \
+                           $smpstate $value $privkey $pubkey $gy1 $x $secret \
+                           -question $question] \
+                        smpstate tlv payload g3a g2 g3 b3 Pb Qb
+                if {$tlv == 6} {
+                    uplevel #0 $smpcommand clear
+                    set answer SMP_CHEATING
+                } else {
+                    uplevel #0 $smpcommand set g3a $g3a
+                    uplevel #0 $smpcommand set g2  $g2
+                    uplevel #0 $smpcommand set g3  $g3
+                    uplevel #0 $smpcommand set b3  $b3
+                    uplevel #0 $smpcommand set Pb  $Pb
+                    uplevel #0 $smpcommand set Qb  $Qb
+                    set answer SMP_PROGRESS
+                }
+                #TODO
+                return [list $msgstate $smpstate $message $gy $answer $tlv $payload]
             }
-            default {
-                #puts "Unknown TLV"
-            }
         }
     }
-    return [list $msgstate $smpstate $message $gy]
+    return [list msgstate $msgstate \
+                 smpstate $smpstate \
+                 nextkey  $gy \
+                 {*}$msg]
 }
 
 # ::otr::message::parseDataMessage --

Modified: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-18 18:35:20 UTC (rev 2059)
@@ -21,26 +21,32 @@
 package provide otr 0.1
 
 namespace eval ::otr {
-    # AuthState {
-    #       AUTHSTATE_NONE
-    #       AUTHSTATE_AWAITING_DHKEY
-    #       AUTHSTATE_AWAITING_REVEALSIG
-    #       AUTHSTATE_AWAITING_SIG
-    #   }
-    # MsgState {
-    #       MSGSTATE_PLAINTEXT
-    #       MSGSTATE_ENCRYPTED
-    #       MSGSTATE_FINISHED
-    #   }
-    # Policy {
-    #       ALLOW_V1
-    #       ALLOW_V2
-    #       ALLOW_V3
-    #       REQUIRE_ENCRYPTION
-    #       SEND_WHITESPACE_TAG
-    #       WHITESPACE_START_AKE
-    #       ERROR_START_AKE
-    #   }
+#   AuthState {
+#       AUTHSTATE_NONE
+#       AUTHSTATE_AWAITING_DHKEY
+#       AUTHSTATE_AWAITING_REVEALSIG
+#       AUTHSTATE_AWAITING_SIG
+#   }
+#   MsgState {
+#       MSGSTATE_PLAINTEXT
+#       MSGSTATE_ENCRYPTED
+#       MSGSTATE_FINISHED
+#   }
+#   SMPState {
+#       SMPSTATE_EXPECT1
+#       SMPSTATE_EXPECT2
+#       SMPSTATE_EXPECT3
+#       SMPSTATE_EXPECT4
+#   }
+#   Policy {
+#       ALLOW_V1
+#       ALLOW_V2
+#       ALLOW_V3
+#       REQUIRE_ENCRYPTION
+#       SEND_WHITESPACE_TAG
+#       WHITESPACE_START_AKE
+#       ERROR_START_AKE
+#   }
 
     variable debug 0
 }
@@ -241,14 +247,11 @@
 
         Debug $token 2 "OTR error message"
 
-        # TODO: nice error report
         if {[queryPolicy $token ERROR_START_AKE]} {
-            return [list action display_reply \
-                         body   $message \
-                         send   [::otr::data::queryMessage $state(Policy)]]
+            return [list error $error \
+                         reply [list [::otr::data::queryMessage $state(Policy)]]]
         } else {
-            return [list action display \
-                         body   $message]
+            return [list error $error]
         }
     } elseif {![catch {::otr::data::findQueryMessage $message} versions] && \
                     [set version [FindVersion $token $versions]]} {
@@ -267,10 +270,9 @@
                         $state(x,$keyid) \
                         -sinstance $state(sinstance)] \
                         state(AuthState) state(MsgState) message
-        return [list action    reply \
-                     authstate $state(AuthState) \
+        return [list authstate $state(AuthState) \
                      msgstate  $state(MsgState) \
-                     send      $message]
+                     reply     [list $message]]
     } elseif {![catch {::otr::data::findWhitespaceTag $message} versions]} {
         # Plaintext with the whitespace tag
 
@@ -294,31 +296,29 @@
                             state(AuthState) state(MsgState) reply
             switch -- $state(MsgState) {
                 MSGSTATE_PLAINTEXT {
-                    return [list action    display_reply \
-                                 authstate $state(AuthState) \
+                    return [list authstate $state(AuthState) \
                                  msgstate  $state(MsgState) \
                                  body      $message \
-                                 send      $reply]
+                                 reply     [list $reply]]
                 }
                 MSGSTATE_ENCRYPTED -
                 MSGSTATE_FINISHED {
-                    return [list action    warn_reply \
-                                 authstate $state(AuthState) \
+                    return [list authstate $state(AuthState) \
                                  msgstate  $state(MsgState) \
+                                 warn      1 \
                                  body      $message \
-                                 send      $reply]
+                                 reply     [list $reply]]
                 }
             }
         } else {
             switch -- $state(MsgState) {
                 MSGSTATE_PLAINTEXT {
-                    return [list action display \
-                                 body   $message]
+                    return [list body $message]
                 }
                 MSGSTATE_ENCRYPTED -
                 MSGSTATE_FINISHED {
-                    return [list action warn \
-                                 body   $message]
+                    return [list warn 1 \
+                                 body $message]
                 }
             }
         }
@@ -329,13 +329,12 @@
 
         switch -- $state(MsgState) {
             MSGSTATE_PLAINTEXT {
-                return [list action display \
-                             body   $message]
+                return [list body $message]
             }
             MSGSTATE_ENCRYPTED -
             MSGSTATE_FINISHED {
-                return [list action warn \
-                             body   $message]
+                return [list warn 1 \
+                             body $message]
             }
         }
     }
@@ -347,7 +346,7 @@
 
     lassign $data version type binary sinstance rinstance
 
-    Debug $token 2 "$version $type"
+    Debug $token 2 "$version $type [::otr::data::Bin2Hex $binary]"
 
     if {![info exists state(version)]} {
         switch -- $type {
@@ -357,35 +356,35 @@
                 } elseif {$version == 2 && [queryPolicy $token ALLOW_V2]} {
                     set state(version) 2
                 } else {
-                    return [list action discard]
+                    return {}
                 }
             }
             3 {
-                return [list action reply \
-                             send [::otr::data::errorMessage \
-                                        "Unreadable encrypted message"]]
+                set error "Encrypted message can't be deciphered"
+                return [list info  $error \
+                             reply [list [::otr::data::errorMessage $error]]]
             }
             default {
-                return [list action discard]
+                return {}
             }
         }
     }
 
     if {$version != $state(version)} {
-        return [list action reply \
-                     send [::otr::data::errorMessage \
-                                    "Incorrect OTR protocol version"]]
+        set error "Unmatched protocol version"
+        return [list info $error \
+                     reply [list [::otr::data::errorMessage $error]]]
     }
 
     if {$version >= 3} {
         if {$sinstance < 0x100 || \
                 ($rinstance > 0 && $rinstance != $state(sinstance))} {
-            return [list action discard]
+            return {}
         }
         if {![info exists state(rinstance)]} {
             set state(rinstance) $sinstance
         } elseif {$sinstance != $state(rinstance)} {
-            return [list action discard]
+            return {}
         }
     } else {
         # Fake sinstance and rinstance for version 2
@@ -415,7 +414,7 @@
             return [ProcessSignatureMessage $token $binary]
         }
         default {
-            return [list action discard]
+            return {}
         }
     }
 }
@@ -447,14 +446,12 @@
             state(egxmpi) state(hgxmpi)
 
     if {$message eq ""} {
-        return [list action    discard
-                     authstate $state(AuthState) \
+        return [list authstate $state(AuthState) \
                      msgstate  $state(MsgState)]
     } else {
-        return [list action    reply \
-                     authstate $state(AuthState) \
+        return [list authstate $state(AuthState) \
                      msgstate  $state(MsgState) \
-                     send      $message]
+                     reply     [list $message]]
     }
 }
 
@@ -487,14 +484,12 @@
             state(AuthState) state(MsgState) message state(gy)
 
     if {$message eq ""} {
-        return [list action    discard \
-                     authstate $state(AuthState) \
+        return [list authstate $state(AuthState) \
                      msgstate  $state(MsgState)]
     } else {
-        return [list action reply \
-                     send   $message \
-                     authstate $state(AuthState) \
-                     msgstate  $state(MsgState)]
+        return [list authstate $state(AuthState) \
+                     msgstate  $state(MsgState) \
+                     reply     [list $message]]
     }
 }
 
@@ -519,17 +514,15 @@
             state(PublicKey) gy keyidy
 
     if {$message eq ""} {
-        return [list action    discard \
-                     authstate $state(AuthState) \
+        return [list authstate $state(AuthState) \
                      msgstate  $state(MsgState)]
     } else {
         UpdatePeerDHKeysAfterAKE $token $gy $keyidy
 
         # TODO: Send stored messages
-        return [list action reply \
-                     send   $message \
-                     authstate $state(AuthState) \
-                     msgstate  $state(MsgState)]
+        return [list authstate $state(AuthState) \
+                     msgstate  $state(MsgState) \
+                     reply     [list $message]]
     }
 }
 
@@ -554,8 +547,7 @@
 
         # TODO: Send stored messages
     }
-    return [list action    discard \
-                 authstate $state(AuthState) \
+    return [list authstate $state(AuthState) \
                  msgstate  $state(MsgState)]
 }
 
@@ -582,53 +574,117 @@
     variable $token
     upvar 0 $token state
 
+    set info "Encrypted message can't be deciphered"
+    set reply [list [::otr::data::errorMessage \
+                            "Encrypted message can't be deciphered"]]
+
     switch -- $state(MsgState) {
         MSGSTATE_ENCRYPTED {
             lassign [::otr::message::getDataMessageKeyids $data] skeyid rkeyid
 
             if {$skeyid <= 0 || $rkeyid <= 0} {
                 Debug $token 1 "Data message doesn't contain key serial numbers"
-                # TODO
-                return [list action display body "OTR encrypted message can't be deciphered"]
+                return [list info $info reply $reply]
             }
 
             if {$skeyid != $state(keyidy) && $skeyid != $state(keyidy)-1} {
                 Debug $token 1 "The sender's key serial number is unknown"
-                # TODO
-                return [list action display body "OTR encrypted message can't be deciphered"]
+                return [list info $info reply $reply]
             }
 
             if {$rkeyid != $state(keyid) && $rkeyid != $state(keyid)-1} {
                 Debug $token 1 "The recipient's key serial number is unknown"
-                # TODO
-                return [list action display body "OTR encrypted message can't be deciphered"]
+                return [list info $info reply $reply]
             }
 
             if {$state(gy,$skeyid) <= 0} {
                 Debug $token 1 "The sender's key with this serial number doesn't exist"
-                # TODO
-                return [list action display body "OTR encrypted message can't be deciphered"]
+                return [list info $info reply $reply]
             }
 
             # TODO: track and check if the peer's counter is monotonic
-            lassign [::otr::message::processDataMessage \
-                            $state(version) \
-                            $state(MsgState) \
-                            $state(SMPState) \
-                            $data \
-                            $skeyid \
-                            $rkeyid \
-                            $state(gy,$skeyid) \
-                            $state(x,$rkeyid) \
-                            -sinstance $state(sinstance) \
-                            -rinstance $state(rinstance)] \
-                    state(MsgState) state(SMPState) message gy
+            set result [::otr::message::processDataMessage \
+                                $state(version) \
+                                $state(MsgState) \
+                                $state(SMPState) \
+                                $data \
+                                $skeyid \
+                                $rkeyid \
+                                $state(gy,$skeyid) \
+                                $state(x,$rkeyid) \
+                                -smpcommand [namespace code [list SMPCallback $token]] \
+                                -sinstance $state(sinstance) \
+                                -rinstance $state(rinstance)]
 
-            if {$message eq ""} {
-                Debug 1 $token "Decrypted message is empty"
-                return [list action discard]
+            array set res $result
+
+            if {[info exists res(msgstate)]} {
+                set state(MsgState) $res(msgstate)
             }
+            if {[info exists res(smpstate)]} {
+                set state(SMPState) $res(smpstate)
+            }
 
+            if {[info exists res(debug)]} {
+                Debug 2 $token $res(debug)
+            }
+
+            set ret {}
+            foreach field {info error body} {
+                if {[info exists res($field)]} {
+                    lappend ret $field $res($field)
+                }
+            }
+            if {[info exists res(replyerr)]} {
+                lappend ret reply $res(replyerr)
+            }
+
+            if {[info exists res(info)] || [info exists res(error)] ||
+                    [info exists res(replyerr)]} {
+                return $ret
+            }
+
+            if {[info exists res(reply)]} {
+                switch -- $state(MsgState) {
+                    MSGSTATE_ENCRYPTED {
+                        # Auto reply makes sense only in encrypted state
+                        # The only example is SMP
+
+                        set repl {}
+                        foreach {body tlvlist} $res(reply) {
+                            # Key management 3
+
+                            set keyid1 [expr {$state(keyid)-1}]
+                            set keyid2 $state(keyid)
+                            set keyidy $state(keyidy)
+                            # TODO: reveal old MACs
+                            set message [::otr::message::createDataMessage \
+                                            $state(version) \
+                                            {} \
+                                            $keyid1 \
+                                            $keyidy \
+                                            $state(x,$keyid1) \
+                                            $state(x,$keyid2) \
+                                            $state(gy,$keyidy) \
+                                            [incr state(ctrtop)] \
+                                            $body \
+                                            $tlvlist \
+                                            -sinstance $state(sinstance) \
+                                            -rinstance $state(rinstance)]
+                            lappend repl $message
+                        }
+                        lappend ret reply $repl
+                    }
+                    default {
+                        # TODO
+                    }
+                }
+            }
+
+            if {![info exists res(body)]} {
+                Debug 2 $token "Decrypted message body is empty"
+            }
+
             switch -- $state(MsgState) {
                 MSGSTATE_ENCRYPTED {
                     # Keys rotation (key management 4)
@@ -646,7 +702,7 @@
                         incr skeyid -1
                         unset state(gy,$skeyid)
                         incr skeyid 2
-                        set state(gy,$skeyid) $gy
+                        set state(gy,$skeyid) $res(nextkey)
                         incr state(keyidy)
                     }
                 }
@@ -655,13 +711,11 @@
                 }
             }
 
-            # TODO: sometimes we want to send something back
-            return [list action display body $message]
+            return $ret
         }
         MSGSTATE_PLAIN -
         MSGSTATE_FINISHED {
-            # TODO
-            return [list action display body "OTR encrypted message was received"]
+            return [list info $info reply $reply]
         }
     }
 }
@@ -818,11 +872,65 @@
 # Side effects:
 #       None.
 
-proc ::otr::fingerprint {key} {
-    binary scan [::otr::crypto::DSAFingerprint $key] H* res
-    set res
+proc ::otr::fingerprint {token {me 0}} {
+    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
 }
 
+###########################################################################
+
+# ::otr::SMPCallback --
+
+proc ::otr::SMPCallback {token op {name ""} {val ""}} {
+    variable $token
+    upvar 0 $token state
+
+    switch -- $op {
+        clear {
+            array unset state smp,*
+            return ""
+        }
+        get {
+            switch -- $name {
+                privkey {
+                    # Our DSA key
+                    return $state(PrivateKey)
+                }
+                pubkey {
+                    # Peer's DSA key
+                    return $state(PublicKey)
+                }
+                default {
+                    if {[info exists state(smp,$name)]} {
+                        return $state(smp,$name)
+                    } else {
+                        return ""
+                    }
+                }
+            }
+        }
+        set {
+            set state(smp,$name) $val
+            return $val
+        }
+    }
+}
+
+###########################################################################
+
 # ::otr::Debug --
 #
 #       Prints debug information.

Modified: trunk/tkabber-plugins/otr/tclotr/smp.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-17 20:19:59 UTC (rev 2058)
+++ trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-18 18:35:20 UTC (rev 2059)
@@ -26,28 +26,63 @@
 
 # ::otr::smp::createSMPMessage1 --
 
-proc ::otr::smp::createSMPMessage1 {smpstate a2 a3 r2 r3 privkey pubkey gy dh usersecret} {
+proc ::otr::smp::createSMPMessage1 {smpstate privkey pubkey gy dh
+                                    usersecret args} {
     variable q
     variable g1
-    set x [Secret $privkey $pubkey $gy $dh $usersecret]
-    set g2a [Exp $g1 $a2]
-    set g3a [Exp $g1 $a3]
-    set c2 [Hash 1 [Exp $g1 $r2]]
-    set D2 [expr {($r2-$a2*$c2) % $q}]
-    set c3 [Hash 2 [Exp $g1 $r3]]
-    set D3 [expr {($r3-$a3*$c3) % $q}]
 
-    list SMPSTATE_EXPECT2 2 [Payload $g2a $c2 $D2 $g3a $c3 $D3] $x $a2 $a3
+    switch -- $smpstate {
+        SMPSTATE_EXPECT1 {
+            set a2 [::otr::crypto::random 128]
+            set a3 [::otr::crypto::random 128]
+            set r2 [::otr::crypto::random 128]
+            set r3 [::otr::crypto::random 128]
+
+            set prefix ""
+            set type 2
+            foreach {key val} $args {
+                switch -- $key {
+                    -question {
+                        set prefix [encoding convertto utf-8 $val]\x00
+                        set type 7
+                    }
+                }
+            }
+
+            set x [Secret $privkey $pubkey $gy $dh $usersecret]
+            set g2a [Exp $g1 $a2]
+            set g3a [Exp $g1 $a3]
+            set c2 [Hash 1 [Exp $g1 $r2]]
+            set D2 [expr {($r2-$a2*$c2) % $q}]
+            set c3 [Hash 2 [Exp $g1 $r3]]
+            set D3 [expr {($r3-$a3*$c3) % $q}]
+
+            return [list SMPSTATE_EXPECT2 $type \
+                         $prefix[Payload $g2a $c2 $D2 $g3a $c3 $D3] \
+                         $x $a2 $a3]
+        }
+        default {
+        }
+    }
 }
 
 # ::otr::smp::processSMPMessage1 --
 
-proc ::otr::smp::processSMPMessage1 {smpstate data b2 b3 r2 r3 r4 r5 r6 privkey pubkey gy dh usersecret} {
+proc ::otr::smp::processSMPMessage1 {smpstate data privkey pubkey gy dh
+                                     usersecret} {
     variable q
     variable g1
 
     switch -- $smpstate {
         SMPSTATE_EXPECT1 {
+            set b2 [::otr::crypto::random 128]
+            set b3 [::otr::crypto::random 128]
+            set r2 [::otr::crypto::random 128]
+            set r3 [::otr::crypto::random 128]
+            set r4 [::otr::crypto::random 128]
+            set r5 [::otr::crypto::random 128]
+            set r6 [::otr::crypto::random 128]
+
             if {[catch {ParsePayload $data} res]} {
                 puts "Parse of SMP message 1 failed"
                 return [list $smpstate 6 ""]
@@ -87,9 +122,10 @@
             set D5 [expr {($r5-$r4*$cP) % $q}]
             set D6 [expr {($r6-$y*$cP) % $q}]
 
-            return [list SMPSTATE_EXPECT3 3 \
-                         [Payload $g2b $c2 $D2 $g3b $c3 $D3 $Pb $Qb $cP $D5 $D6] \
-                         $g3a $g2 $g3 $b3 $Pb $Qb]
+            return \
+                [list SMPSTATE_EXPECT3 3 \
+                      [Payload $g2b $c2 $D2 $g3b $c3 $D3 $Pb $Qb $cP $D5 $D6] \
+                      $g3a $g2 $g3 $b3 $Pb $Qb]
         }
         default {
             # Abort SMP
@@ -100,12 +136,17 @@
 
 # ::otr::smp::processSMPMessage2 --
 
-proc ::otr::smp::processSMPMessage2 {smpstate data r4 r5 r6 r7 x a2 a3} {
+proc ::otr::smp::processSMPMessage2 {smpstate data x a2 a3} {
     variable q
     variable g1
 
     switch -- $smpstate {
         SMPSTATE_EXPECT2 {
+            set r4 [::otr::crypto::random 128]
+            set r5 [::otr::crypto::random 128]
+            set r6 [::otr::crypto::random 128]
+            set r7 [::otr::crypto::random 128]
+
             if {[catch {ParsePayload $data} res]} {
                 puts "Parse of SMP message 2 failed"
                 return [list $smpstate 6 ""]
@@ -165,12 +206,14 @@
 
 # ::otr::smp::processSMPMessage3 --
 
-proc ::otr::smp::processSMPMessage3 {smpstate data r7 g3a g2 g3 b3 Pb Qb} {
+proc ::otr::smp::processSMPMessage3 {smpstate data g3a g2 g3 b3 Pb Qb} {
     variable q
     variable g1
 
     switch -- $smpstate {
         SMPSTATE_EXPECT3 {
+            set r7 [::otr::crypto::random 128]
+
             if {[catch {ParsePayload $data} res]} {
                 puts "Parse of SMP message 3 failed"
                 return [list $smpstate 6 ""]



More information about the Tkabber-dev mailing list