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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Jan 22 21:46:51 MSK 2014


Author: sergei
Date: 2014-01-22 21:46:51 +0400 (Wed, 22 Jan 2014)
New Revision: 2077

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/otr/auth.tcl
   trunk/tkabber-plugins/otr/otr.tcl
   trunk/tkabber-plugins/otr/tclotr/otr.tcl
Log:
	* otr/auth.tcl, otr/otr.tcl, otr/tclotr/otr.tcl: Store the
	  authentication data after peer verification using question & answer,
	  shared secret or manual verification. Provisionally implemented
	  a dialog where user can edit auth info.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-21 18:36:17 UTC (rev 2076)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-22 17:46:51 UTC (rev 2077)
@@ -1,3 +1,10 @@
+2014-01-22  Sergei Golovan <sgolovan at nes.ru>
+
+	* otr/auth.tcl, otr/otr.tcl, otr/tclotr/otr.tcl: Store the
+	  authentication data after peer verification using question & answer,
+	  shared secret or manual verification. Provisionally implemented
+	  a dialog where user can edit auth info.
+
 2014-01-21  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/tclotr/key.tcl, otr/tclotr/pkgIndex.tcl: Added a new subpackage

Modified: trunk/tkabber-plugins/otr/auth.tcl
===================================================================
--- trunk/tkabber-plugins/otr/auth.tcl	2014-01-21 18:36:17 UTC (rev 2076)
+++ trunk/tkabber-plugins/otr/auth.tcl	2014-01-22 17:46:51 UTC (rev 2077)
@@ -5,8 +5,12 @@
     set otrdir [file join $::configdir otr]
     if {![file exists $otrdir]} {
 	file mkdir $otrdir
-	catch {file attributes -permissions 0700 $otrdir}
+	catch {file attributes $otrdir -permissions 0700}
     }
+    # State variable with all auth data
+    set Auth [dict create]
+
+    hook::add finload_hook [namespace current]::restore
 }
 
 proc auth::store {auth} {
@@ -20,8 +24,9 @@
 	    puts $fd [serialize_auth $auth]
 
 	    close $fd
-	}]} {
-	file rename [file join $otrdir auth.xml.new] [file join $otrdir auth.xml]
+	} res]} {
+	file rename -force -- [file join $otrdir auth.xml.new] \
+			      [file join $otrdir auth.xml]
     }
 }
 
@@ -46,10 +51,9 @@
 	lappend subtags [serialize_auth_item $item $val]
     }
 
-    ::xmpp::xml::toTabbedText [::xmpp::xml::create profile \
-					-xmlns $ns \
-					-attrs [list jid $jid]
-					-subelements $subtags]
+    ::xmpp::xml::create profile -xmlns $ns \
+				-attrs [list jid $jid] \
+				-subelements $subtags
 }
 
 proc auth::serialize_auth_item {item val} {
@@ -57,15 +61,15 @@
 
     lassign $item jid fingerprint
 
-    ::xmpp::xml::toTabbedText [::xmpp::xml::create item \
-					-xmlns $ns \
-					-attrs [list jid $jid \
-						     fingerprint $fingerprint \
-						     auth $val]]
+    ::xmpp::xml::create item -xmlns $ns \
+			     -attrs [list jid $jid \
+					  fingerprint $fingerprint \
+					  auth $val]
 }
 
 proc auth::restore {} {
     variable otrdir
+    variable Auth
 
     if {[catch {set fd [open [file join $otrdir auth.xml]]}]} {
 	return [dict create]
@@ -74,7 +78,7 @@
     set data [read $fd]
     close $fd
 
-    deserialize_auth [lindex $data 0]
+    set Auth [deserialize_auth [lindex [::xmpp::xml::parseData $data] 0]]
 }
 
 proc auth::deserialize_auth {xmlel} {
@@ -101,23 +105,275 @@
     foreach xmlel $xmlels {
 	::xmpp::xml::split $xmlel tag xmlns attrs cdata subels
 	dict set items [list [::xmpp::xml::getAttr $attrs jid] \
-			     [::xmpp::xml::getAttr $attrs fingerprint] \
-		       [::xmpp::xml::getAttr $attrs $auth]]
+			     [::xmpp::xml::getAttr $attrs fingerprint]] \
+		       [::xmpp::xml::getAttr $attrs auth]
     }
     set items
 }
 
-proc auth::set_auth {auth myjid jid fingerprint value} {
-    if {!$value} {
-	if {[dict exists $auth $myjid]} {
-	    dict unset auth $myjid [list $jid $fingerprint]
+proc auth::set_auth {vauth myjid jid fingerprint value} {
+    upvar $vauth auth
+
+    set myjid [::xmpp::jid::normalize $myjid]
+    set jid [::xmpp::jid::normalize $jid]
+    if {![dict exists $auth $myjid]} {
+	dict set auth $myjid [dict create]
+    }
+    dict set auth $myjid [list $jid $fingerprint] $value
+    set auth
+}
+
+proc auth::del_auth {auth myjid jid fingerprint} {
+    set myjid [::xmpp::jid::normalize $myjid]
+    set jid [::xmpp::jid::normalize $jid]
+    if {[dict exists $auth $myjid]} {
+	dict unset auth $myjid [list $jid $fingerprint]
+    }
+    if {[llength [dict get $auth $myjid]] == 0} {
+	dict unset auth $myjid
+    }
+    set auth
+}
+
+proc auth::get_auth {auth myjid jid fingerprint} {
+    set myjid [::xmpp::jid::normalize $myjid]
+    set jid [::xmpp::jid::normalize $jid]
+    if {[catch {dict get $auth $myjid [list $jid $fingerprint]} res]} {
+	return 0
+    } else {
+	return $res
+    }
+}
+
+proc auth::edit_auth_dialog {} {
+    variable Auth
+    variable authjid
+    variable lastsort
+
+    set w .otreditauth
+
+    if {[winfo exists $w]} {
+	destroy $w
+    }
+
+    Dialog $w -title [::msgcat::mc "Edit OTR authentication"] \
+	      -separator 1 -anchor e -default 0 -cancel 1
+
+    set f [$w getframe]
+
+    $w add -text [::msgcat::mc "Apply"] \
+	   -state disabled \
+	   -command [namespace code [list apply_edit_auth_changes $w $f.myjid $f.items.listbox]]
+    $w add -text [::msgcat::mc "Cancel"] \
+	   -command [list destroy $w]
+
+    set myjids [lsort [dict keys $Auth]]
+    set authjid [lindex $myjids 0]
+    set connections [connections]
+    if {[llength $connections] > 0} {
+	set myjid [::xmpp::jid::normalize [::xmpp::jid::removeResource [lindex $connections 0]]]
+	if {[dict exists $Auth $myjid]} {
+	    set authjid $myjid
 	}
+    }
+    trace add variable [namespace current]::authjid write \
+	  [namespace code [list fill_mclistbox $w $f.items.listbox]]
+
+    bind $w <Destroy> [list unset -nocomplain [namespace current]::authjid]
+
+    if {[llength $myjids] > 1} {
+	set state normal
     } else {
-	if {![dict exists $auth $myjid]} {
-	    dict set auth $myjid [dict create]
+	set state disabled
+    }
+
+    label $f.lmyjid -text [::msgcat::mc "Your JID: "]
+    ComboBox $f.myjid \
+	     -textvariable [namespace current]::authjid \
+	     -values $myjids \
+	     -state $state
+
+    grid $f.lmyjid -row 0 -column 0 -sticky e
+    grid $f.myjid  -row 0 -column 1 -sticky ew
+
+    set sw [ScrolledWindow $f.items]
+
+    ::mclistbox::mclistbox $sw.listbox \
+	-resizeonecolumn 1 \
+	-labelanchor w \
+	-width 100 \
+	-height 16
+
+    grid $sw -row 1 -column 0 -columnspan 2 -sticky nsew
+    $sw setwidget $sw.listbox
+
+    set lastsort ""
+
+    bind $sw.listbox <3> \
+	"[namespace current]::select_and_popup_menu [list [double% $w] [double% $sw.listbox]] \
+	     \[[double% $sw.listbox] nearest \[::mclistbox::convert %W -y %y\]\]"
+
+    bindscroll $sw $sw.listbox
+
+    set l $sw.listbox
+
+    set label(N) " [::msgcat::mc #] "
+    set label(jid) " [::msgcat::mc JID] "
+    set label(fingerprint) " [::msgcat::mc Fingerprint] "
+    set label(auth) " [::msgcat::mc Authenticated] "
+    set label(del) " [::msgcat::mc Delete] "
+    foreach name {N jid fingerprint auth del} {
+	$l column add $name -label $label($name)
+	$l label bind $name <ButtonPress-1> [namespace code [list sort %W [double% $name]]]
+    }
+    $l column add filler -label "" -width 0
+    $l configure -fillcolumn filler
+
+    fill_mclistbox $w $l
+
+    $w draw
+}
+
+proc auth::fill_mclistbox {w l args} {
+    variable Auth
+    variable authjid
+
+    if {![winfo exists $l]} return
+
+    if {[dict exists $Auth $authjid]} {
+	set items [dict get $Auth $authjid]
+    } else {
+	set items {}
+    }
+
+    $l delete 0 end
+
+    foreach name {N jid fingerprint auth del} {
+	set width($name) [string length [$l column cget $name -label]]
+    }
+
+    set row 0
+    dict for {key val} $items {
+	lassign $key jid fingerprint
+	if {$val} {
+	    set data(auth) " [::msgcat::mc Yes] "
+	} else {
+	    set data(auth) " [::msgcat::mc No] "
 	}
-	dict set auth $myjid [list $jid $fingerprint] 1
+
+	set data(N) " [incr row] "
+	set data(jid) " $jid "
+	set data(fingerprint) " $fingerprint "
+
+	foreach name {N jid fingerprint auth} {
+	    if {$width($name) < [string length $data($name)]} {
+		set width($name) [string length $data($name)]
+	    }
+	}
+
+	$l insert end [list $data(N) $data(jid) $data(fingerprint) $data(auth) ""]
     }
-    set auth
+
+    foreach name {N jid fingerprint auth del} {
+	$l column configure $name -width $width($name)
+    }
+
+    # The filled listbox is unchanged, so disable apply button
+    $w itemconfigure 0 -state disabled
 }
 
+proc auth::sort {w tag} {
+    variable lastsort
+
+    set data [$w get 0 end]
+    set index [lsearch -exact [$w column names] $tag]
+    if {$lastsort != $tag} {
+	set result [lsort -dictionary -index $index $data]
+	set lastsort $tag
+    } else {
+	set result [lsort -decreasing -dictionary -index $index $data]
+	set lastsort ""
+    }
+    set result1 {}
+    set i 0
+    foreach row $result {
+	lappend result1 [lreplace $row 0 0 " [incr i] "]
+    }
+    $w delete 0 end
+    eval $w insert end $result1
+}
+
+proc auth::select_and_popup_menu {w l index} {
+    $l selection clear 0 end
+    $l selection set $index
+
+    if {[winfo exists [set m .otrauthpopupmenu]]} {
+	destroy $m
+    }
+    menu $m -tearoff 0
+
+    $m add command -label [::msgcat::mc "Set authenticated"] \
+		   -command [namespace code [list set_authenticated $w $l $index 1]]
+    $m add command -label [::msgcat::mc "Unset authenticated"] \
+		   -command [namespace code [list set_authenticated $w $l $index 0]]
+    $m add command -label [::msgcat::mc "Mark for deletion"] \
+		   -command [namespace code [list set_delete $w $l $index 1]]
+    $m add command -label [::msgcat::mc "Unmark for deletion"] \
+		   -command [namespace code [list set_delete $w $l $index 0]]
+
+    tk_popup $m [winfo pointerx .] [winfo pointery .]
+}
+
+proc auth::set_authenticated {w l index val} {
+    if {$val} {
+	set auth " [::msgcat::mc Yes] "
+    } else {
+	set auth " [::msgcat::mc No] "
+    }
+    set data [lreplace [$l get $index] 3 3 $auth]
+    $l delete $index
+    $l insert $index $data
+    $l selection set $index
+    $w itemconfigure 0 -state normal
+}
+
+proc auth::set_delete {w l index val} {
+    if {$val} {
+	set del " [::msgcat::mc Yes] "
+    } else {
+	set del ""
+    }
+    set data [lreplace [$l get $index] 4 4 $del]
+    $l delete $index
+    $l insert $index $data
+    $l selection set $index
+    $w itemconfigure 0 -state normal
+}
+
+proc auth::apply_edit_auth_changes {w m l} {
+    variable Auth
+
+    $w itemconfigure 0 -state disabled
+
+    set myjid [$m get]
+    set data [$l get 0 end]
+
+    set items [dict create]
+    foreach item $data {
+	lassign $item i jid fingerprint auth del
+	
+	if {$del eq " [::msgcat::mc Yes] "} continue
+
+	if {$auth eq " [::msgcat::mc Yes] "} {
+	    set auth1 1
+	} else {
+	    set auth1 0
+	}
+	dict set items [list $jid $fingerprint] $auth1
+    }
+    dict set Auth $myjid $items
+    store $Auth
+    # TODO: change the icons for all affected chats
+    fill_mclistbox $w $l
+}
+

Modified: trunk/tkabber-plugins/otr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/otr.tcl	2014-01-21 18:36:17 UTC (rev 2076)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-22 17:46:51 UTC (rev 2077)
@@ -29,6 +29,8 @@
 	return
     }
 
+    source [file join $scriptdir auth.tcl]
+
     # TODO: DSA private key management
     set keyfile [file join $::configdir otr.private.key.pem]
     if {![file readable $keyfile]} {
@@ -419,13 +421,21 @@
 
 #############################################################################
 
+proc otr::peer_jid {xlib jid} {
+    set bjid [::xmpp::jid::removeResource $jid]
+    if {![chat::is_groupchat [chat::chatid $xlib $bjid]]} {
+	return $bjid
+    } else {
+	return $jid
+    }
+}
+
 proc otr::begin_smp_dialog {xlib jid} {
     variable ctx
 
     set w .otrstartauth[jid_to_tag $jid]
-    set bjid [::xmpp::jid::removeResource $jid]
 
-    Dialog $w -title [::msgcat::mc "Authenticate %s" $bjid] \
+    Dialog $w -title [::msgcat::mc "Authenticate %s" [peer_jid $xlib $jid]] \
 	      -separator 1 -anchor e -default 0 -cancel 1
 
     wm resizable $w 0 0
@@ -523,6 +533,14 @@
 					    [::otr::fingerprint $ctx($xlib,$jid) 0]] \
 			      -width 12c]
     grid $m5 -row 2 -column 0 -columnspan 2 -sticky nswe
+    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
+    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
+    set tjid [peer_jid $xlib $jid]
+    if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
+	set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have not verified"]
+    } else {
+	set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have verified"]
+    }
     tk_optionMenu $pf3.ihave [namespace current]::ctx(ihave,$xlib,$jid) \
 			 [::msgcat::mc "I have not verified"] \
 			 [::msgcat::mc "I have verified"]
@@ -597,7 +615,23 @@
 	    set secret [$pf.e3 get]
 	    set question {}
 	}
-	mfv { return }
+	mfv {
+	    if {$ctx(ihave,$xlib,$jid) eq [::msgcat::mc "I have verified"]} {
+		set val 1
+	    } else {
+		set val 0
+	    }
+	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
+	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
+	    set tjid [peer_jid $xlib $jid]
+	    auth::set_auth auth::Auth $myjid $tjid $fingerprint $val
+	    auth::store $auth::Auth
+	    # 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
+	    return
+	}
     }
 
     set result [::otr::startSMP $ctx($xlib,$jid) $secret {*}$question]
@@ -613,9 +647,8 @@
     variable ctx
 
     set w .otrreplauth[jid_to_tag $jid]
-    set bjid [::xmpp::jid::removeResource $jid]
 
-    Dialog $w -title [::msgcat::mc "Authentication from %s" $bjid] \
+    Dialog $w -title [::msgcat::mc "Authentication from %s" [peer_jid $xlib $jid]] \
 	      -separator 1 -anchor e -default 0 -cancel 1
 
     wm resizable $w 0 0
@@ -667,9 +700,8 @@
     variable ctx
 
     set w .otrreplauth[jid_to_tag $jid]
-    set bjid [::xmpp::jid::removeResource $jid]
 
-    Dialog $w -title [::msgcat::mc "Authentication from %s" $bjid] \
+    Dialog $w -title [::msgcat::mc "Authentication from %s" [peer_jid $xlib $jid]] \
 	      -separator 1 -anchor e -default 0 -cancel 1
 
     wm resizable $w 0 0
@@ -771,8 +803,6 @@
 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)
@@ -796,11 +826,27 @@
 	    set ctx(progress,$xlib,$jid) 3
 	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication succeeded"]
 	    result_smp $w $xlib $jid
+
+	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
+	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
+	    set tjid [peer_jid $xlib $jid]
+	    auth::set_auth auth::Auth $myjid $tjid $fingerprint 1
+	    auth::store $auth::Auth
+	    # TODO: change the icons for all chats with this jid
+	    on_msgstate_change $xlib $jid $ctx(msgstate,$xlib,$jid)
 	}
 	SMP_FAILURE {
 	    set ctx(progress,$xlib,$jid) 3
 	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication failed"]
 	    result_smp $w $xlib $jid
+
+	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
+	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
+	    set tjid [peer_jid $xlib $jid]
+	    auth::set_auth auth::Auth $myjid $tjid $fingerprint 0
+	    auth::store $auth::Auth
+	    # TODO: change the icons for all chats with this jid
+	    on_msgstate_change $xlib $jid $ctx(msgstate,$xlib,$jid)
 	}
     }
 }
@@ -1056,8 +1102,10 @@
 		return 0
 	    }
 	    MSGSTATE_ENCRYPTED {
-		# TODO
-		if {1 || [UNVERIFIED $xlib $jid]} {
+		set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
+		set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
+		set tjid [peer_jid $xlib $jid]
+		if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
 		    return 1
 		} else {
 		    return 2
@@ -1141,6 +1189,9 @@
 
 	set mm .otr_menu
 	menu $mm -tearoff $::ifacetk::options(show_tearoffs)
+	$mm add command -label [::msgcat::mc "Edit authentication"] \
+	    -command [namespace code auth::edit_auth_dialog]
+	$mm add separator
 	$mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
 	    -variable [namespace current]::options(allow-encryption)
 	$mm add checkbutton -label [::msgcat::mc "Require encryption"] \

Modified: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-21 18:36:17 UTC (rev 2076)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-22 17:46:51 UTC (rev 2077)
@@ -779,20 +779,22 @@
                     $keyid \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance)] \
-            state(AuthState) state(MsgState) message \
-            state(PublicKey) gy keyidy
+            authstate msgstate message state(PublicKey) gy keyidy
 
     if {$message eq ""} {
         # Failure
-        return {}
+        set ret {}
     } else {
         # Success
         UpdatePeerDHKeysAfterAKE $token $gy $keyidy
         StoreSSID $token
 
         # TODO: Send stored messages
-        return [list reply [list $message]]
+        set ret [list reply [list $message]]
     }
+    set state(AuthState) $authstate
+    set state(MsgState) $msgstate
+    set ret
 }
 
 proc ::otr::ProcessSignatureMessage {token data} {
@@ -809,7 +811,7 @@
                     $state(x,$keyid) \
                     -sinstance $state(rinstance) \
                     -rinstance $state(sinstance)] \
-            state(AuthState) state(MsgState) message state(PublicKey) keyidy
+            authstate msgstate message state(PublicKey) keyidy
 
     if {$keyidy ne ""} {
         # Success
@@ -819,6 +821,8 @@
 
         # TODO: Send stored messages
     }
+    set state(AuthState) $authstate
+    set state(MsgState) $msgstate
     return {}
 }
 



More information about the Tkabber-dev mailing list