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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Jan 19 22:42:57 MSK 2014


Author: sergei
Date: 2014-01-19 22:42:57 +0400 (Sun, 19 Jan 2014)
New Revision: 2064

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
   trunk/tkabber-plugins/otr/tclotr/smp.tcl
Log:
	* otr/tclotr/otr.tcl: Don't attach the OTR whitespace tag if policy
	  doesn't allow using any protocol version.

	* otr/otr.tcl, otr/tclotr/message.tcl, otr/tclotr/otr.tcl,
	  otr/tclotr/smp.tcl: Roughly finished SMP implementation. No peer
	  authentication status storing yet though.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-19 13:55:55 UTC (rev 2063)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-19 18:42:57 UTC (rev 2064)
@@ -16,6 +16,13 @@
 	* otr/otr.tcl, otr/tclotr/message.tcl: Got rid of eval and uplevel
 	  calls.
 
+	* otr/tclotr/otr.tcl: Don't attach the OTR whitespace tag if policy
+	  doesn't allow using any protocol version.
+
+	* otr/otr.tcl, otr/tclotr/message.tcl, otr/tclotr/otr.tcl,
+	  otr/tclotr/smp.tcl: Roughly finished SMP implementation. No peer
+	  authentication status storing yet though.
+
 2014-01-18  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/*: Better error reporting. Continue implementing peer

Modified: trunk/tkabber-plugins/otr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/otr.tcl	2014-01-19 13:55:55 UTC (rev 2063)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-19 18:42:57 UTC (rev 2064)
@@ -368,8 +368,6 @@
 proc otr::begin_smp_dialog {xlib jid} {
     variable ctx
 
-    once_only $xlib $jid
-
     set w .otrstartauth[jid_to_tag $jid]
     set bjid [::xmpp::jid::removeResource $jid]
 
@@ -423,6 +421,10 @@
     grid $l2 -row 3 -column 0 -sticky nsw
     set e2 [entry $pf1.e2]
     grid $e2 -row 4 -column 0 -sticky nswe
+    ProgressBar $pf1.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
+    grid $pf1.pb -row 5 -column 0 -sticky ew
+    set l4 [label $pf1.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
+    grid $l4 -row 6 -column 0
 
     $pm add ss
     set pf2 [$pm getframe ss]
@@ -437,7 +439,15 @@
     grid $l3 -row 1 -column 0 -sticky nsw
     set e3 [entry $pf2.e3]
     grid $e3 -row 2 -column 0 -sticky nswe
+    ProgressBar $pf2.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
+    grid $pf2.pb -row 3 -column 0 -sticky ew
+    set l4 [label $pf2.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
+    grid $l4 -row 4 -column 0
 
+    set ctx(progress,$xlib,$jid) 0
+    set ctx(status,$xlib,$jid) ""
+    set ctx(smpdialog,$xlib,$jid) $w
+
     $pm add mfv
     set pf3 [$pm getframe mfv]
     set m3 [message $pf3.instr -text [::msgcat::mc "To verify the fingerprint, contact\
@@ -494,8 +504,6 @@
 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\
@@ -512,18 +520,26 @@
 	return
     }
 
+    $w itemconfigure 0 -state disabled
+    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]
+
     set f [$w getframe]
     set pm $f.method
 
+    $f.choice configure -state disabled
+
     set page [$pm raise]
 
     set pf [$pm getframe $page]
     switch -- $page {
 	qa  {
+	    $pf.e1 configure -state readonly
+	    $pf.e2 configure -state readonly
 	    set secret [$pf.e2 get]
 	    set question [list -question [$pf.e1 get]]
 	}
 	ss  {
+	    $pf.e3 configure -state readonly
 	    set secret [$pf.e3 get]
 	    set question {}
 	}
@@ -547,8 +563,6 @@
 proc otr::reply_smp_dialog_qa {xlib jid question} {
     variable ctx
 
-    once_only $xlib $jid
-
     set w .otrreplauth[jid_to_tag $jid]
     set bjid [::xmpp::jid::removeResource $jid]
 
@@ -588,14 +602,21 @@
     grid $l2 -row 5 -column 0 -sticky nsw
     set e1 [entry $f.e1]
     grid $e1 -row 6 -column 0 -sticky nswe
+    ProgressBar $f.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
+    grid $f.pb -row 7 -column 0 -sticky ew
+    set l4 [label $f.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
+    grid $l4 -row 8 -column 0
+
+    set ctx(progress,$xlib,$jid) 0
+    set ctx(status,$xlib,$jid) ""
+    set ctx(smpdialog,$xlib,$jid) $w
+
     $w draw
 }
 
 proc otr::reply_smp_dialog_ss {xlib jid} {
     variable ctx
 
-    once_only $xlib $jid
-
     set w .otrreplauth[jid_to_tag $jid]
     set bjid [::xmpp::jid::removeResource $jid]
 
@@ -631,15 +652,21 @@
     grid $l3 -row 3 -column 0 -sticky nsw
     set e1 [entry $f.e1]
     grid $e1 -row 4 -column 0 -sticky nswe
+    ProgressBar $f.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
+    grid $f.pb -row 5 -column 0 -sticky ew
+    set l4 [label $f.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
+    grid $l4 -row 6 -column 0
 
+    set ctx(status,$xlib,$jid) ""
+    set ctx(progress,$xlib,$jid) 0
+    set ctx(smpdialog,$xlib,$jid) $w
+
     $w draw
 }
 
 proc otr::reply_smp {w xlib jid} {
     variable ctx
 
-    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\
@@ -656,7 +683,11 @@
 	return
     }
 
+    $w itemconfigure 0 -state disabled
+    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]
+
     set f [$w getframe]
+    $f.e1 configure -state readonly
     set secret [$f.e1 get]
 
     set result [::otr::replySMP $ctx($xlib,$jid) $secret]
@@ -669,8 +700,78 @@
 	    set ctx($state,$xlib,$jid) $res($state)
 	}
     }
+    if {[info exists res(smpprogress)]} {
+	progress_smp $xlib $jid $res(smpprogress)
+    }
 }
 
+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 {$res(action) eq "send"} {
+	    ::xmpp::sendMessage $xlib $jid -body $res(body)
+	}
+	foreach state {authstate msgstate smpstate} {
+	    if {[info exists res($state)]} {
+		set ctx($state,$xlib,$jid) $res($state)
+	    }
+	}
+	if {[info exists res(smpprogress)]} {
+	    progress_smp $xlib $jid $res(smpprogress)
+	}
+    }
+
+    destroy $w
+}
+
+proc otr::result_smp {w xlib jid} {
+    variable ctx
+
+    # TODO: delete status and progress vars
+    $w itemconfigure 0 -state normal -text [::msgcat::mc "OK"] -command [list destroy $w]
+    $w itemconfigure 1 -state disabled -command [list destroy $w]
+}
+
+proc otr::progress_smp {xlib jid progress} {
+    variable ctx
+
+    puts "$xlib $jid $progress"
+
+    if {![info exists ctx(smpdialog,$xlib,$jid)]} return
+
+    set w $ctx(smpdialog,$xlib,$jid)
+
+    # TODO: Call out after the finish
+    switch -- $progress {
+	SMP_PROGRESS {
+	    incr ctx(progress,$xlib,$jid)
+	}
+	SMP_ABORT {
+	    set ctx(progress,$xlib,$jid) 3
+	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication aborted"]
+	    result_smp $w $xlib $jid
+	}
+	SMP_CHEATING {
+	    set ctx(progress,$xlib,$jid) 3
+	    set ctx(status,$xlib,$jid) [::msgcat::mc "Protocol error"]
+	    result_smp $w $xlib $jid
+	}
+	SMP_SUCCESS {
+	    set ctx(progress,$xlib,$jid) 3
+	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication succeeded"]
+	    result_smp $w $xlib $jid
+	}
+	SMP_FAILURE {
+	    set ctx(progress,$xlib,$jid) 3
+	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication failed"]
+	    result_smp $w $xlib $jid
+	}
+    }
+}
+
 #############################################################################
 
 proc otr::rewrite_message_body \
@@ -708,6 +809,10 @@
 	}
     }
 
+    if {[info exists res(smpprogress)]} {
+	progress_smp $xlib $from $res(smpprogress)
+    }
+
     if {[info exists res(error)]} {
 	set type error
 	set body ""

Modified: trunk/tkabber-plugins/otr/tclotr/message.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-19 13:55:55 UTC (rev 2063)
+++ trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-19 18:42:57 UTC (rev 2064)
@@ -202,8 +202,9 @@
                 set msgstate MSGSTATE_FINISHED
                 set smpstate SMPSTATE_EXPECT1
                 {*}$smpcommand clear
-                return [list msgstate $msgstate \
-                             smpstate $smpstate \
+                return [list msgstate    $msgstate \
+                             smpstate    $smpstate \
+                             smpprogress SMP_ABORT \
                              {*}$msg]
             }
         }
@@ -246,11 +247,11 @@
                     {*}$smpcommand set Ra   $Ra
                     set answer SMP_PROGRESS
                 }
-                return [list msgstate $msgstate \
-                             smpstate $smpstate \
-                             nextkey  $gy \
-                             smpprogr $answer \
-                             reply    [list "" [list $tlv $payload]] \
+                return [list msgstate    $msgstate \
+                             smpstate    $smpstate \
+                             nextkey     $gy \
+                             smpprogress $answer \
+                             reply       [list "" [list $tlv $payload]] \
                              {*}$msg]
             }
             4 {
@@ -275,11 +276,11 @@
                         set answer SMP_FAILURE
                     }
                 }
-                return [list msgstate $msgstate \
-                             smpstate $smpstate \
-                             nextkey  $gy \
-                             spmprogr $answer \
-                             reply    [list "" [list $tlv $payload]] \
+                return [list msgstate    $msgstate \
+                             smpstate    $smpstate \
+                             nextkey     $gy \
+                             smpprogress $answer \
+                             reply       [list "" [list $tlv $payload]] \
                              {*}$msg]
             }
             5 {
@@ -306,11 +307,11 @@
                     }
                     set tlvp {}
                 }
-                return [list msgstate $msgstate \
-                             smpstate $smpstate \
-                             nextkey  $gy \
-                             smpprogr $answer \
-                             reply    [list "" $tlvp] \
+                return [list msgstate    $msgstate \
+                             smpstate    $smpstate \
+                             nextkey     $gy \
+                             smpprogress $answer \
+                             reply       [list "" $tlvp] \
                              {*}$msg]
             }
             6 {
@@ -318,10 +319,10 @@
 
                 set smpstate SMPSTATE_EXPECT1
                 {*}$smpcommand clear
-                return [list msgstate $msgstate \
-                             smpstate $smpstate \
-                             nextkey  $gy \
-                             smpprogr SMP_ABORT \
+                return [list msgstate    $msgstate \
+                             smpstate    $smpstate \
+                             nextkey     $gy \
+                             smpprogress SMP_ABORT \
                              {*}$msg]
             }
             7 {
@@ -333,11 +334,11 @@
                 if {$idx < 0} {
                     set smpstate SMPSTATE_EXPECT1
                     {*}$smpcommand clear
-                    return [list msgstate $msgstate \
-                                 smpstate $smpstate \
-                                 nextkey  $gy \
-                                 smpprogr SMP_CHEATING \
-                                 reply    {"" {6 ""}} \
+                    return [list msgstate    $msgstate \
+                                 smpstate    $smpstate \
+                                 nextkey     $gy \
+                                 smpprogress SMP_CHEATING \
+                                 reply       {"" {6 ""}} \
                                  {*}$msg]
                 }
                 set question [encoding convertfrom utf-8 \

Modified: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-19 13:55:55 UTC (rev 2063)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-19 18:42:57 UTC (rev 2064)
@@ -263,16 +263,17 @@
 
     switch -- $state(MsgState) {
         MSGSTATE_ENCRYPTED {
-            lassign [CreateSMP1 $question $secret $token] flags body tlvlist
+            lassign [CreateSMP1 $question $secret $token] \
+                    state(SMPState) progress flags body tlvlist
             set message [CreateEncryptedMessage $token $flags $body $tlvlist]
 
-            # CreateSMP1 changes SMPState
-            return [list action   send \
-                         body     $message \
-                         smpstate $state(SMPState)]
+            return [list action      send \
+                         body        $message \
+                         smpstate    $state(SMPState) \
+                         smpprogress $progress]
         }
         default {
-            return [list action discard]
+            return [list action discard smpprogress SMP_ABORT]
         }
     }
 }
@@ -283,20 +284,41 @@
 
     switch -- $state(MsgState) {
         MSGSTATE_ENCRYPTED {
-            lassign [CreateSMP2 $secret $token] flags body tlvlist
+            lassign [CreateSMP2 $secret $token] \
+                    state(SMPState) progress flags body tlvlist
             set message [CreateEncryptedMessage $token $flags $body $tlvlist]
 
-            # CreateSMP2 changes SMPState
-            return [list action   send \
-                         body     $message \
-                         smpstate $state(SMPState)]
+            return [list action      send \
+                         body        $message \
+                         smpstate    $state(SMPState) \
+                         smpprogress $progress]
         }
         default {
-            return [list action discard]
+            return [list action discard smpprogress SMP_ABORT]
         }
     }
 }
 
+proc ::otr::abortSMP {token} {
+    variable $token
+    upvar $token state
+
+    switch -- $state(MsgState) {
+        MSGSTATE_ENCRYPTED {
+            set message [CreateEncryptedMessage $token {} "" {6 ""}]
+
+            set state(SMPState) SMPSTATE_EXPECT1
+            return [list action      send \
+                         body        $message \
+                         smpstate    $state(SMPState) \
+                         smpprogress SMP_ABORT]
+        }
+        default {
+            return [list action discard smpprogress SMP_ABORT]
+        }
+    }
+}
+
 ##############################################################################
 
 proc ::otr::outgoingMessage {token body} {
@@ -309,7 +331,9 @@
                 Store $token $body
                 return [list action send \
                              body [::otr::data::queryMessage $state(Policy)]]
-            } elseif {[queryPolicy $token SEND_WHITESPACE_TAG]} {
+            } elseif {[queryPolicy $token SEND_WHITESPACE_TAG] &&
+                      ([queryPolicy $token ALLOW_V2] ||
+                       [queryPolicy $token ALLOW_V3])} {
                 return [list action send \
                              body "$body[::otr::data::whitespaceTag \
                                                         $state(Policy)]"]
@@ -755,7 +779,8 @@
             }
 
             set ret {}
-            foreach field {msgstate smpstate info error body interaction question} {
+            foreach field {msgstate smpstate smpprogress info error body
+                           interaction question} {
                 if {[info exists res($field)]} {
                     lappend ret $field $res($field)
                 }
@@ -817,7 +842,6 @@
                     InitDHKeys $token
                 }
             }
-
             return $ret
         }
         MSGSTATE_PLAIN -
@@ -869,32 +893,44 @@
                                            $state(ssid) \
                                            $secret \
                                            {*}$quest] \
-            state(SMPState) type payload x a2 a3
-    SMPCallback $token set x  $x
-    SMPCallback $token set a2 $a2
-    SMPCallback $token set a3 $a3
-    list {} "" [list $type $payload]
+            smpstate type payload x a2 a3
+    if {$type == 6} {
+        SMPCallback $token clear
+        set progress SMP_ABORT
+    } else {
+        SMPCallback $token set x  $x
+        SMPCallback $token set a2 $a2
+        SMPCallback $token set a3 $a3
+        set progress SMP_PROGRESS
+    }
+    list $smpstate $progress {} "" [list $type $payload]
 }
 
 proc ::otr::CreateSMP2 {secret token} {
     variable $token
     upvar $token state
 
-    set data1     [SMPCallback $token get data1]
+    set data1 [SMPCallback $token get data1]
     lassign [::otr::smp::processSMPMessage1 $state(SMPState) \
                                             $data1 \
                                             $state(PrivateKey) \
                                             $state(PublicKey) \
                                             $state(ssid) \
                                             $secret] \
-            state(SMPState) type payload g3a g2 g3 b3 Pb Qb
-    SMPCallback $token set g3a $g3a
-    SMPCallback $token set g2  $g2
-    SMPCallback $token set g3  $g3
-    SMPCallback $token set b3  $b3
-    SMPCallback $token set Pb  $Pb
-    SMPCallback $token set Qb  $Qb
-    list {} "" [list $type $payload]
+            smpstate type payload g3a g2 g3 b3 Pb Qb
+    if {$type == 6} {
+        SMPCallback $token clear
+        set progress SMP_ABORT
+    } else {
+        SMPCallback $token set g3a $g3a
+        SMPCallback $token set g2  $g2
+        SMPCallback $token set g3  $g3
+        SMPCallback $token set b3  $b3
+        SMPCallback $token set Pb  $Pb
+        SMPCallback $token set Qb  $Qb
+        set progress SMP_PROGRESS
+    }
+    list $smpstate $progress {} "" [list $type $payload]
 }
 
 ##############################################################################

Modified: trunk/tkabber-plugins/otr/tclotr/smp.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-19 13:55:55 UTC (rev 2063)
+++ trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-19 18:42:57 UTC (rev 2064)
@@ -62,7 +62,7 @@
                          $x $a2 $a3]
         }
         default {
-            # TODO
+            return {SMPSTATE_EXPECT1 6 ""}
         }
     }
 }



More information about the Tkabber-dev mailing list