[Tkabber-dev] r2057 - in trunk/tkabber-plugins: . debug otr otr/pixmaps otr/pixmaps/otr otr/tclotr

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Jan 17 19:44:22 MSK 2014


Author: sergei
Date: 2014-01-17 19:44:22 +0400 (Fri, 17 Jan 2014)
New Revision: 2057

Added:
   trunk/tkabber-plugins/otr/
   trunk/tkabber-plugins/otr/README
   trunk/tkabber-plugins/otr/otr.tcl
   trunk/tkabber-plugins/otr/pixmaps/
   trunk/tkabber-plugins/otr/pixmaps/otr/
   trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif
   trunk/tkabber-plugins/otr/pixmaps/otr/icondef.xml
   trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif
   trunk/tkabber-plugins/otr/pixmaps/otr/private.gif
   trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif
   trunk/tkabber-plugins/otr/tclotr/
   trunk/tkabber-plugins/otr/tclotr/auth.tcl
   trunk/tkabber-plugins/otr/tclotr/crypto.tcl
   trunk/tkabber-plugins/otr/tclotr/data.tcl
   trunk/tkabber-plugins/otr/tclotr/license.terms
   trunk/tkabber-plugins/otr/tclotr/message.tcl
   trunk/tkabber-plugins/otr/tclotr/otr.tcl
   trunk/tkabber-plugins/otr/tclotr/pkgIndex.tcl
   trunk/tkabber-plugins/otr/tclotr/smp.tcl
Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/debug/debug.tcl
Log:
	* otr/*: Added pre-alpha of the new OTR plugin. No key management,
	  peer authentication, SMP, proper error reporting, resending
	  messages yet. Not for regular usage yet.

	* debug/debug.tcl: Added the otr debug category.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/ChangeLog	2014-01-17 15:44:22 UTC (rev 2057)
@@ -1,3 +1,11 @@
+2014-01-17  Sergei Golovan <sgolovan at nes.ru>
+
+	* otr/*: Added pre-alpha of the new OTR plugin. No key management,
+	  peer authentication, SMP, proper error reporting, resending
+	  messages yet. Not for regular usage yet.
+
+	* debug/debug.tcl: Added the otr debug category.
+
 2014-01-01  Sergei Golovan <sgolovan at nes.ru>
 
 	* *: 1.0 is released.

Modified: trunk/tkabber-plugins/debug/debug.tcl
===================================================================
--- trunk/tkabber-plugins/debug/debug.tcl	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/debug/debug.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -64,6 +64,7 @@
 			mucignore
 			negotiate
 			nick
+			otr
 			pconnect::https
 			pconnect::socks4
 			pconnect::socks5
@@ -105,7 +106,8 @@
 	     "[namespace current]::debugmsg \$module \$msg"
     }
 
-    foreach ns {pconnect::https
+    foreach ns {otr
+		pconnect::https
 		pconnect::socks4
 		pconnect::socks5
 		xmpp
@@ -114,8 +116,7 @@
 	if {[llength [info procs ::${ns}::Debug:debug]] == 0} {
 	    rename ::${ns}::Debug ::${ns}::Debug:debug
 	    proc ::${ns}::Debug {xlib level str} \
-		 "[namespace current]::debugmsg $ns \
-		        \"\$xlib \$str\""
+		 "[namespace current]::debugmsg $ns \"\$xlib \$str\""
 	}
     }
 

Added: trunk/tkabber-plugins/otr/README
===================================================================
--- trunk/tkabber-plugins/otr/README	                        (rev 0)
+++ trunk/tkabber-plugins/otr/README	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,29 @@
+$Id$
+
+As usual, copy or link this directory to $HOME/.tkabber/plugins (on UNIX),
+to %APPDATA%\Tkabber\plugins (on Windows), or to
+$HOME/Library/Application Support/Tkabber (on MacOS X) directory.
+
+Restart Tkabber, then you'll find OTR submenu in Tkabber top menu, in
+users' roster menus and in chat tabs or message windows.
+
+On all systems this plugin requires Tcl 8.5 or newer because it uses an
+arbitrary precision integers. Also, the base64, sha1, sha256, aes packages
+are required, they all are bundled with the Tcllib collection.
+
+For Windows this plugin also requires the Memchan package. Its [random]
+channel is used as a PRNG.
+
+At the current stage to use this plugin you'll have to specify your
+long term DSA private key in Tkabber's config.tcl file. The key is a
+list of 5 values (p, q, g, y, x). Example:
+
+set ::OTRPrivateKey {
+    813749128345192734691234769123846...
+    918764983469182736912691691791698...
+    817356418723187263548172653481726...
+    723645182763458123548126354812653...
+    872136451827364581273548123548235...
+}
+
+Numbers may be specified in hexadecimal notation as well (0x343dc63a9f7b...).


Property changes on: trunk/tkabber-plugins/otr/README
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/otr.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/otr.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,748 @@
+# $Id $
+
+namespace eval otr {
+    # TODO: DSA private key management
+    if {![info exists ::OTRPrivateKey]} {
+	return
+    }
+
+    # Prepare to load the local TclOTR library
+
+    set scriptdir [file dirname [info script]]
+    set tclotr [file join $scriptdir tclotr]
+
+    if {[file isdirectory $tclotr]} {
+	lappend ::auto_path $scriptdir
+	package forget otr
+    }
+
+    # Load message catalog:
+
+    package require msgcat
+    ::msgcat::mcload [file join $scriptdir msgs]
+    ::trans::load [file join $scriptdir trans]
+
+    # Attempt to load KHIM. Warn and quit loading plugin if we can't:
+
+    if {[catch { package require otr } err]} {
+	puts stderr $err
+	puts stderr [::msgcat::mc "Problem loading TclOTR. The OTR\
+				   functionality will be disabled.\nRefer\
+				   to the README file of the OTR plugin."]
+	# Clean up what's already here and bail out:
+	namespace delete [namespace current]
+	return
+    }
+
+    # Auxiliary namespace. Rewrite_message_hook will use it to add some
+    # supplemetary info.
+    set ns tkabber:otr
+
+    variable options
+
+    variable themes
+    set dirs \
+	[glob -nocomplain -directory [file join [file dirname [info script]] \
+						pixmaps] *]
+    foreach dir $dirs {
+	pixmaps::load_theme_name [namespace current]::themes $dir
+    }
+    set values {}
+    foreach theme [lsort [array names themes]] {
+	lappend values $theme $theme
+    }
+
+    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
+	-group Tkabber
+
+    custom::defgroup OTR [::msgcat::mc "Off-the-record messaging plugin options."] \
+	-group Plugins
+
+    custom::defvar options(theme) OTR \
+	[::msgcat::mc "OTR icons theme."] -group OTR \
+	-type options -values $values \
+	-command [namespace current]::load_stored_theme
+
+    custom::defvar options(allow-encryption) 1 \
+	[::msgcat::mc "Allow Tkabber to use Off-the-Record protocol (version 2 or 3)."] \
+	-group OTR -type boolean -command [namespace current]::update_policy
+
+    custom::defvar options(require-encryption) 0 \
+	[::msgcat::mc "Refuse to send unencrypted messages. Note that if this option\
+		       is enabled and the previous one is not then you will not be\
+		       able to send any chat or normal messages at all"] \
+	-group OTR -type boolean -command [namespace current]::update_policy
+
+    custom::defvar options(send-whitespace-tag) 1 \
+	[::msgcat::mc "Advertise your support of OTR using the whitespace tag."] \
+	-group OTR -type boolean -command [namespace current]::update_policy
+
+    custom::defvar options(whitespace-or-error-start-ake) 1 \
+	[::msgcat::mc "Start the OTR authenticated key exchange when you\
+		       receive a whitespace tag or an OTR error message."] \
+	-group OTR -type boolean -command [namespace current]::update_policy
+
+    custom::defvar options(dont-log-otr-messages) 0 \
+	[::msgcat::mc "Do not log OTR messages."] \
+	-group OTR -type boolean
+
+#   {myjid1 {jid1 {allow-encryption 0 ...} jid2 {...}} myjid2 {jid1 {...} jid2 {...}}}
+    custom::defvar options(personal-preferences) {} \
+	[::msgcat::mc "Presonal OTR preferences."] \
+	-type string -group Hidden
+
+    array set PolicyFlags {allow-encryption {ALLOW_V2 ALLOW_V3}
+			   require-encryption {REQUIRE_ENCRYPTION}
+			   send-whitespace-tag {SEND_WHITESPACE_TAG}
+			   whitespace-or-error-start-ake {WHITESPACE_START_AKE ERROR_START_AKE}} 
+}
+
+#############################################################################
+
+proc otr::load_stored_theme {args} {
+    variable options
+    variable themes
+
+    pixmaps::load_dir $themes($options(theme))
+}
+
+#############################################################################
+
+proc otr::draw_encrypted {chatid from type body x} {
+    variable ns
+    variable ctx
+
+    set xlib [chat::get_xlib $chatid]
+    set chatw [chat::chat_win $chatid]
+
+    once_only $xlib $from
+
+    switch -- $ctx(msgstate,$xlib,$from) {
+	MSGSTATE_PLAIN {}
+	MSGSTATE_ENCRYPTED -
+	MSGSTATE_FINISHED {
+	    foreach xe $x {
+		::xmpp::xml::split $xe tag xmlns attrs cdata subels
+
+		if {$tag eq "" && $xmlns eq $ns} {
+		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
+			$chatw image create end -image otr/notprivate
+		    } else {
+			$chatw image create end -image otr/unverified
+		    }
+		    break
+		}
+	    }
+	}
+    }
+}
+
+hook::add draw_message_hook [namespace current]::otr::draw_encrypted 6
+
+#############################################################################
+
+proc otr::process_x_encrypted {rowvar bodyvar f x xlib from id type replyP} {
+    variable ns
+    variable ctx
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
+
+    if {$type == "error"} {
+	return
+    }
+
+    once_only $xlib $from
+
+    switch -- $ctx(msgstate,$xlib,$from) {
+	MSGSTATE_PLAIN {}
+	MSGSTATE_ENCRYPTED -
+	MSGSTATE_FINISHED {
+	    foreach xe $x {
+		::xmpp::xml::split $xe tag xmlns attrs cdata subels
+
+		if {$tag eq "" && $xmlns eq $ns} {
+		    set lb [join [lrange [split $f .] 0 end-1] .].title.otrmsgstate
+		    if {[winfo exists $lb]} {
+			destroy $lb
+		    }
+		    if {[::xmpp::xml::getAttr $attrs warn] == 1} {
+			Label $lb -image otr/notprivate
+		    } else {
+			Label $lb -image otr/unverified
+		    }
+		    grid $lb -row 1 -column 4 -sticky e
+		    break
+		}
+	    }
+	}
+    }
+}
+
+hook::add message_process_x_hook [namespace current]::otr::process_x_encrypted 21
+
+#############################################################################
+
+proc otr::once_only {xlib jid} {
+    variable options
+    variable ctx
+
+    debugmsg otr "ONCE_ONLY $xlib $jid"
+
+    if {[info exists ctx($xlib,$jid)] && $ctx($xlib,$jid) != ""} {
+        return
+    }
+
+    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)
+}
+
+proc otr::get_policy {xlib jid} {
+    variable options
+    variable PolicyFlags
+
+    set njid [::xmpp::jid::normalize $jid]
+
+    set policy {}
+    foreach key {allow-encryption require-encryption
+		 send-whitespace-tag whitespace-or-error-start-ake} {
+	if {[info exists options($key,$xlib,$njid)]} {
+	    set flag $options($key,$xlib,$njid)
+	} else {
+	    set flag $options($key)
+	}
+	if {$flag} {
+	    lappend policy {*}$PolicyFlags($key)
+	}
+    }
+    debugmsg otr "GET_POLICY $xlib $jid $policy"
+    set policy
+}
+
+proc otr::update_policy {{xlib ""} {jid ""}} {
+    variable ctx
+
+    if {$xlib eq ""} {
+	set xlibs [connections]
+    } else {
+	set xlibs [list $xlib]
+    }
+    foreach xl $xlibs {
+	if {$jid eq ""} {
+	    set jids {}
+	    foreach idx [array names ctx $xl,*] {
+		regexp "$xl,(.*)" $idx -> j
+		lappend jids $j
+	    }
+	} else {
+	    if {[info exists ctx($xl,$jid)]} {
+		set jids [list $jid]
+	    } else {
+		set jids {}
+	    }
+	}
+	foreach j $jids {
+	    ::otr::setPolicy $ctx($xl,$j) [get_policy $xl $j]
+	}
+    }
+}
+
+proc otr::reset_policy {xlib jid} {
+    variable options
+
+    set njid [::xmpp::jid::normalize $jid]
+
+    foreach key {allow-encryption require-encryption
+		 send-whitespace-tag whitespace-or-error-start-ake} {
+	if {[info exists options($key,$xlib,$njid)]} {
+	    unset options($key,$xlib,$njid)
+	}
+    }
+
+    update_policy $xlib $jid
+}
+
+#############################################################################
+
+proc otr::get_personal_prefs {xlib} {
+    variable options
+
+    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
+    array set p $options(personal-preferences)
+
+    if {[info exists p($connjid)]} {
+	foreach {jid prefs} $p($connjid) {
+	    foreach {key val} $prefs {
+		set options($key,$xlib,$jid) $val
+	    }
+	}
+    }
+}
+
+hook::add connected_hook [namespace current]::otr::get_personal_prefs 1
+
+proc otr::set_personal_prefs {xlib} {
+    variable options
+
+    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
+    array set p $options(personal-preferences)
+
+    set p($connjid) {}
+    set jids {}
+    foreach idx [array names options *,$xlib,*] {
+	lappend jids [join [lrange [split $idx ,] 2 end] ,]
+    }
+    set jids [lsort -unique $jids]
+
+    foreach j $jids {
+	set prefs {}
+	foreach key {allow-encryption require-encryption send-whitespace-tag
+		     whitespace-or-error-start-ake dont-log-otr-messages} {
+	    if {[info exists options($key,$xlib,$j)] && \
+		    $options($key,$xlib,$j) != $options($key)} {
+		lappend prefs $key $options($key,$xlib,$j)
+	    }
+	}
+	if {[llength $prefs] > 0} {
+	    lappend p($connjid) $j $prefs
+	}
+    }
+
+    if {[llength $p($connjid)] == 0} {
+	unset p($connjid)
+    }
+
+    set options(personal-preferences) [array get p]
+}
+
+hook::add disconnected_hook [namespace current]::otr::set_personal_prefs 40
+
+#############################################################################
+
+proc otr::request_session {xlib jid type} {
+    variable ctx
+
+    once_only $xlib $jid
+
+    set lang [get_jid_presence_info lang $xlib $jid]
+
+    set result [::otr::requestConversation $ctx($xlib,$jid)]
+    array set res $result
+    if {$res(action) eq "send"} {
+	append res(body) \n \
+	    [format [::trans::trans $lang \
+		"%s has requested an Off-the-Record\ private conversation\
+		 <http://otr.cypherpunks.ca/>. However, you do not have a\
+		 plugin to support that.\nSee http://otr.cypherpunks.ca/\
+		 for more information."] [connection_jid $xlib]]
+    
+	::xmpp::sendMessage $xlib $jid -type $type -body $res(body)
+    }
+}
+
+proc otr::finish_session {xlib jid type} {
+    variable ctx
+
+    once_only $xlib $jid
+
+    set result [::otr::finishConversation $ctx($xlib,$jid)]
+    array set res $result
+    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)
+    }
+    if {[info exists res(msgstate)]} {
+	set ctx(msgstate,$xlib,$jid) $res(msgstate)
+    }
+}
+
+#############################################################################
+
+proc otr::rewrite_message_body \
+     {vxlib vfrom vid vtype vis_subject vsubject vbody verr vthread vpriority vx} {
+    upvar 2 $vxlib xlib
+    upvar 2 $vfrom from
+    upvar 2 $vtype type
+    upvar 2 $vbody body
+    upvar 2 $vx x
+    variable ns
+    variable ctx
+
+    once_only $xlib $from
+
+    set result [::otr::incomingMessage $ctx($xlib,$from) $body] 
+
+    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]
+	}
+	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 type]} {
+		lappend command -type $type
+	    } 
+	    eval $command
+	}
+    }
+
+    if {[info exists res(authstate)]} {
+	set ctx(authstate,$xlib,$from) $res(authstate)
+    }
+
+    if {[info exists res(msgstate)]} {
+	set ctx(msgstate,$xlib,$from) $res(msgstate)
+    }
+
+    switch -- $res(action) {
+	reply -
+	discard {
+	    lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {discard 1}]
+	}
+    }
+
+    return
+}
+
+hook::add rewrite_message_hook [namespace current]::otr::rewrite_message_body 40
+
+###############################################################################
+
+proc otr::discard_message {xlib from id type is_subject \
+			   subject body err thread priority x} {
+    variable ns
+
+    foreach xel $x {
+	::xmpp::xml::split $xel tag xmlns attrs cdata subels
+
+	if {$tag eq "" && $xmlns eq $ns && \
+		[::xmpp::xml::getAttr $attrs discard] == 1} {
+	    return -code break
+	}
+    }
+}
+
+hook::add process_message_hook [namespace current]::otr::discard_message 0.1
+
+###############################################################################
+
+proc otr::filter:output {xlib to data} {
+    variable ctx
+
+    once_only $xlib $to
+
+    set result [::otr::outgoingMessage $ctx($xlib,$to) $data]
+
+    debugmsg otr "FILTER_OUTPUT: $xlib; $to; $result"
+
+    array set res $result
+    switch -- $res(action) {
+	send {
+	    return [list $res(body) send]
+	}
+    }
+    list $data ""
+}
+
+proc otr::rewrite_outgoing_message_body \
+     {vxlib vto vid vtype vsubject vbody verr vthread vx} {
+    upvar 2 $vxlib xlib
+    upvar 2 $vto to
+    upvar 2 $vbody body
+    upvar 2 $vx x
+
+    if {![info exists body]} return
+
+    # Only the message body is encrypted if appropriate
+    lassign [filter:output $xlib $to $body] encrypted status
+
+    if {$status ne ""} {
+	set body $encrypted
+    }
+}
+
+hook::add rewrite_outgoing_message_hook \
+	  [namespace current]::otr::rewrite_outgoing_message_body 10
+
+#############################################################################
+
+proc otr::msgstate:trace {script xlib jid} {
+    variable trace
+
+    if {![info exists trace(msgstate,$xlib,$jid)]} {
+        set trace(msgstate,$xlib,$jid) {}
+
+        ::trace variable [namespace current]::ctx(msgstate,$xlib,$jid) w [namespace current]::trace
+    }
+
+    lappend trace(msgstate,$xlib,$jid) $script
+}
+
+proc otr::trace {name1 name2 op} {
+    variable trace
+
+    set new {}
+    foreach script $trace($name2) {
+        if {[catch {eval $script} result]} {
+            debugmsg otr "$result -- $script"
+        } else {
+            lappend new $script
+        }
+    }
+    set trace($name2) $new
+}
+
+#############################################################################
+
+proc otr::message_button {mw xlib jid} {
+    set bbox [ButtonBox $mw.bottom.otrbutton -spacing 0]
+
+    set b [$bbox add \
+		 -image [msgstate:icon $xlib $jid] \
+		 -helptype balloon \
+		 -helptext [msgstate:helptext $xlib $jid] \
+		 -height 24 \
+		 -width 24 \
+		 -relief link \
+		 -bd $::tk_borderwidth \
+		 -command [list # $xlib $jid]]
+    msgstate:trace \
+	"$b configure -image \[[namespace current]::msgstate:icon [list $xlib] [list $jid]\] \
+		      -helptext \[[namespace current]::msgstate:helptext [list $xlib] [list $jid]\]" \
+	$xlib $jid
+
+    pack $bbox -side left -fill x -padx 2m -pady 2m
+}
+
+hook::add open_message_post_hook [namespace current]::otr::message_button 55
+
+###############################################################################
+
+proc otr::chat_window_button {chatid type} {
+    if {$type ne "chat"} {
+	return
+    }
+
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+    set cw [chat::winid $chatid]
+
+    Button $cw.status.otrmsgstate \
+	   -relief flat \
+           -image [msgstate:icon $xlib $jid] \
+           -helptype balloon \
+           -helptext [msgstate:helptext $xlib $jid] \
+           -command [list # $xlib $jid]
+
+    msgstate:trace "$cw.status.otrmsgstate configure \
+		-image \[[namespace current]::msgstate:icon [list $xlib] [list $jid]\] \
+		-helptext \[[namespace current]::msgstate:helptext [list $xlib] [list $jid]\]" \
+        $xlib $jid
+    pack $cw.status.otrmsgstate -side left -before $cw.status.mb
+}
+
+hook::add open_chat_post_hook [namespace current]::otr::chat_window_button 55
+
+#############################################################################
+
+proc otr::msgstate:icon {xlib jid} {
+    lindex [list otr/notprivate \
+		 otr/unverified \
+		 otr/private \
+		 otr/finished] \
+           [msgstate:index $xlib $jid]
+}
+
+proc otr::msgstate:helptext {xlib jid} {
+    lindex [list [::msgcat::mc "Not private"] \
+		 [::msgcat::mc "Unverified"] \
+		 [::msgcat::mc "Private"] \
+		 [::msgcat::mc "Finished"]] \
+           [msgstate:index $xlib $jid]
+}
+
+proc otr::msgstate:index {xlib jid} {
+    variable ctx
+
+    if {[info exists ctx(msgstate,$xlib,$jid)]} {
+	switch -- $ctx(msgstate,$xlib,$jid) {
+	    MSGSTATE_PLAINTEXT {
+		return 0
+	    }
+	    MSGSTATE_ENCRYPTED {
+		# TODO
+		if {1 || [UNVERIFIED $xlib $jid]} {
+		    return 1
+		} else {
+		    return 2
+		}
+	    }
+	    MSGSTATE_FINISHED {
+		return 3
+	    }
+	}
+    }
+    return 0
+}
+
+###############################################################################
+
+proc otr::user_popup_info {infovar xlib jid} {
+    variable ctx
+
+    upvar 0 $infovar info
+
+    if {[info exists ctx(authstate,$xlib,$jid)]} {
+	append info [::msgcat::mc "\n\tOTR:"]
+	# TODO: nice report
+	append info "\n\t    Authstate: $ctx(authstate,$xlib,$jid)"
+	append info "\n\t    Msgstate: $ctx(msgstate,$xlib,$jid)"
+    }
+}
+
+hook::add roster_user_popup_info_hook [namespace current]::otr::user_popup_info 99
+
+#############################################################################
+
+proc otr::userinfo {tab xlib jid editable} {
+    variable ctx
+
+    if {$editable} return
+
+    set bare_jid [::xmpp::jid::removeResource $jid]
+    set chatid [chat::chatid $xlib $bare_jid]
+    if {[chat::is_groupchat $chatid]} {
+	if {[info exists ctx(authstate,$xlib,$jid)]} {
+	    set jids [list authstate,$xlib,$jid]
+	} else {
+	    set jids [list]
+	}
+    } else {
+	set jids [array names ctx authstate,$xlib,$bare_jid/*]
+    }
+    if {[llength $jids] > 0} {
+	set otrinfo [$tab insert end otrinfo \
+			      -text [::msgcat::mc "OTR"]]
+	set i 0
+	foreach j $jids {
+	    regexp {authstate,[^,]*,(.*)} $j -> fjid
+	    set x [userinfo::pack_frame $otrinfo.otr_$i $fjid]
+
+	    # TODO: nice report
+	    userinfo::pack_entry $jid $x 1 otr_authstate_$i [::msgcat::mc "Authstate:"]
+	    set userinfo::userinfo(otr_authstate_$i,$jid) $ctx(authstate,$xlib,$fjid)
+
+	    userinfo::pack_entry $jid $x 2 otr_msgstate_$i [::msgcat::mc "Msgstate:"]
+	    set userinfo::userinfo(otr_msgstate_$i,$jid) $ctx(msgstate,$xlib,$fjid)
+
+	    incr i
+	}
+    }
+}
+
+hook::add userinfo_hook [namespace current]::otr::userinfo 90
+
+###############################################################################
+
+proc otr::main_menu {} {
+    variable options
+
+    catch {
+	set m [.mainframe getmenu tkabber]
+	set ind [$m index [::msgcat::mc "View"]]
+	incr ind -1
+
+	set mm .otr_menu
+	menu $mm -tearoff $::ifacetk::options(show_tearoffs)
+	$mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
+	    -variable [namespace current]::options(allow-encryption)
+	$mm add checkbutton -label [::msgcat::mc "Require encryption"] \
+	    -variable [namespace current]::options(require-encryption)
+	$mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
+	    -variable [namespace current]::options(send-whitespace-tag)
+	$mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag or OTR error"] \
+	    -variable [namespace current]::options(whitespace-or-error-start-ake)
+	$mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
+	    -variable [namespace current]::options(dont-log-otr-messages)
+
+	$m insert $ind cascade -label [::msgcat::mc "OTR"] \
+	    -menu $mm
+    }
+}
+
+hook::add finload_hook [namespace current]::otr::main_menu 55
+
+###############################################################################
+
+proc otr::user_menu {type m xlib jid} {
+    variable options
+
+    if {[lsearch -exact [connections] $xlib] >= 0} {
+	set state normal
+    } else {
+	set state disabled
+    }
+    set njid [::xmpp::jid::normalize $jid]
+
+    foreach key {allow-encryption require-encryption send-whitespace-tag
+		 whitespace-or-error-start-ake dont-log-otr-messages} {
+	if {![info exists options($key,$xlib,$njid)]} {
+	    set options($key,$xlib,$njid) $options($key)
+	}
+    }
+
+    set mm $m.otr_menu
+    menu $mm -tearoff 0
+    $mm add command -label [::msgcat::mc "Request OTR session"] \
+	-command [list [namespace current]::request_session $xlib $jid $type]
+    $mm add command -label [::msgcat::mc "Finish OTR session"] \
+	-command [list [namespace current]::finish_session $xlib $jid $type]
+    $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"] \
+	-variable [namespace current]::options(allow-encryption,$xlib,$njid) \
+	-command [list [namespace current]::update_policy $xlib $jid]
+    $mm add checkbutton -label [::msgcat::mc "Require encryption"] \
+	-variable [namespace current]::options(require-encryption,$xlib,$njid) \
+	-command [list [namespace current]::update_policy $xlib $jid]
+    $mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
+	-variable [namespace current]::options(send-whitespace-tag,$xlib,$njid) \
+	-command [list [namespace current]::update_policy $xlib $jid]
+    $mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag or OTR error"] \
+	-variable [namespace current]::options(whitespace-or-error-start-ake,$xlib,$njid) \
+	-command [list [namespace current]::update_policy $xlib $jid]
+    $mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
+	-variable [namespace current]::options(dont-log-otr-messages,$xlib,$njid) \
+	-command [list [namespace current]::update_policy $xlib $jid]
+
+    $m add cascade -label [::msgcat::mc "OTR"] -menu $mm -state $state
+}
+
+hook::add chat_create_user_menu_hook [list [namespace current]::otr::user_menu chat] 78.5
+hook::add roster_conference_popup_menu_hook [list [namespace current]::otr::user_menu ""] 78.5
+hook::add roster_service_popup_menu_hook [list [namespace current]::otr::user_menu ""] 78.5
+hook::add roster_jid_popup_menu_hook [list [namespace current]::otr::user_menu ""] 78.5
+hook::add message_dialog_menu_hook [list [namespace current]::otr::user_menu ""] 78.5
+
+###############################################################################
+
+# vim:ts=8:sw=4:sts=4:noet


Property changes on: trunk/tkabber-plugins/otr/otr.tcl
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif
===================================================================
--- trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif	2014-01-17 15:44:22 UTC (rev 2057)

Property changes on: trunk/tkabber-plugins/otr/pixmaps/otr/finished.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/pixmaps/otr/icondef.xml
===================================================================
--- trunk/tkabber-plugins/otr/pixmaps/otr/icondef.xml	                        (rev 0)
+++ trunk/tkabber-plugins/otr/pixmaps/otr/icondef.xml	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,27 @@
+<?xml version='1.0' encoding='UTF-8'?>
+<!-- $Id$ -->
+<icondef>
+  <meta>
+    <name>OTR</name>
+    <version>1.0</version>
+    <description>Theme from the OTR website.</description>
+    <creation>2014-01-11</creation>
+  </meta>
+  <icon>
+    <image xmlns='tkimage'>otr/notprivate</image>
+    <object mime="image/gif">notprivate.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>otr/unverified</image>
+    <object mime="image/gif">unverified.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>otr/private</image>
+    <object mime="image/gif">private.gif</object>
+  </icon>
+  <icon>
+    <image xmlns='tkimage'>otr/finished</image>
+    <object mime="image/gif">finished.gif</object>
+  </icon>
+</icondef>
+


Property changes on: trunk/tkabber-plugins/otr/pixmaps/otr/icondef.xml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif
===================================================================
--- trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif	2014-01-17 15:44:22 UTC (rev 2057)

Property changes on: trunk/tkabber-plugins/otr/pixmaps/otr/notprivate.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/pixmaps/otr/private.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/otr/pixmaps/otr/private.gif
===================================================================
--- trunk/tkabber-plugins/otr/pixmaps/otr/private.gif	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/otr/pixmaps/otr/private.gif	2014-01-17 15:44:22 UTC (rev 2057)

Property changes on: trunk/tkabber-plugins/otr/pixmaps/otr/private.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif
===================================================================
(Binary files differ)

Index: trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif
===================================================================
--- trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif	2014-01-16 04:13:34 UTC (rev 2056)
+++ trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif	2014-01-17 15:44:22 UTC (rev 2057)

Property changes on: trunk/tkabber-plugins/otr/pixmaps/otr/unverified.gif
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/auth.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/auth.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/auth.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,724 @@
+# auth.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the OTR AKE packets serializing and
+#       deserializing procedures.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require sha256
+package require otr::data
+package require otr::crypto
+
+package provide otr::auth 0.1
+
+##############################################################################
+
+namespace eval ::otr::auth {}
+
+# ::otr::auth::createDHCommitMessage --
+#
+#       Assemble the first OTR AKE message which Bob sends to Alice - the D-H
+#       commit one.
+#
+# Arguments:
+#       version         Protocol version (2 or 3).
+#       r               Random binary to use as an AES key.
+#       x               D-H private key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       Tuple {authstate msgstate message} where authstate and msgstate are
+#       the new FSM state, and message is a BASE64 encoded OTR packet with the
+#       message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::createDHCommitMessage {version authstate msgstate r x args} {
+    set sinstance 0x100
+    set rinstance 0
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+    set message [createDHCommitPayload $version \
+                                       $r \
+                                       $x \
+                                       $sinstance \
+                                       $rinstance]
+    set authstate AUTHSTATE_AWAITING_DHKEY
+    list $authstate $msgstate $message
+}
+
+# ::otr::auth::createDHCommitPayload --
+#
+#       Assemble the first OTR AKE message which Bob sends to Alice - the D-H
+#       commit one.
+#
+# Arguments:
+#       version         Protocol version (2 or 3).
+#       r               Random binary to use as an AES key.
+#       x               D-H private key.
+#       sinstance       (only for version 3) The sender instance tag.
+#       rinstance       (only for version 3) The receiver instance tag.
+#
+# Result:
+#       BASE64 encoded binary OTR packet with the message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::createDHCommitPayload {version r x sinstance rinstance} {
+    set res ""
+    append res [::otr::data::encode SHORT $version]
+    append res [::otr::data::encode BYTE 0x02]
+    if {$version > 2} {
+        append res [::otr::data::encode INT $sinstance]
+        append res [::otr::data::encode INT $rinstance]
+    }
+    set gx [::otr::crypto::DHGx $x]
+    set gxmpi [::otr::data::encode MPI $gx]
+    set egxmpi [::otr::crypto::aes $gxmpi $r 0]
+    append res [::otr::data::encode DATA $egxmpi]
+    append res [::otr::data::encode DATA [::sha2::sha256 -bin $gxmpi]]
+    ::otr::data::encodeMessage $res
+}
+
+# ::otr::auth::processDHCommitMessage --
+#
+#       Pick the received D-H Commit message without the protocol version,
+#       packet type and instance tags, as well as the D-H private key, and
+#       create a suitable reply message.
+#
+# Arguments:
+#       version         OTR protocol version.
+#       authstate       AKE authentication state.
+#       msgstate        Message state.
+#       data            D-H commit packet to process.
+#       x               D-H private key which is to be used for creating the
+#                       answer.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#       -r r            One-time AES key to use only in auth state
+#                       AUTHSTATE_AWAITING_DHKEY to recreate D-H commit
+#                       message.
+#
+# Result:
+#       Tuple {auhstate msgstate message} or {authstate msgstate message
+#       egxmpi hgxmpi} with new FSM state, the message to reply, and encrypted
+#       and hashed peer's D-H public key to store if the current FSM state is
+#       appropriate.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::processDHCommitMessage {version authstate msgstate data \
+                                          x args} {
+    set sinstance 0x100
+    set rinstance 0x100
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+            -r { set r $val }
+        }
+    }
+
+    if {[catch {parseDHCommitMessage $version $data} res]} {
+        return [list $authstate $msgstate ""]
+    }
+
+    lassign $res egxmpi hgxmpi
+
+    switch -- $authstate {
+        AUTHSTATE_NONE -
+        AUTHSTATE_AWAITING_SIG {
+            set authstate AUTHSTATE_AWAITING_REVEALSIG
+            return [list $authstate $msgstate [createDHKeyMessage \
+                                                    $version \
+                                                    $x \
+                                                    -sinstance $rinstance \
+                                                    -rinstance $sinstance] \
+                                              $egxmpi $hgxmpi]
+        }
+        AUTHSTATE_AWAITING_DHKEY {
+            set gx [::otr::crypto::DHGx $x]
+            set gxmpi [::otr::data::encode MPI $gx]
+            set myhgxmpi [::sha2::sha256 -bin $gxmpi]
+            
+            if {[::otr::data::Bin2Int $myhgxmpi] >
+                                        [::otr::data::Bin2Int $hgxmpi]} {
+                return [list $authstate $msgstate [createDHCommitMessage \
+                                                        $version \
+                                                        $authstate \
+                                                        $msgstate \
+                                                        $r \
+                                                        $x \
+                                                        -sinstance $rinstance]]
+            } else {
+                set authstate AUTHSTATE_AWAITING_REVEALSIG
+                return [list $authstate $msgstate [createDHKeyMessage \
+                                                      $version \
+                                                      $x \
+                                                      -sinstance $rinstance \
+                                                      -rinstance $sinstance] \
+                                                  $egxmpi $hgxmpi]
+            }
+        }
+        AUTHSTATE_AWAITING_REVEALSIG {
+            return [list $authstate $msgstate [createDHKeyMessage \
+                                                    $version \
+                                                    $x \
+                                                    -sinstance $rinstance \
+                                                    -rinstance $sinstance] \
+                                              $egxmpi $hgxmpi]
+        }
+    }
+}
+
+# ::otr::auth::parseDHCommitMessage --
+#
+#       Parse the D-H commit message (without version and packet type which
+#       were extracted earlier).
+#
+# Arguments:
+#       version         Protocol version (2 or 3).
+#       data            Payload to parse.
+#
+# Result:
+#       Tuple {egxmpi, H(gxmpi)}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::auth::parseDHCommitMessage {version data} {
+    lassign [::otr::data::decode DATA $data] egxmpi data
+    lassign [::otr::data::decode DATA $data] hgxmpi data
+    list $egxmpi $hgxmpi
+}
+
+# ::otr::auth::createDHKeyMessage --
+#
+#       Assemble the first OTR AKE message which Alice returns to Bob - the
+#       D-H key one.
+#
+# Arguments:
+#       version         Protocol version (2 or 3).
+#       y               D-H private key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       BASE64 encoded OTR packet with the message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::createDHKeyMessage {version y args} {
+    set sinstance 0x100
+    set rinstance 0
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+    set res ""
+    append res [::otr::data::encode SHORT $version]
+    append res [::otr::data::encode BYTE 0x0a]
+    if {$version > 2} {
+        append res [::otr::data::encode INT $sinstance]
+        append res [::otr::data::encode INT $rinstance]
+    }
+    set gy [::otr::crypto::DHGx $y]
+    append res [::otr::data::encode MPI $gy]
+    ::otr::data::encodeMessage $res
+}
+
+# ::otp::auth::processDHKeyMessage --
+#
+#       Pick the received D-H Key message without the protocol version,
+#       packet type and instance tags, as well as the one-time AES key, D-H
+#       private key with its keyid, and create a suitable reply message.
+#
+# Arguments:
+#       version         OTR protocol version.
+#       authstate       AKE authentication state.
+#       msgstate        Message state.
+#       data            D-H key packet to process.
+#       r               One time AES key to reveal to the peer.
+#       x               D-H private key which is to be used for creating the
+#                       answer.
+#       keyid           Serial number of the above D-H key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#       -gy gy          The already obtained peer's D-H public key for the case
+#                       when it's a repeated D-H key message (used only in
+#                       auth state AUTHSTATE_AWAITING_SIG).
+#
+# Result:
+#       Tuple {auhstate msgstate message} or {authstate msgstate message gy}
+#       with new FSM state, the message to reply, and the peer's D-H public
+#       key  to store if the current FSM state is appropriate.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::processDHKeyMessage {version authstate msgstate data
+                                       privkey r x keyid args} {
+    set sinstance 0x100
+    set rinstance 0x100
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+            -gy { set oldgy $val }
+        }
+    }
+
+    if {[catch {parseDHKeyMessage $version $data} res]} {
+        return [list $authstate $msgstate ""]
+    }
+
+    lassign $res gy
+    if {![::otr::crypto::DHCheck $gy]} {
+        return [list $authstate $msgstate ""]
+    }
+
+    switch -- $authstate {
+        AUTHSTATE_NONE -
+        AUTHSTATE_AWAITING_REVEALSIG {
+            return [list $authstate $msgstate ""]
+        }
+        AUTHSTATE_AWAITING_DHKEY {
+            lassign [::otr::crypto::DHKeys $gy $x] ssid c cp m1 m2 m1p m2p
+
+            set authstate AUTHSTATE_AWAITING_SIG
+            return [list $authstate $msgstate [createRevealSignatureMessage \
+                                                    $version $r $c $m1 $m2 \
+                                                    $x $gy $privkey $keyid \
+                                                    -sinstance $rinstance \
+                                                    -rinstance $sinstance] \
+                                              $gy]
+        }
+        AUTHSTATE_AWAITING_SIG {
+            if {$gy != $oldgy} {
+                return [list $authstate $msgstate ""]
+            } else {
+                return [list $authstate $msgstate \
+                             [createRevealSignatureMessage \
+                                        $version $r $c $m1 $m2 \
+                                        $x $gy $privkey $keyid \
+                                        -sinstance $rinstance \
+                                        -rinstance $sinstance] \
+                             $gy]
+            }
+        }
+    }
+}
+
+# ::otr::auth::parseDHKeyMessage --
+#
+#       Parse the D-H key message (without version and packet type which
+#       were extracted earlier).
+#
+# Arguments:
+#       version         The protocol version (2 or 3).
+#       data            The payload to parse.
+#
+# Result:
+#       Tuple {gy}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::auth::parseDHKeyMessage {version data} {
+    lassign [::otr::data::decode MPI $data] gy data
+    list $gy
+}
+
+# ::otr::auth::createRevealSignatureMessage --
+#
+#       Assemble the third OTR AKE message which Bob sends to Alice - the
+#       reveal signature one.
+#
+# Arguments:
+#       version         The protocol version (2 or 3).
+#       r               The random value which was used as an AES key.
+#       c               AES key computed from the shared secret.
+#       m1              MAC key computed from the shared secret.
+#       m2              MAC key computed from the shared secret.
+#       x               The random value which is the part of shared secret.
+#       gy              The part of D-H shared secret.
+#       keyB            Long-term private key.
+#       keyidB          Serial number for the D-H key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       BASE64 encoded OTR packet with the message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::createRevealSignatureMessage {version r c m1 m2 x \
+                                                gy keyB keyidB args} {
+    set sinstance 0x100
+    set rinstance 0
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+    set res ""
+    append res [::otr::data::encode SHORT $version]
+    append res [::otr::data::encode BYTE 0x11]
+    if {$version > 2} {
+        append res [::otr::data::encode INT $sinstance]
+        append res [::otr::data::encode INT $rinstance]
+    }
+    append res [::otr::data::encode DATA $r]
+
+    set gx [::otr::crypto::DHGx $x]
+    set gxmpi [::otr::data::encode MPI $gx]
+    set gympi [::otr::data::encode MPI $gy]
+    set pubB [::otr::data::encode PUBKEY $keyB]
+    set ikeyidB [::otr::data::encode INT $keyidB]
+    set MB [::sha2::hmac -bin -key $m1 $gxmpi$gympi$pubB$ikeyidB]
+    
+    set sigBMB [::otr::data::encode SIG [::otr::crypto::sign $MB $keyB]]
+    set encr [::otr::crypto::aes $pubB$ikeyidB$sigBMB $c 0]
+    set encrfield [::otr::data::encode DATA $encr]
+    append res $encrfield
+    append res \
+           [::otr::data::encode MAC [::sha2::hmac -bin -key $m2 $encrfield]]
+    ::otr::data::encodeMessage $res
+}
+
+# ::otr::auth::processRevealSignatureMessage --
+#
+#       Pick the received Reveal signature message without the protocol
+#       version, packet type and instance tags, as well as the got earlier
+#       peer's encrypted and hashed D-H public key, D-H private key with its
+#       keyid, and create a suitable reply message.
+#
+# Arguments:
+#       version         OTR protocol version.
+#       authstate       AKE authentication state.
+#       msgstate        Message state.
+#       data            Reveal signature packet to process.
+#       egxmpi          Encrypted peer's D-H public key.
+#       hgxmpi          Hashed peer's D-H public key.
+#       keyA            DSA private key.
+#       y               D-H private key which is to be used for decrypting,
+#                       verifying the hash and creating the answer.
+#       keyidA          Serial number of the above D-H key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       Tuple {auhstate msgstate message} or {authstate msgstate message key
+#       gx keyid} with new FSM state, the message to reply, and the peer's
+#       DSA public key, D-H public key and its serial to store if the current
+#       FSM state is appropriate.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::processRevealSignatureMessage {version authstate msgstate \
+                                                 data egxmpi hgxmpi keyA y \
+                                                 keyidA args} {
+    set sinstance 0x100
+    set rinstance 0x100
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+
+    if {[catch {parseRevealSignatureMessage $version $data} res]} {
+        #puts "Reveal signature message is corrupt"
+        return [list $authstate $msgstate ""]
+    }
+
+    lassign $res r encr hmac
+
+    switch -- $authstate {
+        AUTHSTATE_NONE -
+        AUTHSTATE_AWAITING_DHKEY -
+        AUTHSTATE_AWAITING_SIG {
+            #puts "Wrong state for reveal signature message"
+            return [list $authstate $msgstate ""]
+        }
+        AUTHSTATE_AWAITING_REVEALSIG {
+            set gxmpi [::otr::crypto::aes $egxmpi $r 0]
+            set vhgxmpi [::sha2::sha256 -bin $gxmpi]
+            if {$hgxmpi ne $vhgxmpi} {
+                #puts "H(Gx) and decrypted Gx from D-H commit differ"
+                return [list $authstate $msgstate ""]
+            }
+
+            if {[catch {::otr::data::decode MPI $gxmpi} res]} {
+                #puts "D-H public key can't be deciphered"
+                return [list $authstate $msgstate ""]
+            }
+            lassign $res gx
+            if {![::otr::crypto::DHCheck $gx]} {
+                #puts "D-H public key is incorrect"
+                return [list $authstate $msgstate ""]
+            }
+            lassign [::otr::crypto::DHKeys $gx $y] ssid c cp m1 m2 m1p m2p
+
+            set myhmac \
+                [::sha2::hmac -bin -key $m2 [::otr::data::encode DATA $encr]]
+            if {[string range $myhmac 0 19] ne $hmac} {
+                #puts "HMAC in Reveal signature message is invalid"
+                return [list $authstate $msgstate ""]
+            }
+
+            set decr [::otr::crypto::aes $encr $c 0]
+            if {[catch {parsePubkey $decr} res]} {
+                #puts "DSA public key can't be deciphered"
+                return [list $authstate $msgstate ""]
+            }
+            lassign $res keyB keyidB sigBMB
+
+            set gxmpi [::otr::data::encode MPI $gx]
+            set gympi [::otr::data::encode MPI [::otr::crypto::DHGx $y]]
+            set pubB [::otr::data::encode PUBKEY $keyB]
+            set ikeyidB [::otr::data::encode INT $keyidB]
+            set MB [::sha2::hmac -bin -key $m1 $gxmpi$gympi$pubB$ikeyidB]
+
+            if {![::otr::crypto::verify $MB $sigBMB $keyB]} {
+                #puts "DSA signature in Reveal signature message is invalid"
+                return [list $authstate $msgstate ""]
+            }
+
+            set authstate AUTHSTATE_NONE
+            set msgstate MSGSTATE_ENCRYPTED
+
+            set message [createSignatureMessage $version $cp $m1p $m2p \
+                                                $y $gx $keyA $keyidA \
+                                                -sinstance $rinstance \
+                                                -rinstance $sinstance]
+            return [list $authstate $msgstate $message $keyB $gx $keyidB]
+        }
+    }
+}
+
+# ::otr::auth::parseRevealSignatureMessage --
+#
+#       Parse the reveal signature message (without version and packet type
+#       which were extracted earlier).
+#
+# Arguments:
+#       version         The protocol version (2 or 3).
+#       data            The payload to parse.
+#
+# Result:
+#       Tuple {r, eXB, hmac}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::auth::parseRevealSignatureMessage {version data} {
+    lassign [::otr::data::decode DATA $data] r data
+    lassign [::otr::data::decode DATA $data] encr data
+    lassign [::otr::data::decode MAC $data] hmac data
+    list $r $encr $hmac
+}
+
+# ::otr::auth::createSignatureMessage --
+#
+#       Assemble the fourth OTR AKE message which Alice returns to Bob - the
+#       signature one.
+#
+# Arguments:
+#       version         The protocol version (2 or 3).
+#       cp              AES key computed from the shared secret.
+#       m1p             MAC key computed from the shared secret.
+#       m2p             MAC key computed from the shared secret.
+#       y               The random value which is the part of shared secret.
+#       gx              The part of D-H shared secret.
+#       keyA            Long-term private key.
+#       keyidA          Serial number for the D-H key.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       BASE64 encoded OTR packet with the message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::createSignatureMessage {version cp m1p m2p y gx \
+                                          keyA keyidA args} {
+    set sinstance 0x100
+    set rinstance 0
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+    set res ""
+    append res [::otr::data::encode SHORT $version]
+    append res [::otr::data::encode BYTE 0x12]
+    if {$version > 2} {
+        append res [::otr::data::encode INT $sinstance]
+        append res [::otr::data::encode INT $rinstance]
+    }
+
+    set gy [::otr::crypto::DHGx $y]
+    set gympi [::otr::data::encode MPI $gy]
+    set gxmpi [::otr::data::encode MPI $gx]
+    set pubA [::otr::data::encode PUBKEY $keyA]
+    set ikeyidA [::otr::data::encode INT $keyidA]
+    set MA [::sha2::hmac -bin -key $m1p $gympi$gxmpi$pubA$ikeyidA]
+    set sigAMA [::otr::data::encode SIG [::otr::crypto::sign $MA $keyA]]
+    set encr [::otr::crypto::aes $pubA$ikeyidA$sigAMA $cp 0]
+    set encrfield [::otr::data::encode DATA $encr]
+    append res $encrfield
+    append res \
+           [::otr::data::encode MAC [::sha2::hmac -bin -key $m2p $encrfield]]
+    ::otr::data::encodeMessage $res
+}
+
+# ::otr::auth::processSignatureMessage --
+#
+#       Pick the received Signature message without the protocol version,
+#       packet type and instance tags, as well as the got earlier
+#       peer's D-H public key, D-H private key, and create a suitable reply
+#       message (which is always empty).
+#
+# Arguments:
+#       version         OTR protocol version.
+#       authstate       AKE authentication state.
+#       msgstate        Message state.
+#       data            Signature packet to process.
+#       gy              Peer's D-H public key.
+#       x               D-H private key which is to be used for decrypting,
+#                       verifying the hash and creating the answer.
+#       -sinstance num  (only for version 3) The sender instance tag.
+#       -rinstance num  (only for version 3) The receiver instance tag.
+#
+# Result:
+#       Tuple {auhstate msgstate message} or {authstate msgstate message key
+#       gy keyid} with new FSM state, the message to reply, and the peer's
+#       DSA public key, and serial of the D-H public key to store if the
+#       current FSM state is appropriate.
+#
+# Side effects:
+#       None.
+
+proc ::otr::auth::processSignatureMessage {version authstate msgstate data
+                                           gy x args} {
+    set sinstance 0x100
+    set rinstance 0x100
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+
+    if {[catch {parseSignatureMessage $version $data} res]} {
+        return [list $authstate $msgstate ""]
+    }
+
+    lassign $res encr hmac
+
+    switch -- $authstate {
+        AUTHSTATE_NONE -
+        AUTHSTATE_AWAITING_DHKEY -
+        AUTHSTATE_AWAITING_REVEALSIG {
+            return [list $authstate $msgstate ""]
+        }
+        AUTHSTATE_AWAITING_SIG {
+            lassign [::otr::crypto::DHKeys $gy $x] ssid c cp m1 m2 m1p m2p
+            set myhmac \
+                [::sha2::hmac -bin -key $m2p [::otr::data::encode DATA $encr]]
+            if {[string range $myhmac 0 19] ne $hmac} {
+                #puts "HMAC in Signature message is invalid"
+                return [list $authstate $msgstate ""]
+            }
+
+            set decr [::otr::crypto::aes $encr $cp 0]
+            if {[catch {parsePubkey $decr} res]} {
+                # puts "DSA public key can't be deciphered"
+                return [list $authstate $msgstate ""]
+            }
+            lassign $res keyA keyidA sigAMA
+
+            set gympi [::otr::data::encode MPI $gy]
+            set gxmpi [::otr::data::encode MPI [::otr::crypto::DHGx $x]]
+            set pubA [::otr::data::encode PUBKEY $keyA]
+            set ikeyidA [::otr::data::encode INT $keyidA]
+            set MA [::sha2::hmac -bin -key $m1p $gympi$gxmpi$pubA$ikeyidA]
+
+            if {![::otr::crypto::verify $MA $sigAMA $keyA]} {
+                #puts "DSA signature in Signature message is invalid"
+                return [list $authstate $msgstate ""]
+            }
+
+            set authstate AUTHSTATE_NONE
+            set msgstate MSGSTATE_ENCRYPTED
+
+            return [list $authstate $msgstate "" $keyA $keyidA]
+        }
+    }
+}
+
+# ::otr::auth::parseSignatureMessage --
+#
+#       Parse the signature message (without version and packet type
+#       which were extracted earlier).
+#
+# Arguments:
+#       version         The protocol version (2 or 3).
+#       data            The payload to parse.
+#
+# Result:
+#       Tuple {eXB, hmac}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::auth::parseSignatureMessage {version data} {
+    lassign [::otr::data::decode DATA $data] encr data
+    lassign [::otr::data::decode MAC $data] hmac data
+    list $encr $hmac
+}
+
+# ::otr::auth::parsePubkey --
+#
+#       Parse the pubkey, keyid, signature data block.
+#
+# Arguments:
+#       data            The data to parse.
+#
+# Result:
+#       Tuple {pubkey, keyid, signature}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::auth::parsePubkey {data} {
+    lassign [::otr::data::decode PUBKEY $data] key data
+    lassign [::otr::data::decode INT $data] keyid data
+    lassign [::otr::data::decode SIG $data] sig
+    list $key $keyid $sig
+}
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/auth.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/crypto.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/crypto.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/crypto.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,511 @@
+# crypto.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the OTR cryptography procedures.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require Tcl 8.5
+package require sha1
+package require sha256
+package require aes
+package require otr::data
+
+package provide otr::crypto 0.1
+
+##############################################################################
+
+namespace eval ::otr::crypto {
+    # Useful constants
+
+    set Prime \
+        0x[join {FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1
+                 29024E08 8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD
+                 EF9519B3 CD3A431B 302B0A6D F25F1437 4FE1356D 6D51C245
+                 E485B576 625E7EC6 F44C42E9 A637ED6B 0BFF5CB6 F406B7ED
+                 EE386BFB 5A899FA5 AE9F2411 7C4B1FE6 49286651 ECE45B3D
+                 C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8 FD24CF5F
+                 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D
+                 670C354E 4ABC9804 F1746C08 CA237327 FFFFFFFF FFFFFFFF} ""]
+    set G 2
+
+    if {![file readable /dev/urandom]} {
+        package require Memchan
+        # Random channel from Memchan uses the ISAAC algorithm which is
+        # supposedly cryptographically secure
+        set randomfd [::random]
+    }
+}
+
+##############################################################################
+#
+#       Diffie-Hellman key exchange auxiliary procedures
+
+proc ::otr::crypto::DHGx {x} {
+    variable Prime
+    variable G
+
+    Power $Prime $G $x
+}
+
+proc ::otr::crypto::DHCheck {gy} {
+    variable Prime
+
+    expr {$gy > 1 && $gy < $Prime-1}
+}
+
+proc ::otr::crypto::DHSecret {gy x} {
+    variable Prime
+
+    Power $Prime $gy $x
+}
+
+proc ::otr::crypto::DHKeys {gy x} {
+    set s [DHSecret $gy $x]
+    set secbytes [::otr::data::encode MPI $s]
+    set ssid [string range [::sha2::sha256 -bin \x00$secbytes] 0 7]
+    set ccp [::sha2::sha256 -bin \x01$secbytes]
+    set c [string range $ccp 0 15]
+    set cp [string range $ccp 16 31]
+    set m1 [::sha2::sha256 -bin \x02$secbytes]
+    set m2 [::sha2::sha256 -bin \x03$secbytes]
+    set m1p [::sha2::sha256 -bin \x04$secbytes]
+    set m2p [::sha2::sha256 -bin \x05$secbytes]
+    set extrakey [::sha2::sha256 -bin \xff$secbytes]
+    list $ssid $c $cp $m1 $m2 $m1p $m2p $extrakey
+}
+
+proc ::otr::crypto::AESKeys {gy x} {
+    set s [DHSecret $gy $x]
+    set secbytes [::otr::data::encode MPI $s]
+    set gx [DHGx $x]
+
+    if {$gx > $gy} {
+        # We're on the high end
+        set sendbyte \x01
+        set recvbyte \x02
+    } else {
+        # We're on the low end
+        set sendbyte \x02
+        set recvbyte \x01
+    }
+    set skey [string range [::sha1::sha1 -bin $sendbyte$secbytes] 0 15]
+    set rkey [string range [::sha1::sha1 -bin $recvbyte$secbytes] 0 15]
+    set smac [::sha1::sha1 -bin $skey]
+    set rmac [::sha1::sha1 -bin $rkey]
+    list $skey $smac $rkey $rmac
+}
+
+##############################################################################
+#
+#       AES128-CTR
+
+# ::otr::crypto::aes --
+#
+#       Encrypt or decrypt (these operations are the same) binary data using
+#       AES128-CTR method.
+#
+# Arguments:
+#       data        Binary data to encrypt/decrypt.
+#       key         128-bit binary key.
+#       ctrtop      64-bit integer top counter.
+#       ctrbot      (optional, 0 by default) 64-bit integer bottom counter.
+#
+# Result:
+#       Encrypted/decrypted binary data.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::aes {data key ctrtop {ctrbot 0}} {
+        set res ""
+        set ctr [expr {$ctrtop*(2**64) + $ctrbot}]
+
+        while {[string length $data] > 0} {
+            # Make binary counter
+            set binctr [Int2Octets $ctr 128]
+            # Encrypt $binctr using $key
+            set binectr [::aes::aes -mode ecb -dir encrypt -key $key $binctr]
+            # XOR the data chunk with the encrypted counter
+            set chunk [string range $data 0 15]
+            set len [string length $chunk]
+            set binectr [string range $binectr 0 [expr {$len-1}]]
+            append res [Xor $binectr $chunk]
+            set data [string range $data 16 end]
+            incr ctr
+        }
+        return $res
+}
+
+# ::otr::crypto::Xor --
+#
+#       Return bitwize XOR between two binary strings of equal length.
+#
+# Arguments:
+#       data1       Binary to XOR.
+#       data2       Binary to XOR.
+#
+# Result:
+#       Bitwise XOR of the supplied binaries or error if their lengths differ.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Xor {data1 data2} {
+    set res ""
+    binary scan $data1 cu* clist1
+    binary scan $data2 cu* clist2
+    foreach c1 $clist1 c2 $clist2 {
+        append res [binary format cu [expr {$c1 ^ $c2}]]
+    }
+    return $res
+}
+
+##############################################################################
+#
+#       DSA signing and verifying
+
+# ::otr::crypto::sign --
+#
+#       Sign binary data using the DSA algorithm.
+#
+# Arguments:
+#       data            Binary data to sign.
+#       key             DSA private key (list {p q g y x}).
+#       -hash proc      (optional, default is no hash) Hash function
+#                       (::sha1::sha1 or ::sha2::sha256 works) to apply to the
+#                       signed data.
+#       -random num     (optional, useful for testing only) Random number to
+#                       add to the signature.
+#
+# Result:
+#       The DSA signature (list {r s}).
+#
+# Side effects:
+#       The side effects of ::otr::crypto::random in case if there's no
+#       -random or -hmac options.
+
+proc ::otr::crypto::sign {data key args} {
+    lassign $key p q g y x
+
+    set random 0
+    set h1 $data
+    set hmac ""
+    foreach {opt val} $args {
+        switch -- $opt {
+            -random { set random $val }
+            -hash { set h1 [$val -bin $data] }
+            -hmac { set hmac $val }
+        }
+    }
+
+    set qlen [BitLength $q]
+    set h [Bits2Int $h1]
+
+    set r 0
+    set s 0
+    set k 0
+    while {$r == 0 || $s == 0} {
+        if {$random == 0} {
+            while {$k == 0} {
+                set k [expr {[random $qlen] % $q}]
+            }
+        } else {
+            set k $random ; # For testing purposes only
+        }
+
+        set r [expr {[Power $p $g $k] % $q}]
+        set s [Mult $q [Inverse $q $k] [expr {$h + $x*$r}]]
+    }
+    list $r $s
+}
+
+# ::otr::crypto::verify --
+#
+#       Verify binary data DSA signature.
+#
+# Arguments:
+#       data            Binary data.
+#       sig             DSA signature to verify.
+#       key             DSA public key (list {p q g y}).
+#       -hash proc      (optional, default is no hash) Hash function
+#                       (::sha1::sha1 or ::sha2::sha256 works) to apply to the
+#                       signed data.
+#
+# Result:
+#       1 if the signature is correct, 0 otherwise.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::verify {data sig key args} {
+    lassign $sig r s
+    lassign $key p q g y
+
+    if {$r <= 0 || $r >= $q || $s <= 0 || $s >= $q} {
+        return 0
+    }
+
+    set data1 $data
+    foreach {opt val} $args {
+        switch -- $opt {
+            -hash { set data1 [$val -bin $data] }
+        }
+    }
+
+    set hash [Bits2Int $data1]
+    set w [Inverse $q $s]
+    set u1 [Mult $q $hash $w]
+    set u2 [Mult $q $r $w]
+    set v0 [Mult $p [Power $p $g $u1] [Power $p $y $u2]]
+    set v [expr {$v0 % $q}]
+    expr {$v == $r}
+}
+
+# ::otr::crypto::BitLength --
+#
+#       Return the bit length of the given number x (minimum l such that
+#       2**l is greater than x).
+#
+# Arguments:
+#       x           Non-negative nteger.
+#
+# Result:
+#       Bit length of x.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::BitLength {x} {
+    set len 0
+    while {$x >= 2**$len} {
+        incr len
+    }
+    set len
+}
+
+# ::otr::crypto::Bits2Int --
+#
+#       Convert binary into an unsigned integer treating binary as a big
+#       endian byte array.
+#
+# Arguments:
+#       data        Binary to convert.
+#       len         Number of leftmost bits to convert. If 0 then all bits
+#                   are to be converted.
+#
+# Result:
+#       Arbitrary length integer which corresponds to the first $len bits of
+#       the given binary. Bits are taken in big endian way.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Bits2Int {data {len 0}} {
+    binary scan $data cu* clist
+    set int [lindex $clist 0]
+    set olen [expr {($len - 1) / 8}]
+    foreach c [lrange $clist 1 end] {
+        if {$olen == 0} break
+        set int [expr {$int*256 + $c}]
+        incr olen -1
+    }
+    if {$len > 0} {
+        set int [expr {$int & ((2**($len+1)) - 1)}]
+    }
+    set int
+}
+
+# ::otr::crypto::Int2Octests --
+#
+#       Convert integer to the sequence of octets of the given length (left
+#       zero padded).
+#
+# Arguments:
+#       int         Non-negative integer.
+#       len         (optional, by default the hole x is converted into minimum
+#                   length binary) How many bits to convert (in fact the
+#                   number of bits would be 8*ceil(len/8).
+#
+# Result:
+#       Binary which represents the given integer.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Int2Octets {int {len 0}} {
+    if {$int == 0} {
+        return \00
+    }
+    set bin ""
+    set olen [expr {($len - 1) / 8}]
+    while {($len == 0 && $int > 0) || $olen >= 0} {
+        set bin [binary format cu [expr {$int % 256}]]$bin
+        set int [expr {$int / 256}]
+        incr olen -1
+    }
+    set bin
+
+}
+
+# ::otr::crypto::Bits2Octets --
+#
+#       Convert binary into another binary as described in RFC-6979 section
+#       2.3.4.
+#
+# Arguments:
+#       data        Binary to convert.
+#       q           Modulus.
+#
+# Result:
+#       Binary.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Bits2Octets {data q} {
+    set len [BitLength $q]
+    set z1 [Bits2Int $data $len]
+    set z2 [expr {$z1 % $q}]
+    Int2Octets $z2 $len
+}
+
+##############################################################################
+#
+#       Generating random number
+
+# ::otr::crypto::random --
+#
+#       Return random number which is not shorter than the required number
+#       of bits.
+#
+# Arguments:
+#       bits        Number of random bits to generate.
+#
+# Result:
+#       The generated random number.
+#
+# Side effects:
+#       Some entropy from /dev/urandom is used.
+
+proc ::otr::crypto::random {bits} {
+    set bytes [expr {($bits + 7) / 8}]
+    set rnd ""
+    if {[file readable /dev/urandom]} {
+        set fd [open /dev/urandom r]
+    } else {
+        variable randomfd
+        set fd $randomfd
+    }
+    catch {
+        fconfigure $fd -translation binary -buffering none
+        set rnd [read $fd $bytes]
+        close $f
+    }
+    Bits2Int $rnd $bits
+}
+
+##############################################################################
+#
+#       Useful procedures implementing arithmetics modulo some prime number.
+
+# ::otr::crypto::Mult --
+#
+#       Multiplication modulo some positive integer.
+#
+# Arguments:
+#       prime       Modulus (usually it's a prime number).
+#       x           The first multiplier.
+#       y           The second multiplier.
+#
+# Result:
+#       x*y mod p.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Mult {prime x y} {
+    expr {($x * $y) % $prime}
+}
+
+# ::otr::crypto::Inverse --
+#
+#       Inverse modulo some prime number. It's found using the Euclid GCD
+#       algorithm.
+#
+# Arguments:
+#       prime       Modulus (must be a prime number, or result will not be
+#                   the inversion.
+#       x           Number to inverse.
+#
+# Result:
+#       Number y such that x*y mod p = 1.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Inverse {prime x} {
+    lassign [EGCD $prime $x] x1 y1
+    expr {$y1 % $prime}
+}
+
+# ::otr::crypto::Power --
+#
+#       Power modulo some integer. It's implemented using the exponentiation
+#       by squaring algorithm.
+#
+# Arguments:
+#       prime       Modulus (usually it's a prime number).
+#       x           Exponentiation base.
+#       n           Exponentiation index.
+#
+# Result:
+#       x**n mod p.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::Power {prime x n} {
+    set y 1
+    while {$n > 0} {
+        if {$n % 2 == 0} {
+            set n [expr {$n / 2}]
+            set x [Mult $prime $x $x]
+        } else {
+            incr n -1
+            set y [Mult $prime $y $x]
+        }
+    }
+    return $y
+}
+
+# ::otr::crypto::EGCD --
+#
+#       Perform the Euclid algorithm to find the Greatest Common Divisor.
+#
+# Arguments:
+#       a           Positive integer.
+#       b           Positive integer.
+#
+# Result:
+#       Tuple {x y} where x = GCD(a,b), y is such that y*b mod a = x.
+#
+# Side effects:
+#       None.
+
+proc ::otr::crypto::EGCD {a b} {
+    set r [expr {$a % $b}]
+    if {$r == 0} {
+        return {0 1}
+    } else {
+        lassign [EGCD $b $r] x y
+        return [list $y [expr {$x - $y * ($a / $b)}]]
+    }
+}
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/crypto.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/data.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/data.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/data.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,481 @@
+# data.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the decoding/encoding procedures.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require base64
+
+package provide otr::data 0.1
+
+##############################################################################
+
+namespace eval ::otr::data {
+    set WSHeader " \t  \t\t\t\t \t \t \t  "
+    set WSv1 " \t \t  \t "
+    set WSv2 "  \t\t  \t "
+    set WSv3 "  \t\t  \t\t"
+}
+
+# ::otr::data::Bin2Int --
+#
+#       Convert binary into an unsigned integer treating binary as a big
+#       endian byte array.
+#
+# Arguments:
+#       data        Binary to convert.
+#
+# Result:
+#       Arbitrary length integer which corresponds to the given binary.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::Bin2Int {data} {
+    binary scan $data cu* clist
+    set int [lindex $clist 0]
+    foreach c [lrange $clist 1 end] {
+        set int [expr {$int*256 + $c}]
+    }
+    set int
+}
+
+# ::otr::data::encodeMessage --
+#
+#       Encode binary message using BASE64 and add ?OTR: prefix and . suffix.
+#
+# Arguments:
+#       data        Binary OTR message.
+#
+# Result:
+#       BASE64 encoded message ready for transmission.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::encodeMessage {data} {
+    return ?OTR:[::base64::encode -maxlen 0 $data].
+}
+
+# ::otr::data::binaryMessage --
+#
+#       Decode BASE64 message with ?OTR prefix and parse out the protocol
+#       version, the packet type and for version 3 packets the sender and
+#       receiver's instances.
+#
+# Arguments:
+#       data        Received or assembled from the fragments OTR BASE64
+#                   encoded message.
+#
+# Result:
+#       Tuple {version type binary ?sinstance rinstance?} where version is
+#       the OTR version, type is the packet type, sinstance is a sender's
+#       instance, rinstance is a receiver's instance, and binary is the
+#       rest of the binary message.
+#
+# Side effects:
+#       Error is raised if the message doesn't start with ?OTR: or if the
+#       BASE64 decoded message is too short to contain the protocol version,
+#       message type and sender and recipient instance tags (for version 3).
+
+proc ::otr::data::binaryMessage {data} {
+    if {![regexp {^\?OTR:(.*).$} $data -> message]} {
+        return -code error "Message doesn't contain OTR marker"
+    }
+    set binary [::base64::decode $message]
+    lassign [decode SHORT $binary] version binary
+    lassign [decode BYTE $binary] type binary
+    if {$version >= 3} {
+        lassign [decode INT $binary] sinstance binary
+        lassign [decode INT $binary] rinstance binary
+        return [list $version $type $binary $sinstance $rinstance]
+    } else {
+        return [list $version $type $binary]
+    }
+}
+
+# ::otr::data::queryMessage --
+#
+#       Return the OTR query message.
+#
+# Arguments:
+#       policy      The correspondent policy list.
+#
+# Result:
+#       The OTR query message which requests an OTR conversation with
+#       protocol versions including 2 if ALLOW_V2 belongs to the policy
+#       and 3 id ALLOW_V3 belongs to the policy.
+#
+# Side effects:
+#       Error is raised if the policy contains ALLOW_V1.
+
+proc ::otr::data::queryMessage {policy} {
+    set res ?OTR
+    if {"ALLOW_V1" in $policy} {
+        return -code error "OTR version 1 is not supported"
+    }
+    append res v
+    if {"ALLOW_V2" in $policy} {
+        append res 2
+    }
+    if {"ALLOW_V3" in $policy} {
+        append res 3
+    }
+    return $res?
+}
+
+# ::otr::data::findQueryMessage --
+#
+#       Parse the OTR query message if it is given.
+#
+# Arguments:
+#       message     Message to parse.
+#
+# Result:
+#       OTR versions list from the message if it is the OTR query message,
+#       or error if it is not.
+#
+# Side effects:
+#       Error is raised if the message is not an OTR query message.
+
+proc ::otr::data::findQueryMessage {message} {
+    if {![regexp {^\?OTR(\??)(?:v([^?]*))?\?} $message -> v1 v2]} {
+        # BUG: ?OTR? shows no support for version 1, though it doesn't
+        #      matter because we don't support OTR version 1
+        return -code error "Message is not an OTR query message"
+    }
+    set res {}
+    if {$v1 eq "?"} {
+        lappend res 1
+    }
+    set res [concat $res [split $v2 ""]]
+    return [lsort -unique $res]
+}
+
+# ::otr::data::whitespaceTag --
+#
+#       Return the OTR whitespace tag corresponding to a given policy.
+#
+# Arguments:
+#       policy      The correspondent policy list.
+#
+# Result:
+#       The OTR whitespace tag which indicates the willing to start an OTR
+#       conversation with protocol versions 2 if ALLOW_V2 belongs to the
+#       policy and 3 if ALLOW_V3 belongs to the policy.
+#
+# Side effects:
+#       Error is raised if ALLOW_V1 belongs to the policy.
+
+proc ::otr::data::whitespaceTag {policy} {
+    variable WSHeader
+    variable WSv2
+    variable WSv3
+
+    set res $WSHeader
+    if {"ALLOW_V1" in $policy} {
+        return -code error "OTR version 1 is not supported"
+    }
+    if {"ALLOW_V2" in $policy} {
+        append res $WSv2
+    }
+    if {"ALLOW_V3" in $policy} {
+        append res $WSv3
+    }
+    set res
+}
+
+# ::otr::data::findWhitespaceTag --
+#
+#       Find the OTR whitespace tag in a plaintext message.
+#
+# Arguments:
+#       message     Message to search.
+#
+# Result:
+#       OTR versions list from the message if the whitespace tag is found,
+#       or error if it is not.
+#
+# Side effects:
+#       Error is raised if the message doesn't contain the whitespace tag.
+
+proc ::otr::data::findWhitespaceTag {message} {
+    variable WSHeader
+    variable WSv1
+    variable WSv2
+    variable WSv3
+
+    set idx [string first $WSHeader $message]
+    if {$idx < 0} {
+        return -code error "There's no whitespace tag in the message"
+    }
+    set res {}
+    set str1 [string range $message [expr {$idx+16}] [expr {$idx+23}]]
+    set str2 [string range $message [expr {$idx+24}] [expr {$idx+31}]]
+    set str3 [string range $message [expr {$idx+32}] [expr {$idx+39}]]
+    if {$str1 eq $WSv1 || $str2 eq $WSv1 || $str3 eq $WSv1} {
+        lappend res 1
+    }
+    if {$str1 eq $WSv2 || $str2 eq $WSv2 || $str3 eq $WSv2} {
+        lappend res 2
+    }
+    if {$str1 eq $WSv3 || $str2 eq $WSv3 || $str3 eq $WSv3} {
+        lappend res 3
+    }
+    # TODO: remove the whitespace tag
+    return $res
+}
+
+# ::otr::data::removeWhitespaceTag --
+#
+#       Remove the OTR whitespace tag from a plaintext message.
+#
+# Arguments:
+#       message     Message to search.
+#
+# Result:
+#       The given message without the OTR whitespace tag if was any.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::removeWhitespaceTag {message} {
+    variable WSHeader
+    variable WSv1
+    variable WSv2
+    variable WSv3
+
+    string map [list $WSHeader "" $WSv1 "" $WSv2 "" $WSv3 ""] $message
+}
+
+# ::otr::data::errorMessage --
+#
+#       Create an OTR error message.
+#
+# Arguments:
+#       error       The error text.
+#
+# Result:
+#       The OTR error message.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::errorMessage {error} {
+    return "?OTR Error: $error"
+}
+
+# ::otr::data::findErrorMessage --
+#
+#       Check if a given message is an OTR error message and return the error
+#       text.
+#
+# Arguments:
+#       message     Message to check.
+#
+# Result:
+#       The error text or error if the message is not an OTR error message.
+#
+# Side effects:
+#       Error is raised if the message is not an OTR error message.
+
+proc ::otr::data::findErrorMessage {message} {
+    if {[regexp {^\?OTR Error:\s*(.*)} $message -> error]} {
+        return $error
+    } else {
+        return -code error "Message is not an OTR error message"
+    }
+}
+
+# ::otr::data::encode --
+#
+#       Encode given data to the binary format suitable for inclusion into
+#       an OTR binary message.
+#
+# Arguments:
+#       type        Data type (BYTE, SHORT, INT, MPI, DATA, CTR, MAC, PUBKEY,
+#                   SIG).
+#       data        Data to encode (for BYTE, SHORT, INT, MPI, CTR it's a
+#                   number, for DATA, MAC it's a binary string, for PUBKEY
+#                   it's a list of 4 numbers {p q g y}, for SIG it's a list
+#                   of 2 numbers {r s}).
+#
+# Result:
+#       Binary string.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::encode {type data} {
+    switch -- $type {
+        BYTE {
+            return [binary format cu $data]
+        }
+        SHORT {
+            return [binary format Su $data]
+        }
+        INT {
+            return [binary format Iu $data]
+        }
+        MPI {
+            if {$data == 0} {
+                return [binary format Iucu 1 0]
+            }
+            set len 0
+            set res ""
+            while {$data > 0} {
+                incr len
+                set res [binary format cu [expr {$data % 256}]]$res
+                set data [expr {$data / 256}]
+            }
+            return [binary format Iu $len]$res
+        }
+        DATA {
+            return [binary format Iu [string length $data]]$data
+        }
+        CTR {
+            return [binary format Wu $data]
+        }
+        MAC {
+            return [string range $data 0 19]
+        }
+        PUBKEY {
+            lassign $data p q g y
+            set res [encode SHORT 0] ; # DSA key only
+            append res [encode MPI $p]
+            append res [encode MPI $q]
+            append res [encode MPI $g]
+            append res [encode MPI $y]
+            return $res
+        }
+        SIG {
+            lassign $data r s
+            set res [binary format IuIuIuIuIu \
+                            [expr {$r / (256**16)}] \
+                            [expr {($r / (256**12)) % (256**4)}] \
+                            [expr {($r / (256**8)) % (256**4)}] \
+                            [expr {($r / (256**4)) % (256**4)}] \
+                            [expr {$r % (256**4)}]]
+            append res [binary format IuIuIuIuIu \
+                               [expr {$s / (256**16)}] \
+                               [expr {($s / (256**12)) % (256**4)}] \
+                               [expr {($s / (256**8)) % (256**4)}] \
+                               [expr {($s / (256**4)) % (256**4)}] \
+                               [expr {$s % (256**4)}]]
+            return $res
+        }
+    }
+}
+
+# ::otr::data::decode --
+#
+#       Decode a portion of given binary string and return the decoded
+#       value and the rest of the string.
+#
+# Arguments:
+#       type        Type of the decoded chunk.
+#       data        Binary string to decode.
+#
+# Result:
+#       List of two items: the decoded data chunk (the same as is given to
+#       ::otr::data::encode proc) and the rest of the input data.
+#
+# Side effects:
+#       None.
+
+proc ::otr::data::decode {type data} {
+    switch -- $type {
+        BYTE {
+            if {[binary scan $data cu num]} {
+                set res $num
+                set data [string range $data 1 end]
+            } else {
+                return -code error "Invalid BYTE"
+            }
+        }
+        SHORT {
+            if {[binary scan $data Su num]} {
+                set res $num
+                set data [string range $data 2 end]
+            } else {
+                return -code error "Invalid SHORT"
+            }
+        }
+        INT {
+            if {[binary scan $data Iu num]} {
+                set res $num
+                set data [string range $data 4 end]
+            } else {
+                return -code error "Invalid INT"
+            }
+        }
+        MPI {
+            if {[binary scan $data Iu len]} {
+                set res [Bin2Int [string range $data 4 [expr {$len+3}]]]
+                set data [string range $data [expr {$len+4}] end]
+            } else {
+                return -code error "Invalid MPI"
+            }
+        }
+        DATA {
+            if {[binary scan $data Iu len]} {
+                set res [string range $data 4 [expr {$len+3}]]
+                set data [string range $data [expr {$len+4}] end]
+            } else {
+                return -code error "Invalid DATA"
+            }
+        }
+        CTR {
+            if {[binary scan $data Wu num]} {
+                set res $num
+                set data [string range $data 8 end]
+            } else {
+                return -code error "Invalid CTR"
+            }
+        }
+        MAC {
+            set res [string range $data 0 19]
+            set data [string range $data 20 end]
+        }
+        PUBKEY {
+            lassign [decode SHORT $data] keytype data
+            if {$keytype != 0} {
+                return -code error "Only DSA keys are supported"
+            }
+            lassign [decode MPI $data] p data
+            lassign [decode MPI $data] q data
+            lassign [decode MPI $data] g data
+            lassign [decode MPI $data] y data
+            set res [list $p $q $g $y]
+        }
+        SIG {
+            set r [Bin2Int [string range $data 0 19]]
+            set s [Bin2Int [string range $data 20 39]]
+            set res [list $r $s]
+            set data [string range $data 40 end]
+        }
+    }
+    list $res $data
+}
+
+# ::otr::data::encodeTLV --
+
+proc ::otr::data::encodeTLV {type data} {
+    return [encode SHORT $type][encode SHORT [string length $data]]$data
+}
+
+# ::otr::data::decodeTLV --
+
+proc ::otr::data::decodeTLV {data} {
+    lassign [decode SHORT $data] type data
+    lassign [decode SHORT $data] length data
+    list $type [string range $data 0 [expr {$length-1}]] [string range $data $length end]
+}
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/data.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/license.terms
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/license.terms	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/license.terms	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,26 @@
+Copyright (c) 2013 Sergei Golovan <sgolovan at nes.ru>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


Property changes on: trunk/tkabber-plugins/otr/tclotr/license.terms
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/message.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/message.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/message.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,326 @@
+# message.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the OTR Data packets serializing and
+#       deserializing procedures.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require sha1
+package require otr::data
+package require otr::crypto
+package require otr::smp
+
+package provide otr::message 0.1
+
+##############################################################################
+
+namespace eval ::otr::message {
+    array set Flags {IGNORE_UNREADABLE 0x01}
+}
+
+# ::otr::message::createDataMessage --
+#
+#       Assemble the OTR data message, the only message type which is to be
+#       sent after AKE succeedes.
+#
+# Arguments:
+#       version         Protocol version (2 or 3).
+#       flags           List of message flags (currently either {} or
+#                       {IGNORE_UNREADABLE}).
+#       skeyid          Sender D-H key serial ID (for x1).
+#       rkeyid          Recipient D-H key serial ID (for gy).
+#       x1              Current D-H private key.
+#       x2              Next D-H private key.
+#       gy              Peer's current D-H public key.
+#       ctrtop          Top 64 bit of the counter for AES128-CTR cipher.
+#       humanreadable   Human readable message.
+#       tlvlist         List of even number of items, integer TLV types and
+#                       their binary payloads.
+#       -sinstance num  (only for version 3) Sender instance tag.
+#       -rinstance num  (only for version 3) Receiver instance tag.
+#
+# Result:
+#       BASE64 encoded OTR packet with the data message inside.
+#
+# Side effects:
+#       None.
+
+proc ::otr::message::createDataMessage {version flags skeyid rkeyid x1 x2 gy
+                                        ctrtop humanreadable tlvlist args} {
+    variable Flags
+
+    set sinstance 0x100
+    set rinstance 0
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+        }
+    }
+    set res ""
+    append res [::otr::data::encode SHORT $version]
+    append res [::otr::data::encode BYTE 0x03]
+    if {$version > 2} {
+        append res [::otr::data::encode INT $sinstance]
+        append res [::otr::data::encode INT $rinstance]
+    }
+    set binflags 0
+    foreach f $flags {
+        if {[info exists Flags($f)]} {
+            set binflags [expr {$binflags | $Flags($f)}]
+        }
+    }
+    append res [::otr::data::encode BYTE $binflags]
+    append res [::otr::data::encode INT $skeyid]
+    append res [::otr::data::encode INT $rkeyid]
+    set gx [::otr::crypto::DHGx $x2]
+    append res [::otr::data::encode MPI $gx]
+    append res [::otr::data::encode CTR $ctrtop]
+
+    set plaintext [createDataMessagePlaintext $humanreadable $tlvlist]
+
+    lassign [::otr::crypto::AESKeys $gy $x1] skey smac rkey rmac
+    set cryptotext [::otr::crypto::aes $plaintext $skey $ctrtop]
+    append res [::otr::data::encode DATA $cryptotext]
+
+    set hmac [::sha1::hmac -bin -key $smac $res]
+    append res [::otr::data::encode MAC $hmac]
+    # TODO
+    set oldmackeys ""
+    append res [::otr::data::encode DATA $oldmackeys]
+    ::otr::data::encodeMessage $res
+}
+
+# ::otr::message::processDataMessage --
+
+proc ::otr::message::processDataMessage {version msgstate smpstate data
+                                         skeyid1 rkeyid1 gy1 x args} {
+    set sinstance 0x100
+    set rinstance 0x100
+    foreach {key val} $args {
+        switch -- $key {
+            -sinstance { set sinstance $val }
+            -rinstance { set rinstance $val }
+            -r { set r $val }
+        }
+    }
+
+    if {[catch {parseDataMessage $data} res]} {
+        puts "Parsing data message failed: $res"
+
+        return [list $msgstate $smpstate ""]
+    }
+
+    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 ""]
+    }
+
+    # Reassemble the message and verify its hash
+
+    set msg ""
+    append msg [::otr::data::encode SHORT $version]
+    append msg [::otr::data::encode BYTE 0x03]
+    if {$version > 2} {
+        append msg [::otr::data::encode INT $sinstance]
+        append msg [::otr::data::encode INT $rinstance]
+    }
+    set binflags 0
+    foreach f $flags {
+        if {[info exists Flags($f)]} {
+            set binflags [expr {$binflags | $Flags($f)}]
+        }
+    }
+    append msg [::otr::data::encode BYTE $binflags]
+    append msg [::otr::data::encode INT $skeyid]
+    append msg [::otr::data::encode INT $rkeyid]
+    append msg [::otr::data::encode MPI $gy]
+    append msg [::otr::data::encode CTR $ctrtop]
+    append msg [::otr::data::encode DATA $cryptotext]
+
+    lassign [::otr::crypto::AESKeys $gy1 $x] skey smac rkey rmac
+
+    set myhmac [::sha1::hmac -bin -key $rmac $msg]
+
+    if {$myhmac ne $hmac} {
+        puts "Data message hash verification failed"
+        return [list $msgstate $smpstate ""]
+    }
+
+    set plaintext [::otr::crypto::aes $cryptotext $rkey $ctrtop]
+
+    if {[catch {parseDataMessagePlaintext $plaintext} res]} {
+        puts "Data message plaintext encoding failed: $res"
+        return [list $msgstate $smpstate ""]
+    }
+
+    lassign $res message tlvlist
+
+    foreach {type value} $tlvlist {
+        switch -- $type {
+            0 {
+                # Padding
+            }
+            1 {
+                # Disconnected
+                set msgstate MSGSTATE_FINISHED
+            }
+            2 {
+                # SMP message 1
+                # TODO
+                #::otr::smp::processSMPMessage1 ...
+            }
+            3 {
+                # SMP message 2
+                # TODO
+                #::otr::smp::processSMPMessage2 ...
+            }
+            4 {
+                # SMP message 3
+                # TODO
+                #::otr::smp::processSMPMessage3 ...
+            }
+            5 {
+                # SMP message 4
+                # TODO
+                #::otr::smp::processSMPMessage4 ...
+            }
+            6 {
+                # SMP abort message
+                # TODO
+                #::otr::smp::processSMPAbortMessage ...
+            }
+            7 {
+                # SMP message 1Q (for version 3 only)
+                if {$version < 3} {
+                    return [list $msgstate $smpstate $message]
+                }
+                # TODO
+                #::otr::smp::processSMPMessage1Q ...
+            }
+            8 {
+                # Extra symmetric key (for version 3 only)
+                if {$version < 3} {
+                    return [list $msgstate $smpstate $message]
+                }
+                # TODO
+            }
+            default {
+                #puts "Unknown TLV"
+            }
+        }
+    }
+    return [list $msgstate $smpstate $message $gy]
+}
+
+# ::otr::message::parseDataMessage --
+#
+#       Parse the OTR data message (without version, packet type and sender
+#       and receiver instance tags which were extracted earlier).
+#
+# Arguments:
+#       data            Payload to parse.
+#
+# Result:
+#       Tuple {}.
+#
+# Side effects:
+#       Error is raised if decoding is failed for some reason.
+
+proc ::otr::message::parseDataMessage {data} {
+    variable Flags
+
+    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 data
+    lassign [::otr::data::decode MPI $data] gy data
+    lassign [::otr::data::decode CTR $data] ctrtop data
+    lassign [::otr::data::decode DATA $data] cryptotext data
+    lassign [::otr::data::decode MAC $data] hmac data
+    lassign [::otr::data::decode DATA $data] oldmackeys
+    list $flags $skeyid $rkeyid $gy $ctrtop $cryptotext $hmac $oldmackeys
+}
+
+# ::otr::message::getDataMessageKeyids --
+#
+#       Return D-H key serial IDs encoded in the data message (with stripped
+#       out protocol version, message type, sender and receiver instance tags.
+#
+# Arguments:
+#       data            Payload to parse.
+#
+# Result:
+#       Tuple {skeyid, rkeyid} with the sender and recipient key serials, or
+#       tuple {0, 0} if decoding failed.
+#
+# Side effects:
+#       None.
+
+proc ::otr::message::getDataMessageKeyids {data} {
+    if {![catch {
+            lassign [::otr::data::decode BYTE $data] binflags data
+            lassign [::otr::data::decode INT $data] skeyid data
+            lassign [::otr::data::decode INT $data] rkeyid
+            list $skeyid $rkeyid
+         } res]} {
+        return $res
+    } else {
+        #puts $res
+        return {0 0}
+    }
+}
+
+# ::otr::message::createDataMessagePlaintext --
+
+proc ::otr::message::createDataMessagePlaintext {humanreadable tlvlist} {
+    set res [encoding convertto utf-8 $humanreadable]
+    if {[string first \x00 $res] >= 0} {
+        return -code error "Zero byte in the human readable message part"
+    }
+
+    if {[llength $tlvlist] > 0} {
+        append res \x00
+    }
+
+    foreach {type data} $tlvlist {
+        append res [::otr::data::encodeTLV $type $data]
+    }
+    set res
+}
+
+# ::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} {
+        set hrutf8 $data
+        set data ""
+    } else {
+        set hrutf8 [string range $data 0 [expr {$idx-1}]]
+        set data [string range $data [expr {$idx+1}] end]
+    }
+    while {[string length $data] > 0} {
+        lassign [::otr::data::decodeTLV $data] type value data
+        lappend tlvlist $type $value
+    }
+    list [encoding convertfrom utf-8 $hrutf8] $tlvlist
+}
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/message.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/otr.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/otr.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/otr.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,852 @@
+# otr.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the OTR instance implementation. Only
+#       versions 2 and 3 are implemented, any support for version 1 is
+#       omitted.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require otr::data
+package require otr::crypto
+package require otr::auth
+package require otr::message
+
+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
+    #   }
+
+    variable debug 0
+}
+
+# ::otr::new --
+#
+#       Create new OTR instance.
+#
+# Arguments:
+#       key                 Private key (tuple {p q g y x}).
+#       policy              List of policy flags.
+#
+# Result:
+#       Serialized array with fields 'token', 'authstate', 'msgstate'.
+#
+# Side effects:
+#       The state variable is created.
+
+proc ::otr::new {key {policy {}}} {
+    variable id
+
+    if {![info exists id]} {
+        set id 0
+    }
+
+    if {"ALLOW_V1" in $policy} {
+        return -code error "OTR version 1 is not supported"
+    }
+
+    set token [namespace current]::[incr id]
+    variable $token
+    upvar 0 $token state
+
+    array unset state
+
+    set state(AuthState) AUTHSTATE_NONE
+    set state(MsgState) MSGSTATE_PLAINTEXT
+    set state(SMPState) SMPSTATE_EXPECT1
+    set state(StoredMessages) {}
+    set state(PrivateKey) $key
+    set state(Policy) $policy
+    while {[set state(sinstance) [::otr::crypto::random 32]] < 0x100} {}
+
+    # Generate DH private keys (key management 1)
+
+    InitDHKeys $token
+
+    list token $token \
+         authstate $state(AuthState) \
+         msgstate $state(MsgState) \
+         smpstate $state(SMPState)
+}
+
+proc ::otr::free {token} {
+    variable $token
+    upvar 0 $token state
+
+    unset -nocomplain state
+}
+
+proc ::otr::setPolicy {token policy} {
+    variable $token
+    upvar 0 $token state
+
+    if {![info exists state(AuthState)]} return
+
+    if {"ALLOW_V1" in $policy} {
+        return -code error "OTR version 1 is not supported"
+    }
+
+    set state(Policy) $policy
+}
+
+proc ::otr::queryPolicy {token item} {
+    variable $token
+    upvar 0 $token state
+
+    expr {$item in $state(Policy)}
+}
+
+proc ::otr::requestConversation {token} {
+    variable $token
+    upvar $token state
+
+    list action send body [::otr::data::queryMessage $state(Policy)]
+}
+
+proc ::otr::finishConversation {token} {
+    variable $token
+    upvar $token state
+
+    switch -- $state(MsgState) {
+        MSGSTATE_PLAINTEXT {
+            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 state(MsgState) MSGSTATE_PLAINTEXT
+            InitDHKeys $token
+            return [list action   send \
+                         body     $message \
+                         msgstate $state(MsgState)]
+        }
+        MSGSTATE_FINISHED {
+            set state(MsgState) MSGSTATE_PLAINTEXT
+            return [list action discard msgstate $state(MsgState)]
+        }
+    }
+}
+
+proc ::otr::outgoingMessage {token message} {
+    variable $token
+    upvar 0 $token state
+
+    switch -- $state(MsgState) {
+        MSGSTATE_PLAINTEXT {
+            if {[queryPolicy $token REQUIRE_ENCRYPTION]} {
+                Store $token $message
+                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)]"]
+            } else {
+                return [list action send body $message]
+            }
+        }
+        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)]
+            return [list action send \
+                         body   $message]
+        }
+        MSGSTATE_FINISHED {
+            Store $token $message
+            return [list action stop error "Can't send message"]
+        }
+    }
+}
+
+proc ::otr::incomingMessage {token message} {
+    variable $token
+    upvar 0 $token state
+
+    # TODO: support for message fragmentation
+    if {![catch {::otr::data::binaryMessage $message} data]} {
+        # Binary OTR message
+
+        Debug $token 2 "OTR binary message"
+
+        return [DispatchBinaryMessage $token $data]
+
+    } elseif {![catch {::otr::data::findErrorMessage $message} error]} {
+        # OTR error message
+
+        Debug $token 2 "OTR error message"
+
+        # TODO: nice error report
+        if {[queryPolicy $token ERROR_START_AKE]} {
+            return [list action display_reply \
+                         body   $message \
+                         send   [::otr::data::queryMessage $state(Policy)]]
+        } else {
+            return [list action display \
+                         body   $message]
+        }
+    } elseif {![catch {::otr::data::findQueryMessage $message} versions] && \
+                    [set version [FindVersion $token $versions]]} {
+        # OTR query message of a suitable version
+
+        Debug $token 2 "OTR query message"
+
+        NewSession $token $version
+
+        set keyid [expr {$state(keyid)-1}]
+        lassign [::otr::auth::createDHCommitMessage \
+                        $state(version) \
+                        $state(AuthState) \
+                        $state(MsgState) \
+                        $state(r) \
+                        $state(x,$keyid) \
+                        -sinstance $state(sinstance)] \
+                        state(AuthState) state(MsgState) message
+        return [list action    reply \
+                     authstate $state(AuthState) \
+                     msgstate  $state(MsgState) \
+                     send      $message]
+    } elseif {![catch {::otr::data::findWhitespaceTag $message} versions]} {
+        # Plaintext with the whitespace tag
+
+        Debug $token 2 "Plaintext with the whitespace tag"
+
+        set message [::otr::data::removeWhitespaceTag $message]
+
+        if {[queryPolicy $token WHITESPACE_START_AKE] && \
+                    [set version [FindVersion $token $versions]]} {
+
+            NewSession $token $version
+
+            set keyid [expr {$state(keyid)-1}]
+            lassign [::otr::auth::createDHCommitMessage \
+                            $state(version) \
+                            $state(AuthState) \
+                            $state(MsgState) \
+                            $state(r) \
+                            $state(x,$keyid) \
+                            -sinstance $state(sinstance)] \
+                            state(AuthState) state(MsgState) reply
+            switch -- $state(MsgState) {
+                MSGSTATE_PLAINTEXT {
+                    return [list action    display_reply \
+                                 authstate $state(AuthState) \
+                                 msgstate  $state(MsgState) \
+                                 body      $message \
+                                 send      $reply]
+                }
+                MSGSTATE_ENCRYPTED -
+                MSGSTATE_FINISHED {
+                    return [list action    warn_reply \
+                                 authstate $state(AuthState) \
+                                 msgstate  $state(MsgState) \
+                                 body      $message \
+                                 send      $reply]
+                }
+            }
+        } else {
+            switch -- $state(MsgState) {
+                MSGSTATE_PLAINTEXT {
+                    return [list action display \
+                                 body   $message]
+                }
+                MSGSTATE_ENCRYPTED -
+                MSGSTATE_FINISHED {
+                    return [list action warn \
+                                 body   $message]
+                }
+            }
+        }
+    } else {
+        # Plaintext without a whitespace tag
+
+        Debug $token 2 "Plaintext without a whitespace tag"
+
+        switch -- $state(MsgState) {
+            MSGSTATE_PLAINTEXT {
+                return [list action display \
+                             body   $message]
+            }
+            MSGSTATE_ENCRYPTED -
+            MSGSTATE_FINISHED {
+                return [list action warn \
+                             body   $message]
+            }
+        }
+    }
+}
+
+proc ::otr::DispatchBinaryMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    lassign $data version type binary sinstance rinstance
+
+    Debug $token 2 "$version $type"
+
+    if {![info exists state(version)]} {
+        switch -- $type {
+            2 {
+                if {$version == 3 && [queryPolicy $token ALLOW_V3]} {
+                    set state(version) 3
+                } elseif {$version == 2 && [queryPolicy $token ALLOW_V2]} {
+                    set state(version) 2
+                } else {
+                    return [list action discard]
+                }
+            }
+            3 {
+                return [list action reply \
+                             send [::otr::data::errorMessage \
+                                        "Unreadable encrypted message"]]
+            }
+            default {
+                return [list action discard]
+            }
+        }
+    }
+
+    if {$version != $state(version)} {
+        return [list action reply \
+                     send [::otr::data::errorMessage \
+                                    "Incorrect OTR protocol version"]]
+    }
+
+    if {$version >= 3} {
+        if {$sinstance < 0x100 || \
+                ($rinstance > 0 && $rinstance != $state(sinstance))} {
+            return [list action discard]
+        }
+        if {![info exists state(rinstance)]} {
+            set state(rinstance) $sinstance
+        } elseif {$sinstance != $state(rinstance)} {
+            return [list action discard]
+        }
+    } else {
+        # Fake sinstance and rinstance for version 2
+        set state(sinstance) 0x100
+        set state(rinstance) 0x100
+    }
+
+    switch -- $type {
+        2 {
+            # D-H commit message
+            return [ProcessDHCommitMessage $token $binary]
+        }
+        3 {
+            # Data message
+            return [ProcessDataMessage $token $binary]
+        }
+        10 {
+            # D-H key message
+            return [ProcessDHKeyMessage $token $binary]
+        }
+        17 {
+            # Reveal signature message
+            return [ProcessRevealSignatureMessage $token $binary]
+        }
+        18 {
+            # Signature message
+            return [ProcessSignatureMessage $token $binary]
+        }
+        default {
+            return [list action discard]
+        }
+    }
+}
+
+proc ::otr::ProcessDHCommitMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    switch -- $state(AuthState) {
+        AUTHSTATE_AWAITING_DHKEY {
+            set arg [list -r $state(r)]
+        }
+        default {
+            set arg {}
+        }
+    }
+
+    set keyid [expr {$state(keyid)-1}]
+    lassign [::otr::auth::processDHCommitMessage \
+                    $state(version) \
+                    $state(AuthState) \
+                    $state(MsgState) \
+                    $data \
+                    $state(x,$keyid) \
+                    -sinstance $state(rinstance) \
+                    -rinstance $state(sinstance) \
+                    {*}$arg] \
+            state(AuthState) state(MsgState) message \
+            state(egxmpi) state(hgxmpi)
+
+    if {$message eq ""} {
+        return [list action    discard
+                     authstate $state(AuthState) \
+                     msgstate  $state(MsgState)]
+    } else {
+        return [list action    reply \
+                     authstate $state(AuthState) \
+                     msgstate  $state(MsgState) \
+                     send      $message]
+    }
+}
+
+proc ::otr::ProcessDHKeyMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    switch -- $state(AuthState) {
+        AUTHSTATE_AWAITING_SIG {
+            set arg [list -gy $state(gy)]
+        }
+        default {
+            set arg {}
+        }
+    }
+
+    set keyid [expr {$state(keyid)-1}]
+    lassign [::otr::auth::processDHKeyMessage \
+                    $state(version) \
+                    $state(AuthState) \
+                    $state(MsgState) \
+                    $data \
+                    $state(PrivateKey) \
+                    $state(r) \
+                    $state(x,$keyid) \
+                    $keyid \
+                    -sinstance $state(rinstance) \
+                    -rinstance $state(sinstance) \
+                    {*}$arg] \
+            state(AuthState) state(MsgState) message state(gy)
+
+    if {$message eq ""} {
+        return [list action    discard \
+                     authstate $state(AuthState) \
+                     msgstate  $state(MsgState)]
+    } else {
+        return [list action reply \
+                     send   $message \
+                     authstate $state(AuthState) \
+                     msgstate  $state(MsgState)]
+    }
+}
+
+proc ::otr::ProcessRevealSignatureMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    set keyid [expr {$state(keyid)-1}]
+    lassign [::otr::auth::processRevealSignatureMessage \
+                    $state(version) \
+                    $state(AuthState) \
+                    $state(MsgState) \
+                    $data \
+                    $state(egxmpi) \
+                    $state(hgxmpi) \
+                    $state(PrivateKey) \
+                    $state(x,$keyid) \
+                    $keyid \
+                    -sinstance $state(rinstance) \
+                    -rinstance $state(sinstance)] \
+            state(AuthState) state(MsgState) message \
+            state(PublicKey) gy keyidy
+
+    if {$message eq ""} {
+        return [list action    discard \
+                     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)]
+    }
+}
+
+proc ::otr::ProcessSignatureMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    set keyid [expr {$state(keyid)-1}]
+    lassign [::otr::auth::processSignatureMessage \
+                    $state(version) \
+                    $state(AuthState) \
+                    $state(MsgState) \
+                    $data \
+                    $state(gy) \
+                    $state(x,$keyid) \
+                    -sinstance $state(rinstance) \
+                    -rinstance $state(sinstance)] \
+            state(AuthState) state(MsgState) message state(PublicKey) keyidy
+
+    if {$keyidy ne ""} {
+        UpdatePeerDHKeysAfterAKE $token $state(gy) $keyidy
+
+        # TODO: Send stored messages
+    }
+    return [list action    discard \
+                 authstate $state(AuthState) \
+                 msgstate  $state(MsgState)]
+}
+
+proc ::otr::UpdatePeerDHKeysAfterAKE {token gy keyidy} {
+    variable $token
+    upvar 0 $token state
+
+    # Store the peer's D-H public key (key management 2)
+
+    if {$state(keyidy) == $keyidy && $state(gy,$keyidy) == $gy} {
+        # Do nothing
+    } elseif {$state(keyidy)-1 == $keyidy && $state(gy,$keyidy) == $gy} {
+        # Do nothing
+    } else {
+        array unset state gy,*
+        set state(keyidy) $keyidy
+        set state(gy,$keyidy) $gy
+        incr keyidy -1
+        set state(gy,$keyidy) 0
+    }
+}
+
+proc ::otr::ProcessDataMessage {token data} {
+    variable $token
+    upvar 0 $token state
+
+    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"]
+            }
+
+            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"]
+            }
+
+            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"]
+            }
+
+            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"]
+            }
+
+            # 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
+
+            if {$message eq ""} {
+                Debug 1 $token "Decrypted message is empty"
+                return [list action discard]
+            }
+
+            switch -- $state(MsgState) {
+                MSGSTATE_ENCRYPTED {
+                    # Keys rotation (key management 4)
+
+                    if {$rkeyid == $state(keyid)} {
+                        incr rkeyid -1
+                        unset state(x,$rkeyid)
+                        incr rkeyid 2
+                        set state(x,$rkeyid) [::otr::crypto::random 320]
+                        incr state(keyid)
+                        set state(ctrtop) 0
+                    }
+
+                    if {$skeyid == $state(keyidy)} {
+                        incr skeyid -1
+                        unset state(gy,$skeyid)
+                        incr skeyid 2
+                        set state(gy,$skeyid) $gy
+                        incr state(keyidy)
+                    }
+                }
+                default {
+                    InitDHKeys $token
+                }
+            }
+
+            # TODO: sometimes we want to send something back
+            return [list action display body $message]
+        }
+        MSGSTATE_PLAIN -
+        MSGSTATE_FINISHED {
+            # TODO
+            return [list action display body "OTR encrypted message was received"]
+        }
+    }
+}
+
+proc ::otr::InitDHKeys {token} {
+    variable $token
+    upvar 0 $token state
+
+    # Forget the existing keys if any
+
+    array unset state x,*
+    array unset state gy,*
+
+    # Generate DH private keys (key management 1)
+
+    set state(keyid) 2
+    set state(x,1) [::otr::crypto::random 320]
+    set state(x,2) [::otr::crypto::random 320]
+    set state(keyidy) 0
+    set state(gy,0) 0
+    set state(gy,-1) 0
+
+    # Not exactly D-H related:
+
+    set state(ctrtop) 0
+    unset -nocomplain state(version)
+}
+
+# ::otr::FindVersion --
+#
+#       Check if the given versions list contains one of the supported.
+#
+# Arguments:
+#       token           The OTR session token.
+#       versions        The OTR protocol versions list (from the received
+#                       OTR request or whitespace tag).
+#
+# Result:
+#       Either the preferred version to choose or 0 if there's no supported
+#       version in the list.
+#
+# Side effects:
+#       None.
+
+proc ::otr::FindVersion {token versions} {
+    variable $token
+    upvar 0 $token state
+
+    if {3 in $versions && [queryPolicy $token ALLOW_V3]} {
+        return 3
+    } elseif {2 in $versions && [queryPolicy $token ALLOW_V2]} {
+        return 2
+    } else {
+        return 0
+    }
+}
+
+# ::otr::NewSession --
+
+proc ::otr::NewSession {token version} {
+    variable $token
+    upvar 0 $token state
+
+    set state(AuthState) AUTHSTATE_NONE
+    set state(MsgState) MSGSTATE_PLAINTEXT
+
+    set state(version) $version
+    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} {
+    variable $token
+    upvar 0 $token state
+
+    # TODO
+    #lappend state(StoredMessages) $message
+}
+
+# ::otr::fingerprint --
+#
+#       Return the DSA public key fingerprint.
+#
+# Arguments:
+#       key         DSA public key {p q g y}.
+#
+# Result:
+#       The SHA-1 hash of the binary representation of the key.
+#
+# Side effects:
+#       None.
+
+proc ::otr::fingerprint {key} {
+    set bytes [::otr::data::encode PUBKEY $key]
+    return [::sha1::sha1 -hex [string range $bytes 2 end]]
+}
+
+# ::otr::Debug --
+#
+#       Prints debug information.
+#
+# Arguments:
+#       token   OTR instance token.
+#       level   A debug level.
+#       str     A debug message.
+#
+# Result:
+#       An empty string.
+#
+# Side effects:
+#       A debug message is printed to the console if the value of
+#       ::otr::debug variable is not less than num.
+
+proc ::otr::Debug {token level str} {
+    variable debug
+
+    if {$debug >= $level} {
+        puts "[clock format [clock seconds] -format %T]\
+              [lindex [info level -1] 0] $token $str"
+    }
+
+    return
+}
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/otr.tcl
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/pkgIndex.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/pkgIndex.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/pkgIndex.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,18 @@
+# pkgIndex.tcl --
+#
+#       This file is a part of Off-the-Record messaging protocol
+#	implementation. It loads the main package.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package ifneeded otr 0.1 [list source [file join $dir otr.tcl]]
+package ifneeded otr::data 0.1 [list source [file join $dir data.tcl]]
+package ifneeded otr::crypto 0.1 [list source [file join $dir crypto.tcl]]
+package ifneeded otr::auth 0.1 [list source [file join $dir auth.tcl]]
+package ifneeded otr::smp 0.1 [list source [file join $dir smp.tcl]]
+package ifneeded otr::message 0.1 [list source [file join $dir message.tcl]]


Property changes on: trunk/tkabber-plugins/otr/tclotr/pkgIndex.tcl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: trunk/tkabber-plugins/otr/tclotr/smp.tcl
===================================================================
--- trunk/tkabber-plugins/otr/tclotr/smp.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/otr/tclotr/smp.tcl	2014-01-17 15:44:22 UTC (rev 2057)
@@ -0,0 +1,26 @@
+# smp.tcl --
+#
+#       This file is a part of the Off-the-Record messaging protocol
+#       implementation. It contains the OTR SMP packets serializing and
+#       deserializing procedures.
+#
+# Copyright (c) 2014 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require sha256
+package require otr::data
+package require otr::crypto
+
+package provide otr::smp 0.1
+
+##############################################################################
+
+namespace eval ::otr::smp {}
+
+# TODO
+
+# vim:ts=8:sw=4:sts=4:et


Property changes on: trunk/tkabber-plugins/otr/tclotr/smp.tcl
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property


More information about the Tkabber-dev mailing list