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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Jan 19 14:10:14 MSK 2014


Author: sergei
Date: 2014-01-19 14:10:14 +0400 (Sun, 19 Jan 2014)
New Revision: 2061

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: Fixed checking data message hash for protocol
	  version 3.

	* otr/tclotr/message.tcl: Fixed typo in processing SMP message 4.
	  Fixed error reporting.

	* otr/otr.tcl: Enabled starting SMP with shared secret.

	* otr/*: Continue developing OTR plugin.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-19 07:51:16 UTC (rev 2060)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-19 10:10:14 UTC (rev 2061)
@@ -1,3 +1,15 @@
+2014-01-19  Sergei Golovan <sgolovan at nes.ru>
+
+	* otr/tclotr/otr.tcl: Fixed checking data message hash for protocol
+	  version 3.
+
+	* otr/tclotr/message.tcl: Fixed typo in processing SMP message 4.
+	  Fixed error reporting.
+
+	* otr/otr.tcl: Enabled starting SMP with shared secret.
+
+	* otr/*: Continue developing OTR plugin.
+
 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 07:51:16 UTC (rev 2060)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-19 10:10:14 UTC (rev 2061)
@@ -395,7 +395,7 @@
     wm resizable $w 0 0
 
     $w add -text [::msgcat::mc "Authenticate"] \
-	   -command [namespace code [list start_smp $w $xlib $jid]]
+	   -command [namespace code [list begin_smp $w $xlib $jid]]
     $w add -text [::msgcat::mc "Cancel"] \
 	   -command [list destroy $w]
 
@@ -527,6 +527,35 @@
 	    -type user -buttons ok -default 0 -cancel 0
 	return
     }
+
+    set f [$w getframe]
+    set pm $f.method
+
+    set page [$pm raise]
+
+    set pf [$pm getframe $page]
+    switch -- $page {
+	qa  {
+	    set secret [$pf.e2 get]
+	    set question [list -question [$pf.e1 get]]
+	}
+	ss  {
+	    set secret [$pf.e3 get]
+	    set question {}
+	}
+	mfv { return }
+    }
+
+    set result [::otr::startSMP $ctx($xlib,$jid) $secret {*}$question]
+    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)
+	}
+    }
 }
 
 #############################################################################
@@ -716,6 +745,8 @@
     set jid [chat::get_jid $chatid]
     set cw [chat::winid $chatid]
 
+    once_only $xlib $jid
+
     Button $cw.status.otrmsgstate \
 	   -relief flat \
            -image [msgstate:icon $xlib $jid] \

Modified: trunk/tkabber-plugins/otr/tclotr/message.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-19 07:51:16 UTC (rev 2060)
+++ trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-19 10:10:14 UTC (rev 2061)
@@ -84,7 +84,6 @@
     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]
@@ -124,14 +123,14 @@
 
     if {[catch {parseDataMessage $data} res]} {
         return [list debug "Parsing data message failed: $res" \
-                     info $info replyerr [list $error]]
+                     info $info replyerr $error]
     }
 
     lassign $res flags skeyid rkeyid gy ctrtop cryptotext hmac oldmackeys
 
     if {$skeyid != $skeyid1 || $rkeyid != $rkeyid1} {
         return [list debug "Serials don't match" \
-                     info $info replyerr [list $error]]
+                     info $info replyerr $error]
     }
 
     # Reassemble the message and verify its hash
@@ -162,7 +161,7 @@
 
     if {$myhmac ne $hmac} {
         return [list debug "Data message hash verification failed" \
-                     info $info replyerr [list $error]]
+                     info $info replyerr $error]
     }
 
     # Decrypt yhe payload and parse it
@@ -171,7 +170,7 @@
 
     if {[catch {parseDataMessagePlaintext $plaintext} res]} {
         return [list debug "Data message plaintext decoding failed: $res" \
-                     info $info replyerr [list $error]]
+                     info $info replyerr $error]
     }
 
     lassign $res message tlvlist
@@ -273,7 +272,7 @@
                              {*}$msg]
             }
             4 {
-                # SMP message 3 g3a g2 g3 b3 Pb Qb
+                # SMP message 3
 
                 set g3a [uplevel #0 $smpcommand get g3a]
                 set g2  [uplevel #0 $smpcommand get g2]
@@ -307,7 +306,7 @@
                 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 QaQb [uplevel #0 $smpcommand get QaQb]
                 set Ra   [uplevel #0 $smpcommand get Ra]
                 lassign [::otr::smp::processSMPMessage4 \
                                 $smpstate $value $a3 $g3b $PaPb $QaQb $Ra] \
@@ -441,16 +440,23 @@
 #       None.
 
 proc ::otr::message::getDataMessageKeyids {data} {
+    variable Flags
+
     if {![catch {
             lassign [::otr::data::decode BYTE $data] binflags data
+            set flags {}
+            foreach f [array names Flags] {
+                if {[expr {$binflags & $Flags($f)}]} {
+                    lappend flags $f
+                }
+            }
             lassign [::otr::data::decode INT $data] skeyid data
             lassign [::otr::data::decode INT $data] rkeyid
-            list $skeyid $rkeyid
+            list $flags $skeyid $rkeyid
          } res]} {
         return $res
     } else {
-        #puts $res
-        return {0 0}
+        return {{} 0 0}
     }
 }
 
@@ -475,7 +481,6 @@
 # ::otr::message::parseDataMessagePlaintext --
 
 proc ::otr::message::parseDataMessagePlaintext {data} {
-    binary scan $data H* t ; puts "Plaintext: $t"
     set tlvlist {}
     set idx [string first \x00 $data]
     if {$idx < 0} {

Modified: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-19 07:51:16 UTC (rev 2060)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-19 10:10:14 UTC (rev 2061)
@@ -51,6 +51,8 @@
     variable debug 0
 }
 
+##############################################################################
+
 # ::otr::new --
 #
 #       Create new OTR instance.
@@ -107,6 +109,8 @@
     unset -nocomplain state
 }
 
+##############################################################################
+
 proc ::otr::setPolicy {token policy} {
     variable $token
     upvar 0 $token state
@@ -127,6 +131,91 @@
     expr {$item in $state(Policy)}
 }
 
+##############################################################################
+
+# ::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)"
+        }
+    }
+}
+
+##############################################################################
+
 proc ::otr::requestConversation {token} {
     variable $token
     upvar $token state
@@ -143,24 +232,10 @@
             return [list action discard]
         }
         MSGSTATE_ENCRYPTED {
-            # 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)] \
-                                        "" \
-                                        {1 ""} \
-                                        -sinstance $state(sinstance) \
-                                        -rinstance $state(rinstance)]
+            set message [CreateEncryptedMessage \
+                                $token \
+                                {apply {{token i1 i2}
+                                        {return {{} "" {1 ""}}}}}]
             set state(MsgState) MSGSTATE_PLAINTEXT
             InitDHKeys $token
             return [list action   send \
@@ -174,62 +249,78 @@
     }
 }
 
-proc ::otr::outgoingMessage {token message} {
+##############################################################################
+
+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) {
+        MSGSTATE_ENCRYPTED {
+            set message [CreateEncryptedMessage \
+                             $token \
+                             [namespace code \
+                                        [list CreateSMP1 $question $secret]]]
+            # CreateSMP changes SMPState
+            return [list action   send \
+                         body     $message \
+                         smpstate $state(SMPState)]
+        }
+        default {
+            return [list action discard]
+        }
+    }
+}
+
+##############################################################################
+
+proc ::otr::outgoingMessage {token body} {
+    variable $token
     upvar 0 $token state
 
     switch -- $state(MsgState) {
         MSGSTATE_PLAINTEXT {
             if {[queryPolicy $token REQUIRE_ENCRYPTION]} {
-                Store $token $message
+                Store $token $body
                 return [list action send \
                              body [::otr::data::queryMessage $state(Policy)]]
             } elseif {[queryPolicy $token SEND_WHITESPACE_TAG]} {
                 return [list action send \
-                             body "$message[::otr::data::whitespaceTag \
-                                                    $state(Policy)]"]
+                             body "$body[::otr::data::whitespaceTag \
+                                                        $state(Policy)]"]
             } else {
-                return [list action send body $message]
+                return [list action send body $body]
             }
         }
         MSGSTATE_ENCRYPTED {
-            Store $token $message
-
-            # Key management 3
-            set keyid1 [expr {$state(keyid)-1}]
-            set keyid2 $state(keyid)
-            set keyidy $state(keyidy)
-            # TODO: reveal old MACs
-            set tlvlist {}
-            set bl [string bytelength $message]
-            if {$bl < 59} {
-                set l [expr {(59-$bl)*8}]
-                set tlvlist \
-                    [list 0 [::otr::crypto::Int2Octets [::otr::crypto::random $l] $l]]
-            }
-            set message [::otr::message::createDataMessage \
-                                        $state(version) \
-                                        {} \
-                                        $keyid1 \
-                                        $keyidy \
-                                        $state(x,$keyid1) \
-                                        $state(x,$keyid2) \
-                                        $state(gy,$keyidy) \
-                                        [incr state(ctrtop)] \
-                                        $message \
-                                        $tlvlist \
-                                        -sinstance $state(sinstance) \
-                                        -rinstance $state(rinstance)]
+            Store $token $body
+            set message [CreateEncryptedMessage \
+                             $token \
+                             [list apply \
+                                   [list {token i1 i2} \
+                                         [list return [list {} $body {}]]]]]
             return [list action send \
                          body   $message]
         }
         MSGSTATE_FINISHED {
-            Store $token $message
-            return [list action stop error "Can't send message"]
+            Store $token $body
+            return [list action stop info "Can't send message when OTR\
+                                           conversation is in finished state"]
         }
     }
 }
 
+##############################################################################
+
 proc ::otr::incomingMessage {token message} {
     variable $token
     upvar 0 $token state
@@ -344,6 +435,9 @@
     variable $token
     upvar 0 $token state
 
+    # Here sinstance is a remote instance tag, rinstance is ours,
+    # because the message is incoming
+
     lassign $data version type binary sinstance rinstance
 
     Debug $token 2 "$version $type [::otr::data::Bin2Hex $binary]"
@@ -360,6 +454,7 @@
                 }
             }
             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]]]
@@ -372,6 +467,7 @@
 
     if {$version != $state(version)} {
         set error "Unmatched protocol version"
+        Debug $token 1 $error
         return [list info $error \
                      reply [list [::otr::data::errorMessage $error]]]
     }
@@ -575,13 +671,14 @@
     upvar 0 $token state
 
     set info "Encrypted message can't be deciphered"
-    set reply [list [::otr::data::errorMessage \
-                            "Encrypted message can't be deciphered"]]
+    set reply [list [::otr::data::errorMessage $info]]
 
     switch -- $state(MsgState) {
         MSGSTATE_ENCRYPTED {
-            lassign [::otr::message::getDataMessageKeyids $data] skeyid rkeyid
+            lassign [::otr::message::getDataMessageKeyids $data] flags skeyid rkeyid
 
+            # TODO: Check message flags
+
             if {$skeyid <= 0 || $rkeyid <= 0} {
                 Debug $token 1 "Data message doesn't contain key serial numbers"
                 return [list info $info reply $reply]
@@ -613,8 +710,8 @@
                                 $state(gy,$skeyid) \
                                 $state(x,$rkeyid) \
                                 -smpcommand [namespace code [list SMPCallback $token]] \
-                                -sinstance $state(sinstance) \
-                                -rinstance $state(rinstance)]
+                                -sinstance $state(rinstance) \
+                                -rinstance $state(sinstance)]
 
             array set res $result
 
@@ -630,7 +727,7 @@
             }
 
             set ret {}
-            foreach field {info error body} {
+            foreach field {msgstate smpstate info error body} {
                 if {[info exists res($field)]} {
                     lappend ret $field $res($field)
                 }
@@ -648,30 +745,16 @@
                 switch -- $state(MsgState) {
                     MSGSTATE_ENCRYPTED {
                         # Auto reply makes sense only in encrypted state
-                        # The only example is SMP
+                        # The only existing example so far 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 repl \
+                                [CreateEncryptedMessage \
+                                    $token \
+                                    [list apply \
+                                          [list {token i1 i2} \
+                                                [list return [list {} $body $tlvlist]]]]]
                         }
                         lappend ret reply $repl
                     }
@@ -744,6 +827,54 @@
     unset -nocomplain state(version)
 }
 
+##############################################################################
+
+proc ::otr::CreateSMP1 {question secret token i1 i2} {
+    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) \
+                                           $state(gy,$i2) \
+                                           $state(x,$i1) \
+                                           $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]
+}
+
+proc ::otr::CreateEncryptedMessage {token command} {
+    variable $token
+    upvar $token state
+
+    # Key management 3
+    set keyid1 [expr {$state(keyid)-1}]
+    set keyid2 $state(keyid)
+    set keyidy $state(keyidy)
+    # TODO: reveal old MACs
+
+    # Sometimes the message body is created using the D-H keys currently in use
+
+    lassign [uplevel #0 $command $token $keyid1 $keyidy] flags body tlvlist
+
+    ::otr::message::createDataMessage \
+            $state(version) $flags $keyid1 $keyidy $state(x,$keyid1) \
+            $state(x,$keyid2) $state(gy,$keyidy) [incr state(ctrtop)] \
+            $body $tlvlist \
+            -sinstance $state(sinstance) \
+            -rinstance $state(rinstance)
+}
+
 # ::otr::FindVersion --
 #
 #       Check if the given versions list contains one of the supported.
@@ -786,69 +917,6 @@
     set state(r) [::otr::crypto::Int2Octets [::otr::crypto::random 128] 128]
 }
 
-# ::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]
-            }
-            set psize [expr {$size - 18}]
-            if {$psize <= 0} {
-                return -code error "Too small chunk size, must be at least 19"
-            }
-            set n [expr {([string length $data]+$psize-1)/$psize}]
-            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 psize [expr {$size - 36}]
-            if {$psize <= 0} {
-                return -code error "Too small chunk size, must be at least 37"
-            }
-            set sinstance $state(sinstance)
-            set rinstance [expr {[info exists state(rinstance)]? \
-                                 $state(rinstance) : 0}]
-            set n [expr {([string length $data]+$psize-1)/$psize}]
-            set res {}
-            set k 1
-            set id1 0
-            set id2 [expr {$psize-1}]
-            while {$k <= $n} {
-                lappend res [format "?OTR|%x|%x,%hu,%hu,%s," \
-                                    $sinstance $rinstance \
-                                    $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::Store --
 
 proc ::otr::Store {token message} {

Modified: trunk/tkabber-plugins/otr/tclotr/smp.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-19 07:51:16 UTC (rev 2060)
+++ trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-19 10:10:14 UTC (rev 2061)
@@ -62,6 +62,7 @@
                          $x $a2 $a3]
         }
         default {
+            # TODO
         }
     }
 }



More information about the Tkabber-dev mailing list