[Tkabber-dev] r1603 - in trunk/tkabber: . plugins/filetransfer plugins/si

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Nov 3 17:42:10 MSK 2008


Author: sergei
Date: 2008-11-03 17:42:10 +0300 (Mon, 03 Nov 2008)
New Revision: 1603

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/filetransfer/si.tcl
   trunk/tkabber/plugins/si/socks5.tcl
   trunk/tkabber/si.tcl
Log:
	* plugins/si/socks5.tcl: Moved resetting fileevent script upper.

	* plugins/filetransfer/si.tcl, si.tcl: Made receiving file or use of any
	  other SI profile asynchronous (without vwait).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-11-03 12:38:08 UTC (rev 1602)
+++ trunk/tkabber/ChangeLog	2008-11-03 14:42:10 UTC (rev 1603)
@@ -2,6 +2,11 @@
 
 	* msgs/de.msg: Updated German translation (thanks to Roger Sondermann).
 
+	* plugins/si/socks5.tcl: Moved resetting fileevent script upper.
+
+	* plugins/filetransfer/si.tcl, si.tcl: Made receiving file or use of any
+	  other SI profile asynchronous (without vwait).
+
 2008-11-02  Sergei Golovan  <sgolovan at nes.ru>
 
 	* datagathering.tcl: Added a procedure which returns a list of entered

Modified: trunk/tkabber/plugins/filetransfer/si.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/si.tcl	2008-11-03 12:38:08 UTC (rev 1602)
+++ trunk/tkabber/plugins/filetransfer/si.tcl	2008-11-03 14:42:10 UTC (rev 1603)
@@ -48,8 +48,9 @@
     if {![info exists state(fd)]} return
 
     if {![lindex $res 0]} {
-	eval $state(command) error \
-	     [list [::msgcat::mc "Request failed: %s" [lindex $res 1]]]
+	eval $state(command) \
+	     [list error \
+		   [::msgcat::mc "Request failed: %s" [lindex $res 1]]]
 	return
     }
 
@@ -78,8 +79,9 @@
     if {![info exists state(fd)]} return
 
     if {![lindex $res 0]} {
-	eval $state(command) error \
-	     [list [::msgcat::mc "Transfer failed: %s" [lindex $res 1]]]
+	eval $state(command) \
+	     [list error \
+		   [::msgcat::mc "Transfer failed: %s" [lindex $res 1]]]
 	return
     }
 
@@ -101,7 +103,7 @@
 ###############################################################################
 ###############################################################################
 
-proc si::recv_file_dialog {xlib from iqid lang id name size date hash desc} {
+proc si::recv_file_dialog {xlib from lang id name size date hash desc command} {
     variable winid
 
     set token [namespace current]::[incr winid]
@@ -174,11 +176,11 @@
     grid rowconfigure $f 3 -weight 1
     
     $w add -text [::msgcat::mc "Receive"] -command \
-	[namespace code [list recv_file_start $token $w $iqid]]
+	[namespace code [list recv_file_start $token $w $command]]
     $w add -text [::msgcat::mc "Cancel"] -command \
-	[namespace code [list recv_file_cancel $token $w $iqid]]
+	[namespace code [list recv_file_cancel $token $w $command]]
     
-    bind $w <Destroy> [namespace code [list recv_file_cancel $token $w $iqid]]
+    bind $w <Destroy> [namespace code [list recv_file_cancel $token $w $command]]
 
     $w draw
     return
@@ -196,22 +198,22 @@
 
 ###############################################################################
 
-proc si::recv_file_cancel {token w iqid} {
+proc si::recv_file_cancel {token w command} {
     upvar #0 $token state
 
+    bind $w <Destroy> {}
     destroy $w
-    ::xmpp::sendIQ $state(xlib) error \
-	    -error [::xmpp::stanzaerror::error cancel not-allowed \
-			    -text [::trans::trans $state(lang) \
-						  "File transfer is refused"]] \
-	    -to $state(jid) \
-	    -id $iqid
+    eval $command \
+	 [list error \
+	       [::xmpp::stanzaerror::error cancel not-allowed \
+			-text [::trans::trans $state(lang) \
+					      "File transfer is refused"]]]
     return
 }
 
 ###############################################################################
 
-proc si::recv_file_start {token w iqid} {
+proc si::recv_file_start {token w command} {
     upvar #0 $token state
 
     ft::hide_error_msg $state(f)
@@ -231,12 +233,11 @@
     if {[catch {si::newin $state(xlib) $state(jid) $state(id)} stream]} {
 	# Return error to the sender but leave transfer window with disabled
 	# 'Receive' button and error message.
-	::xmpp::sendIQ $state(xlib) error \
-	    -error [::xmpp::stanzaerror::error modify bad-request \
-			    -text [::trans::trans $state(lang) \
-						  "Stream ID is in use"]] \
-	    -to $state(jid) \
-	    -id $iqid
+	eval $command \
+	     [list error
+		   [::xmpp::stanzaerror::error modify bad-request \
+				-text [::trans::trans $state(lang) \
+						      "Stream ID is in use"]]]
 	ft::report_error $state(f) \
 		[::msgcat::mc "Receive error: Stream ID is in use"]
 	return
@@ -251,9 +252,7 @@
     si::set_closed_handler \
 	$stream [list [namespace current]::closed $token]
 
-    ::xmpp::sendIQ $state(xlib) result \
-	    -to $state(jid) \
-	    -id $iqid
+    eval $command [list ok {}]
     return
 }
 
@@ -304,7 +303,7 @@
 ###############################################################################
 ###############################################################################
 
-proc si::si_handler {xlib from iqid lang id mimetype child} {
+proc si::si_handler {xlib from lang id mimetype child command} {
     debugmsg filetransfer "SI set: [list $from $child]"
 
     ::xmpp::xml::split $child tag xmlns attrs cdata subels
@@ -319,17 +318,17 @@
 	    }
 	}
 
-	recv_file_dialog \
-	    $xlib \
-	    $from \
-	    $iqid \
-	    $lang \
-	    $id \
-	    [::xmpp::xml::getAttr $attrs name] \
-	    [::xmpp::xml::getAttr $attrs size] \
-	    [::xmpp::xml::getAttr $attrs date] \
-	    [::xmpp::xml::getAttr $attrs hash] \
-	    $desc
+	return [recv_file_dialog \
+			$xlib \
+			$from \
+			$lang \
+			$id \
+			[::xmpp::xml::getAttr $attrs name] \
+			[::xmpp::xml::getAttr $attrs size] \
+			[::xmpp::xml::getAttr $attrs date] \
+			[::xmpp::xml::getAttr $attrs hash] \
+			$desc \
+			$command]
     } else {
 	return [list error modify bad-request]
     }

Modified: trunk/tkabber/plugins/si/socks5.tcl
===================================================================
--- trunk/tkabber/plugins/si/socks5.tcl	2008-11-03 12:38:08 UTC (rev 1602)
+++ trunk/tkabber/plugins/si/socks5.tcl	2008-11-03 14:42:10 UTC (rev 1603)
@@ -13,7 +13,7 @@
 	[::msgcat::mc "Use mediated SOCKS5 connection if proxy is available."] \
 	-group {Stream Initiation} -type boolean
 
-    custom::defvar options(proxy_servers) "proxy.netlab.cz proxy.jabber.cd.chalmers.se" \
+    custom::defvar options(proxy_servers) "proxy.netlab.cz" \
 	[::msgcat::mc "List of proxy servers for SOCKS5 bytestreams (all\
 		       available servers will be tried for mediated connection)."] \
 	-group {Stream Initiation} -type string
@@ -46,14 +46,14 @@
 proc socks5::target::sock_writable {sock stream iqid lang streamhost hosts} {
     upvar #0 $stream state
 
+    fileevent $sock writable {}
+
     if {![info exists state(id)]} {
 	::close $sock
 	sock_finish $stream $iqid $lang error ""
 	return
     }
 
-    fileevent $sock writable {}
-
     if {[catch {fconfigure $sock -peername}]} {
 	::close $sock
 	sock_connect $stream $iqid $hosts $lang

Modified: trunk/tkabber/si.tcl
===================================================================
--- trunk/tkabber/si.tcl	2008-11-03 12:38:08 UTC (rev 1602)
+++ trunk/tkabber/si.tcl	2008-11-03 14:42:10 UTC (rev 1603)
@@ -319,58 +319,80 @@
     if {[info exists profiledata($profile)]} {
 	foreach item $subels {
 	    ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
+
 	    if {[string equal $sxmlns $profile]} {
-		set profile_res [$profiledata($profile) \
-				     $xlib $from $iqid $lang $id $mimetype $item]
-	    } elseif {[string equal $sxmlns \
-			   http://jabber.org/protocol/feature-neg]} {
-		set options [parse_negotiation $item]
+		return [$profiledata($profile) \
+				$xlib $from $lang $id $mimetype $item \
+				[namespace code [list set_handler_cont $xlib $from $iqid $lang $id $subels]]]
+	    }
+	}
+    } else {
+	# bad-profile
+	return [list error modify bad-request]
+    }
+}
 
-		set trans [lsort -unique -index 1 $transport(list)]
-		set myoptions {}
-		foreach t $trans {
-		    set name [lindex $t 0]
-		    if {![info exists transport(allowed,$name)] || \
-			    $transport(allowed,$name)} {
-			lappend myoptions $transport(oppos,$name)
-		    }
+proc si::set_handler_cont {xlib from iqid lang id subels status xml} {
+    variable transport
+
+    foreach item $subels {
+	::xmpp::xml::split $item tag xmlns attrs cdata subels
+
+	if {[string equal $xmlns http://jabber.org/protocol/feature-neg]} {
+	    set options [parse_negotiation $item]
+
+	    set trans [lsort -unique -index 1 $transport(list)]
+	    set myoptions {}
+	    foreach t $trans {
+		set name [lindex $t 0]
+		if {![info exists transport(allowed,$name)] || \
+			$transport(allowed,$name)} {
+		    lappend myoptions $transport(oppos,$name)
 		}
+	    }
 
-		foreach opt $options {
-		    if {[lcontain $myoptions $opt]} {
-			set stream $opt
-			break
-		    }
+	    foreach opt $options {
+		if {[lsearch -exact $myoptions $opt] >= 0} {
+		    set stream $opt
+		    break
 		}
 	    }
 	}
-	
-	if {[lindex $profile_res 0] == "error"} {
-	    return $profile_res
-	}
-	if {$stream == {}} {
-	    # no-valid-streams
-	    return [list error modify bad-request]
-	}
-	set res_elements {}
-	if {$profile_res != {}} {
-	    lappend res_elements $profile_res
-	}
+    }
 
-	set fields [list stream-method [list $opt]]
-	lappend res_elements \
+    if {$status == "error"} {
+        ::xmpp::sendIQ $xlib error \
+                       -error $xml \
+                       -to $from \
+                       -id $iqid
+    }
+
+    if {$stream == ""} {
+        ::xmpp::sendIQ $xlib error \
+                       -error [::xmpp::stanzaerror::error modify bad-request] \
+                       -to $from \
+                       -id $iqid
+    }
+
+    set res_elements {}
+    if {$xml != {}} {
+	lappend res_elements $xml
+    }
+
+    set fields [list stream-method [list $opt]]
+    lappend res_elements \
 	    [::xmpp::xml::create feature \
 		    -xmlns http://jabber.org/protocol/feature-neg \
 		    -subelement [::xmpp::data::submitForm $fields]]
 
-	set res [::xmpp::xml::create si \
-			-xmlns $::NS(si) \
-			-subelements $res_elements]
-	return [list result $res]
-    } else {
-	# bad-profile
-	return [list error modify bad-request]
-    }
+    set res [::xmpp::xml::create si \
+		    -xmlns $::NS(si) \
+		    -subelements $res_elements]
+
+    ::xmpp::sendIQ $xlib result \
+                   -query $res \
+                   -to $from \
+                   -id $iqid
 }
 
 ::xmpp::iq::register set * $::NS(si) si::set_handler



More information about the Tkabber-dev mailing list