[Tkabber-dev] r726 - in trunk/tkabber: . jabberlib-tclxml plugins/filetransfer plugins/si

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Sep 21 23:45:05 MSD 2006


Author: sergei
Date: 2006-09-21 23:44:55 +0400 (Thu, 21 Sep 2006)
New Revision: 726

Added:
   trunk/tkabber/plugins/si/iqibb.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/filetransfer.tcl
   trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
   trunk/tkabber/plugins/filetransfer/si.tcl
   trunk/tkabber/plugins/si/ibb.tcl
   trunk/tkabber/plugins/si/socks5.tcl
   trunk/tkabber/si.tcl
   trunk/tkabber/userinfo.tcl
Log:
	* filetransfer.tcl, plugins/filetransfer/si.tcl,
	  plugins/si/ibb.tcl, plugins/si/iqibb.tcl, plugins/si/socks5.tcl,
	  si.tcl: Slightly redesigned filetransfer via SI (JEP-0095,
	  JEP-0065, JEP-0047). Replaced all unnecessary vwaits by
	  callbacks. Added new (undocumented yet) IQ-based IBB transport.
	  Made IBB transport usable (now it does not throw all data
	  immediately).

	* jabberlib-tclxml/jabberlib.tcl: Added jlib::socket_ip function.

	* userinfo.tcl: Made all userinfo fields flat.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/ChangeLog	2006-09-21 19:44:55 UTC (rev 726)
@@ -1,4 +1,19 @@
+2006-09-21  Sergei Golovan  <sgolovan at nes.ru>
+
+	* filetransfer.tcl, plugins/filetransfer/si.tcl,
+	  plugins/si/ibb.tcl, plugins/si/iqibb.tcl, plugins/si/socks5.tcl,
+	  si.tcl: Slightly redesigned filetransfer via SI (JEP-0095,
+	  JEP-0065, JEP-0047). Replaced all unnecessary vwaits by
+	  callbacks. Added new (undocumented yet) IQ-based IBB transport.
+	  Made IBB transport usable (now it does not throw all data
+	  immediately).
+
+	* jabberlib-tclxml/jabberlib.tcl: Added jlib::socket_ip function.
+
+	* userinfo.tcl: Made all userinfo fields flat.
+
 2006-09-20  Sergei Golovan  <sgolovan at nes.ru>
+
 	* datagathering.tcl, disco.tcl: Added processing and using of
 	  multiple values in jabber:x:data forms (thanks to Artem Borodin).
 

Modified: trunk/tkabber/filetransfer.tcl
===================================================================
--- trunk/tkabber/filetransfer.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/filetransfer.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -45,6 +45,25 @@
     
 }
 
+proc ft::get_POSIX_error_desc {} {
+	global errorCode
+	set class [lindex $errorCode 0]
+	if {$class != "POSIX"} {
+		return [::msgcat::mc "unknown"]
+	} else {
+		return [::msgcat::mc [lindex $errorCode 2]]
+	}
+}
+
+proc ft::report_cannot_open_file {w filename error} {
+    tk_messageBox -parent $w -icon error -type ok \
+	    -title [::msgcat::mc "File transfer error"] \
+	    -message [format \
+		[::msgcat::mc "Failed to open file \"%s\".\nThe error was: %s"] \
+	    	$filename $error
+	    ]
+}
+
 hook::add chat_create_user_menu_hook \
     [namespace current]::ft::create_menu 46
 hook::add roster_create_groupchat_user_menu_hook \

Modified: trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -321,6 +321,18 @@
 
 ######################################################################
 
+proc jlib::socket_ip {connid} {
+    variable lib
+
+    if {[info exists lib($connid,sck)]} {
+	return [lindex [fconfigure $lib($connid,sck) -sockname] 0]
+    } else {
+	return ""
+    }
+}
+
+######################################################################
+
 proc jlib::reset {connid} {
     variable lib
 

Modified: trunk/tkabber/plugins/filetransfer/si.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/si.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/plugins/filetransfer/si.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -1,13 +1,15 @@
 # $Id$
 
-# File transfer via SI
+# File transfer via Stream Initiation (JEP-0095)
 
+###############################################################################
+
 namespace eval si {
     set winid 0
-    set id 0
-    set chunk_size 4096
+    set chunk_size 1024
 
     variable options
+    variable state
 
     custom::defgroup SI \
 	[::msgcat::mc "Stream initiation options."] \
@@ -20,8 +22,14 @@
 
 set ::NS(file-transfer) http://jabber.org/protocol/si/profile/file-transfer
 
-proc si::send_file_dialog {user args} {
+###############################################################################
+#
+# Draw a send file dialog
+#
+
+proc si::send_file_dialog {jid args} {
     variable winid
+    variable state
 
     foreach {opt val} $args {
 	switch -- $opt {
@@ -29,32 +37,37 @@
 	}
     }
     if {![info exists connid]} {
-	set connid [jlib::route $user]
+	error "[namespace current]::send_file_dialog: -connection option\
+	       is mandatory"
     }
 
-    while {[winfo exists .sfd$winid]} {
-	incr winid
-    }
+    set token [namespace current]::[incr winid]
+    variable $token
+    upvar 0 $token state
+
     set w .sfd$winid
+    set state(w) $w
+    set state(jid) $jid
+    set state(connid) $connid
 
-    variable filename$winid
-
-    Dialog $w -title [format [::msgcat::mc "Send file to %s"] $user] \
+    Dialog $w -title [format [::msgcat::mc "Send file to %s"] $jid] \
 	-separator 1 -anchor e -modal none \
 	-default 0 -cancel 1
 
     set f [$w getframe]
+    set state(f) $f
 
     label $f.lfile -text [::msgcat::mc "File to send:"]
-    entry $f.file -textvariable [list [namespace current]::filename$winid]
+    entry $f.file -textvariable ${token}(filename)
     button $f.browsefile -text [::msgcat::mc "Browse..."] \
-	-command [list [namespace current]::set_send_file_name $winid]
+	-command [list [namespace current]::set_send_file_name $token]
 
     label $f.ldesc -text [::msgcat::mc "Description:"]
     text $f.desc -width 50 -height 5
 
-    ProgressBar $f.pb -variable [namespace current]::progress$f.pb
-    variable progress$f.pb 0
+    ProgressBar $f.pb -variable ${token}(progress)
+    set state(pb) $f.pb
+    set state(progress) 0
 
     grid $f.lfile      -row 0 -column 0 -sticky e
     grid $f.file       -row 0 -column 1 -sticky ew
@@ -69,152 +82,157 @@
     grid rowconfigure $f 1 -weight 1
 
     $w add -text [::msgcat::mc "Send"] \
-	-command [list [namespace current]::send_file_start \
-		      $winid $f $user \
-		      -connection $connid]
+	   -command [list [namespace current]::send_file_negotiate $token]
     $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
 
-    incr winid
+    bind $w <Destroy> [list [namespace current]::send_file_close $token $w %W]
+
     $w draw $f.file
 }
 
-proc si::set_send_file_name {winid} {
-    variable filename$winid
+proc si::set_send_file_name {token} {
+    variable $token
+    upvar 0 $token state
 
     set file [tk_getOpenFile]
     if {$file != ""} {
-	set filename$winid $file
+	set state(filename) $file
     }
 }
 
-proc si::send_file_start {winid f user args} {
+###############################################################################
 
-    .sfd$winid itemconfigure 0 -state disabled
+proc si::send_file_negotiate {token} {
+    variable $token
+    upvar 0 $token state
+    variable chunk_size
 
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
+    $state(w) itemconfigure 0 -state disabled
 
-    set filename [$f.file get]
-    set desc [$f.desc get 0.0 "end -1c"]
+    set desc [$state(f).desc get 0.0 "end -1c"]
 
-    if {![file isfile $filename]} {
-	MessageDlg .filenofound$winid -aspect 50000 -icon error \
-	    -message [format [::msgcat::mc \
-				  "File not found or not regular file: %s"] \
-			  $filename] \
-	    -type user \
-	    -buttons ok -default 0 -cancel 0
-	.sfd$winid itemconfigure 0 -state normal
+    if {[catch {open $state(filename)} fd]} {
+	ft::report_cannot_open_file $state(w) $state(filename) \
+				    [ft::get_POSIX_error_desc]
+	$state(w) itemconfigure 0 -state normal
 	return
     }
 
-    set fsize [file size $filename]
-    $f.pb configure -maximum $fsize
-    .sfd$winid itemconfigure 0 -state disabled
-    #destroy .sfd$winid
+    debugmsg filetransfer "SENDFILE: $state(filename); $desc"
 
-    debugmsg filetransfer "SENDFILE: $filename; $desc"
+    set state(fd) $fd
+    fconfigure $fd -translation binary
 
-    send_file_setup_connection $connid $user $filename $desc $winid
-    #bind .sfd$winid <Destroy> [list ft::send_file_cancel $winid $servsock]
-}
+    set name [file tail $state(filename)]
+    set size [file size $state(filename)]
 
+    if {$size == 0} {
+	$state(pb) configure -maximum -1
+    } else {
+	$state(pb) configure -maximum $size
+    }
 
-proc si::send_file_setup_connection {connid user filename desc winid} {
-    variable files
-    variable chunk_size
-
     set id [random 1000000000]
-    set name [file tail $filename]
-    set size [file size $filename]
+    set state(id) $id
 
-    set files(filename,$id) $filename
-    set files(w,$id) .sfd$winid
-
     set profile [jlib::wrapper:createtag file \
 		     -vars [list xmlns $::NS(file-transfer) \
-				id $id \
-				name $name \
-				size $size] \
+				 id $id \
+				 name $name \
+				 size $size] \
 		     -subtags [list [jlib::wrapper:createtag desc \
 					 -chdata $desc]]]
 
-    set res [si::connect $connid $user $id application/octet-stream \
-		 $::NS(file-transfer) $profile]
+    si::connect $state(connid) $state(jid) $id $chunk_size \
+		application/octet-stream $::NS(file-transfer) $profile \
+		[list [namespace current]::send_file $token]
+}
 
+###############################################################################
+
+proc si::send_file {token res} {
+    variable $token
+    upvar 0 $token state
+
     if {![lindex $res 0]} {
 	MessageDlg .auth_err -aspect 50000 -icon error \
 	    -message [format [::msgcat::mc "Request failed: %s"] \
 			  [lindex $res 1]] -type user \
 	    -buttons ok -default 0 -cancel 0
+	close $state(fd)
+	$state(w) itemconfigure 0 -state normal
 	return
     }
 
-    set w $files(w,$id)
+    set_status [::msgcat::mc "Transferring..."]
 
-    if {![winfo exists $w]} {
-	si::close $id
-	return
-    }
+    after idle [list [namespace current]::send_chunk $token]
+}
 
-    bind $w <Destroy> [list [namespace current]::send_file_close $id]
+proc si::send_chunk {token} {
+    variable $token
+    upvar 0 $token state
+    variable chunk_size
 
-    set fd [open $filename]
-    fconfigure $fd -translation binary
+    set chunk [read $state(fd) $chunk_size]
+    if {$chunk != ""} {
+	si::send_data $state(id) $chunk \
+		      [list [namespace current]::send_chunk_response $token]
+    } else {
+	destroy $state(w)
+    }
+}
 
-    set files(rfd,$id) $fd
+proc si::send_chunk_response {token res} {
+    variable $token
+    upvar 0 $token state
 
-    set pb [$files(w,$id) getframe].pb
-    variable progress$pb
-    $pb configure -maximum [file size $filename]
+    if {![info exists state(id)]} return
 
-    #set chunk [read $fd]
-    set_status [::msgcat::mc "Transferring..."]
+    if {![lindex $res 0]} {
+	MessageDlg .auth_err -aspect 50000 -icon error \
+	    -message [format [::msgcat::mc "Transfer failed: %s"] \
+			  [lindex $res 1]] -type user \
+	    -buttons ok -default 0 -cancel 0
+	set state(progress) 0
+	si::close $state(id)
+	close $state(fd)
+	$state(w) itemconfigure 0 -state normal
+	return
+    }
 
-    set chunk [read $fd $chunk_size]
-    #catch {
-	while {$chunk != ""} {
-	    si::send_data $id $chunk
-	    set progress$pb [tell $fd]
-	    #after 1000
-	    update idletasks
-	    set chunk [read $fd $chunk_size]
-	}
-    #}
+    set state(progress) [tell $state(fd)]
+    after idle [list [namespace current]::send_chunk $token]
+}
 
-    catch { close $fd }
-    catch { destroy $w }
+###############################################################################
 
-    si::close $id
-}
+proc si::send_file_close {token w1 w2} {
+    variable $token
+    upvar 0 $token state
 
-proc si::send_file_close {id} {
-    variable files
+    if {$w1 != $w2} return
 
-    catch { close $files(rfd,$id) }
-    #set w $files(w,$id)
-    #si::close $id
-    #destroy $w
+    catch { si::close $state(id) }
+    catch { close $state(fd) }
+    catch { unset $token }
 }
 
 ###############################################################################
+###############################################################################
 
 proc si::recv_file_dialog {from id name size date hash desc} {
     variable winid
-    variable files
 
+    set token [namespace current]::[incr winid]
+    variable $token
+    upvar 0 $token state
+
     set w .rfd$winid
+    set state(w) $w
 
-    while {[winfo exists $w]} {
-	incr winid
-	set w .rfd$winid
-    }
+    set state(id) $id
+    set state(jid) $from
 
     Dialog $w -title [format [::msgcat::mc "Receive file from %s"] $from] \
 	-separator 1 -anchor e \
@@ -234,16 +252,24 @@
 
     set dir $ft::options(download_dir)
     label $f.lsaveas -text [::msgcat::mc "Save as:"]
-    entry $f.saveas -textvariable [namespace current]::saveas$winid
-    variable saveas$winid [file join $dir $name]
+    entry $f.saveas -textvariable ${token}(filename)
+
+    set state(dir) $dir
+    set state(name) $name
+    set state(filename) [file join $dir $name]
     button $f.browsefile -text [::msgcat::mc "Browse..."] \
-	-command [list [namespace current]::set_receive_file_name $winid $dir $name]
+	-command [list [namespace current]::set_receive_file_name $token]
 
-    set pbvar [namespace current]::progress$f.pb
-    ProgressBar $f.pb -variable $pbvar
-    $f.pb configure -maximum $size
-    set $pbvar 0
+    set state(progress) 0
 
+    # Working around a bug in ProgressBar:
+    # crash when setting PB variable while -maximum is 0:
+    if {$size > 0} {
+	ProgressBar $f.pb -variable ${token}(progress)
+	$f.pb configure -maximum $size
+	grid $f.pb  -row 4 -column 0 -sticky ew -columnspan 3 -pady 2m
+    }
+
     grid $f.lname   -row 0 -column 0 -sticky e
     grid $f.name    -row 0 -column 1 -sticky w
     
@@ -257,91 +283,124 @@
     grid $f.saveas  -row 3 -column 1 -sticky ew
     grid $f.browsefile  -row 3 -column 2 -sticky ew
 
-    grid $f.pb      -row 4 -column 0 -sticky ew -columnspan 3 -pady 2m
-
     grid columnconfigure $f 1 -weight 1 -minsize 8c
     grid rowconfigure $f 2 -weight 1
     
     $w add -text [::msgcat::mc "Receive"] -command \
-	[list [namespace current]::recv_file_start $winid $pbvar $from $id]
+	[list [namespace current]::recv_file_start $token]
     $w add -text [::msgcat::mc "Cancel"] -command \
-	[list [namespace current]::recv_file_cancel $w $id]
+	[list [namespace current]::recv_file_cancel $token]
     
-    incr winid
-
     $w draw
 
-    vwait [namespace current]::result($id,recv)
-    return [set [namespace current]::result($id,recv)]
+    # Can't avoid vwait, because this procedure must return result or error
+    vwait ${token}(result)
+
+    set result $state(result)
+    if {[lindex $result 0] == "error"} {
+	catch { unset $token }
+    }
+
+    return $result
 }
 
-proc si::set_receive_file_name {winid dir fname} {
-    variable saveas$winid
+proc si::set_receive_file_name {token} {
+    variable $token
+    upvar 0 $token state
 
-    set file [tk_getSaveFile -initialdir $dir -initialfile $fname]
+    set file [tk_getSaveFile -initialdir $state(dir) \
+			     -initialfile $state(name)]
     if {$file != ""} {
-	set saveas$winid $file
+	set state(filename) $file
     }
 }
 
-proc si::recv_file_cancel {w id} {
-    set [namespace current]::result($id,recv) [list error cancel forbidden]
-    destroy $w
+###############################################################################
+
+proc si::recv_file_cancel {token} {
+    variable $token
+    upvar 0 $token state
+
+    set state(result) [list error cancel not-allowed]
+
+    destroy $state(w)
 }
 
-proc si::recv_file_start {winid pbvar user id} {
-    variable saveas$winid
-    variable files
+###############################################################################
 
-    set filename [set saveas$winid]
+proc si::recv_file_start {token} {
+    variable $token
+    upvar 0 $token state
 
-    .rfd$winid itemconfigure 0 -state disabled
-    set $pbvar 0
+    if {[catch {open $state(filename) w} fd]} {
+	ft::report_cannot_open_file $state(w) $state(filename) \
+				    [ft::get_POSIX_error_desc]
+	return
+    }
 
-    set files(filename,$id) $filename
-
-    set fd [open $filename w]
     fconfigure $fd -translation binary
 
-    set files(fd,$id) $fd
-    set w .rfd$winid
+    set state(fd) $fd
+    set w $state(w)
 
+    $w itemconfigure 0 -state disabled
+    bind $w <Destroy> [list [namespace current]::recv_file_close $token $w %W]
+
+    set id $state(id)
+
     si::set_readable_handler \
-	$id [list [namespace current]::recv_file_chunk $pbvar]
+	$id [list [namespace current]::recv_file_chunk $token]
     si::set_closed_handler \
-	$id [list [namespace current]::closed $w]
+	$id [list [namespace current]::closed $token]
 
-    set [namespace current]::result($id,recv) {}
+    set state(result) {}
 }
 
-proc si::recv_file_chunk {pbvar key} {
-    variable files
+###############################################################################
 
-    if {[info exists files(filename,$key)]} {
-	set data [si::read_data $key]
+proc si::recv_file_chunk {token id} {
+    variable $token
+    upvar 0 $token state
 
-	debugmsg filetransfer "RECV into $files(filename,$key) data $data"
+    if {[info exists state(id)] && $state(id) == $id} {
+	set fd $state(fd)
+	set filename $state(filename)
+	set data [si::read_data $id]
 
-	puts -nonewline $files(fd,$key) $data
+	debugmsg filetransfer "RECV into $filename data $data"
 
-	incr $pbvar [string bytelength $data]
-	debugmsg filetransfer [set $pbvar]
+	puts -nonewline $fd $data
+	set state(progress) [tell $fd]
+
     }
-
 }
 
-proc si::closed {w key} {
-    variable files
+###############################################################################
 
-    if {[info exists files(filename,$key)]} {
+proc si::closed {token id} {
+    variable $token
+    upvar 0 $token state
+
+    if {[info exists state(id)] && $state(id) == $id} {
 	debugmsg filetransfer CLOSE
-	catch { close $files(fd,$key) }
-	catch { destroy $w }
-	unset files(filename,$key)
-	set_status [::msgcat::mc "Connection closed"]
+    	destroy $state(w)
     }
 }
 
+###############################################################################
+
+proc si::recv_file_close {token w1 w2} {
+    variable $token
+    upvar 0 $token state
+
+    if {$w1 != $w2} return
+
+    catch { close $state(fd) }
+    catch { unset $token }
+}
+
+###############################################################################
+
 proc si::si_handler {from id mimetype child} {
     debugmsg filetransfer "SI set: [list $from $child]"
 
@@ -371,6 +430,7 @@
 
 si::register_profile $::NS(file-transfer) [namespace current]::si::si_handler
 
+###############################################################################
 
 proc si::add_menu_item {m cascad jid args} {
     variable options
@@ -392,3 +452,5 @@
 hook::add create_filetransfer_menu_hook \
     [namespace current]::si::add_menu_item 10
 
+###############################################################################
+

Modified: trunk/tkabber/plugins/si/ibb.tcl
===================================================================
--- trunk/tkabber/plugins/si/ibb.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/plugins/si/ibb.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -1,73 +1,86 @@
 # $Id$
+# In-Band Bytestreams (JEP-0047) transport for SI
 
+###############################################################################
+
 namespace eval ibb {}
 
 set ::NS(ibb) http://jabber.org/protocol/ibb
 
-proc ibb::connect {connid jid sid} {
-    variable connection
+###############################################################################
 
+proc ibb::connect {connid jid sid chunk_size command} {
     set_status [::msgcat::mc "Opening IBB connection"]
 
     jlib::send_iq set \
 	[jlib::wrapper:createtag open \
 	     -vars [list xmlns $::NS(ibb) \
-			sid $sid \
-			block-size 4096]] \
+			 sid $sid \
+			 block-size $chunk_size]] \
 	-to $jid \
 	-command [list [namespace current]::recv_connect_response \
-		      $connid $jid $sid]
-	 
-    vwait [namespace current]::connection(status,$sid)
-    return $connection(status,$sid)
+		       $connid $jid $sid $command]
 }
 
-proc ibb::recv_connect_response {connid jid sid res child} {
-    variable connection
-
+proc ibb::recv_connect_response {connid jid sid command res child} {
     if {$res != "OK"} {
-	set connection(status,$key) [list 0 [error_to_string $child]]
+	uplevel #0 $command [list [list 0 [error_to_string $child]]]
 	return
     }
 
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    set connection(connid,$sid) $connid
-    set connection(jid,$sid) $jid
-    set connection(seq,$sid) 0
-    set connection(status,$sid) 1
+    set state(connid) $connid
+    set state(jid) $jid
+    set state(seq) 0
+    uplevel #0 $command 1
 }
 
+###############################################################################
+
 package require base64
 
-proc ibb::send_data {sid data} {
-    variable connection
+proc ibb::send_data {sid data command} {
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
-    jlib::send_msg $connection(jid,$sid) \
+    jlib::send_msg $state(jid) \
 	-xlist [list [jlib::wrapper:createtag data \
 			  -vars [list xmlns $::NS(ibb) \
-				     sid $sid \
-				     seq $connection(seq,$sid)] \
+				      sid $sid \
+				      seq $state(seq)] \
 			  -chdata [base64::encode $data]]] \
-	-connection $connection(connid,$sid)
+	-connection $state(connid)
 
-    set connection(seq,$sid) [expr {($connection(seq,$sid) + 1) % 65536}]
+    set state(seq) [expr {($state(seq) + 1) % 65536}]
 
-    return 1
+    after 2000 [list uplevel #0 $command 1]
 }
 
+###############################################################################
 
 proc ibb::close {sid} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
     jlib::send_iq set \
 	[jlib::wrapper:createtag close \
 	     -vars [list xmlns $::NS(ibb) \
 			sid $sid]] \
-	-to $connection(jid,$sid) \
-	-connection $connection(connid,$sid)
+	-to $state(jid) \
+	-connection $state(connid)
+
+    unset $token
 }
 
+###############################################################################
+
 proc ibb::iq_set_handler {connid from lang child} {
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
@@ -87,6 +100,8 @@
 
 iq::register_handler set "" $::NS(ibb) [namespace current]::ibb::iq_set_handler
 
+###############################################################################
+
 proc ibb::message_handler {connid from id type is_subject subject body \
 				 err thread priority x} {
     foreach item $x {
@@ -112,10 +127,12 @@
 
 hook::add process_message_hook [namespace current]::ibb::message_handler 50
 
+###############################################################################
 
 si::register_transport $::NS(ibb) $::NS(ibb) 75 \
     [namespace current]::ibb::connect \
     [namespace current]::ibb::send_data \
     [namespace current]::ibb::close
 
+###############################################################################
 

Added: trunk/tkabber/plugins/si/iqibb.tcl
===================================================================
--- trunk/tkabber/plugins/si/iqibb.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/si/iqibb.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -0,0 +1,134 @@
+# $Id$
+# IQ-based In-Band Bytestreams (JEP-????) transport for SI
+
+###############################################################################
+
+namespace eval iqibb {}
+
+set ::NS(iqibb) http://jabber.org/protocol/iqibb
+
+###############################################################################
+
+proc iqibb::connect {connid jid sid chunk_size command} {
+    set_status [::msgcat::mc "Opening IQ-IBB connection"]
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag open \
+	     -vars [list xmlns $::NS(iqibb) \
+			 sid $sid \
+			 block-size $chunk_size]] \
+	-to $jid \
+	-command [list [namespace current]::recv_connect_response \
+		      $connid $jid $sid $command]
+}
+
+proc iqibb::recv_connect_response {connid jid sid command res child} {
+    if {$res != "OK"} {
+	uplevel #0 $command [list [list 0 [error_to_string $child]]]
+	return
+    }
+
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
+    jlib::wrapper:splitxml $child tag vars isempty chdata children
+
+    set state(connid) $connid
+    set state(jid) $jid
+    set state(seq) 0
+    uplevel #0 $command 1
+}
+
+###############################################################################
+
+package require base64
+
+proc iqibb::send_data {sid data command} {
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag data \
+	     -vars [list xmlns $::NS(iqibb) \
+			 sid $sid \
+			 seq $state(seq)] \
+	     -chdata [base64::encode $data]] \
+	-to $state(jid) \
+	-command [list [namespace current]::send_data_ack $sid $command] \
+	-connection $state(connid)
+
+    set state(seq) [expr {($state(seq) + 1) % 65536}]
+}
+
+proc iqibb::send_data_ack {sid command res child} {
+    if {$res != "OK"} {
+	uplevel #0 $command [list [list 0 [error_to_string $child]]]
+    } else {
+	uplevel #0 $command 1
+    }
+}
+
+###############################################################################
+
+proc iqibb::close {sid} {
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag close \
+	     -vars [list xmlns $::NS(iqibb) \
+			 sid $sid]] \
+	-to $state(jid) \
+	-connection $state(connid)
+
+    unset $token
+}
+
+###############################################################################
+
+proc iqibb::iq_set_handler {connid from lang child} {
+    jlib::wrapper:splitxml $child tag vars isempty chdata children
+
+    set sid [jlib::wrapper:getattr $vars sid]
+
+    switch -- $tag {
+	open {
+	    # TODO
+	}
+	close {
+	    si::closed $sid
+	}
+	data {
+	    set sid [jlib::wrapper:getattr $vars sid]
+	    # TODO: seq processing
+	    set seq [jlib::wrapper:getattr $vars seq]
+	    set data $chdata
+
+	    if {[catch {set decoded [base64::decode $data]}]} {
+		# TODO
+		debugmsg si "IQIBB: WRONG DATA"
+		return [list error modify bad-request]
+	    } else {
+		debugmsg si "IQIBB: RECV DATA [list $data]"
+		si::recv_data $sid $decoded
+	    }
+	}
+    }
+
+    return [list result ""]
+}
+
+iq::register_handler set "" $::NS(iqibb) [namespace current]::iqibb::iq_set_handler
+
+###############################################################################
+
+si::register_transport $::NS(iqibb) $::NS(iqibb) 70 \
+    [namespace current]::iqibb::connect \
+    [namespace current]::iqibb::send_data \
+    [namespace current]::iqibb::close
+
+###############################################################################
+


Property changes on: trunk/tkabber/plugins/si/iqibb.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Modified: trunk/tkabber/plugins/si/socks5.tcl
===================================================================
--- trunk/tkabber/plugins/si/socks5.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/plugins/si/socks5.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -1,13 +1,20 @@
 # $Id$
+# SOCKS5 Bytestreams (JEP-0065) transport for SI
 
+###############################################################################
+
 namespace eval socks5 {}
 namespace eval socks5::target {}
 namespace eval socks5::initiator {}
 
 set ::NS(bytestreams) http://jabber.org/protocol/bytestreams
 
+###############################################################################
+
 proc socks5::target::sock_connect {connid jid sid hosts} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
     foreach host $hosts {
 	lassign $host addr port streamhost
@@ -15,16 +22,17 @@
 	if {[catch {set sock [socket -async $addr $port]}]} continue
 	debugmsg si "CONNECTED"
 	fconfigure $sock -translation binary -blocking no
-	set connection(sock,$sid) $sock
+	set state(sock) $sock
 
 	puts -nonewline $sock "\x05\x01\x00"
 	flush $sock
 	fileevent $sock readable \
 	    [list [namespace current]::wait_for_method $sock $connid $jid $sid]
 
-	vwait [namespace current]::connection(status,$sid)
+	# Can't avoid vwait, because this procedure must return result or error
+	vwait ${token}(status)
 
-	if {$connection(status,$sid) == 0} continue
+	if {$state(status) == 0} continue
 
 	set res [jlib::wrapper:createtag query \
 		     -vars [list xmlns $::NS(bytestreams)] \
@@ -40,16 +48,21 @@
     return [list error cancel item-not-found]
 }
 
+###############################################################################
+
 proc socks5::target::wait_for_method {sock connid jid sid} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
     if {[catch {set data [read $sock]}]} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
     if {[eof $sock]} {
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -57,7 +70,7 @@
 
     if {$ver != 5 || $method != 0} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -75,15 +88,18 @@
 }
 
 proc socks5::target::wait_for_reply {sock jid sid} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
     if {[catch {set data [read $sock]}]} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
     if {[eof $sock]} {
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -91,39 +107,51 @@
 
     if {$ver != 5 || $rep != 0} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
-    set connection(status,$sid) 1
+    set state(status) 1
     fileevent $sock readable \
 	[list [namespace parent]::readable $sid $sock]
 }
 
+###############################################################################
+
 proc socks5::target::send_data {sid data} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
-    puts -nonewline $connection(sock,$sid) $data
-    flush $connection(sock,$sid)
+    puts -nonewline $state(sock) $data
+    flush $state(sock)
 
     return 1
 }
 
+###############################################################################
+
 proc socks5::target::close {sid} {
-    variable connection
-    ::close $connection(sock,$sid)
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
+    ::close $state(sock)
+
+    unset $token
 }
 
+###############################################################################
+###############################################################################
 
-proc socks5::initiator::connect {connid jid sid} {
-    variable connection
+proc socks5::initiator::connect {connid jid sid chunk_size command} {
     variable hash_sid
 
     set_status [::msgcat::mc "Opening SOCKS5 listening socket"]
 
     set servsock [socket -server [list [namespace current]::accept $sid] 0]
     lassign [fconfigure $servsock -sockname] addr hostname port
-    set ip [lindex [fconfigure $jlib::lib($connid,sck) -sockname] 0]
+    set ip [jlib::socket_ip $connid]
     set myjid [jlib::connection_jid $connid]
     set hash [::sha1::sha1 $sid$myjid$jid]
     set hash_sid($hash) $sid
@@ -131,54 +159,64 @@
     jlib::send_iq set \
 	[jlib::wrapper:createtag query \
 	     -vars [list xmlns $::NS(bytestreams) \
-			sid $sid] \
+			 sid $sid] \
 	     -subtags [list \
 			   [jlib::wrapper:createtag streamhost \
 				-vars [list jid $myjid \
-					   host $ip \
-					   port $port]]]] \
+					    host $ip \
+					    port $port]]]] \
 	-to $jid \
 	-command [list [namespace current]::recv_connect_response \
-		      $connid $jid $sid] \
+		       $connid $jid $sid $command] \
 	-connection $connid
-
-    vwait [namespace current]::connection(status,$sid)
-    return $connection(status,$sid)
 }
 
-proc socks5::initiator::recv_connect_response {connid jid sid res child} {
-    variable connection
-
+proc socks5::initiator::recv_connect_response {connid jid sid command res child} {
     if {$res != "OK"} {
-	set connection(status,$sid) [list 0 [error_to_string $child]]
+	uplevel #0 $command [list 0 [error_to_string $child]]
 	return
     }
 
     # TODO
-    set connection(status,$sid) 1
+    uplevel #0 $command 1
     return
 }
 
-proc socks5::initiator::send_data {sid data} {
-    variable connection
+###############################################################################
 
-    puts -nonewline $connection(sock,$sid) $data
-    flush $connection(sock,$sid)
+proc socks5::initiator::send_data {sid data command} {
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
-    return 1
+    puts -nonewline $state(sock) $data
+    flush $state(sock)
+
+    after idle [list uplevel #0 $command 1]
 }
 
+###############################################################################
+
 proc socks5::initiator::close {sid} {
-    variable connection
-    ::close $connection(sock,$sid)
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
+    ::close $state(sock)
+
+    unset $token
 }
 
+###############################################################################
+
 proc socks5::initiator::accept {sid sock addr port} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
 
     debugmsg si "CONNECT FROM $addr:$port"
 
-    set connection(sock,$sid) $sock
+    set state(sock) $sock
     fconfigure $sock -translation binary -blocking no
 
     fileevent $sock readable \
@@ -186,15 +224,18 @@
 }
 
 proc socks5::initiator::wait_for_methods {sock sid} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
+
     if {[catch {set data [read $sock]}]} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
     if {[eof $sock]} {
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -203,7 +244,7 @@
     if {$ver != 5 || ![lcontain $methods 0]} {
 	puts -nonewline $sock "\x05\xff"
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -215,17 +256,19 @@
 }
 
 proc socks5::initiator::wait_for_request {sock sid} {
-    variable connection
+    set token [namespace current]::$sid
+    variable $token
+    upvar 0 $token state
     variable hash_sid
 
     if {[catch {set data [read $sock]}]} {
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
     if {[eof $sock]} {
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -235,7 +278,7 @@
 	set reply [string replace $data 1 1 \x07]
 	puts -nonewline $sock $reply
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
 	return
     }
 
@@ -254,10 +297,12 @@
 	set reply [string replace $data 1 1 \x02]
 	puts -nonewline $sock $reply
 	::close $sock
-	set connection(status,$sid) 0
+	set state(status) 0
     }
 }
 
+###############################################################################
+
 proc socks5::readable {sid chan} {
     if {![eof $chan]} {
 	set buf [read $chan 4096]
@@ -268,6 +313,8 @@
     }
 }
 
+###############################################################################
+
 proc socks5::iq_set_handler {connid from lang child} {
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
@@ -280,8 +327,8 @@
 	    switch -- $tag1 {
 		streamhost {
 		    lappend hosts [list [jlib::wrapper:getattr $vars1 host] \
-				       [jlib::wrapper:getattr $vars1 port] \
-				       [jlib::wrapper:getattr $vars1 jid]]
+				        [jlib::wrapper:getattr $vars1 port] \
+				        [jlib::wrapper:getattr $vars1 jid]]
 		}
 	    }
 	}
@@ -296,8 +343,12 @@
 iq::register_handler set "" $::NS(bytestreams) \
     [namespace current]::socks5::iq_set_handler
 
+###############################################################################
+
 si::register_transport $::NS(bytestreams) $::NS(bytestreams) 50 \
     [namespace current]::socks5::initiator::connect \
     [namespace current]::socks5::initiator::send_data \
     [namespace current]::socks5::initiator::close
 
+###############################################################################
+

Modified: trunk/tkabber/si.tcl
===================================================================
--- trunk/tkabber/si.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/si.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -6,7 +6,9 @@
 
 set ::NS(si) http://jabber.org/protocol/si
 
-proc si::connect {connid jid id mimetype profile profile_el} {
+###############################################################################
+
+proc si::connect {connid jid id chunk_size mimetype profile profile_el command} {
     variable connection
     variable transport
 
@@ -54,19 +56,19 @@
 			profile $profile] \
 	     -subtags [list $profile_el $feature]] \
 	-to $jid \
-	-command [list si::connect_response $connid $jid $id $profile] \
+	-command [list si::connect_response $connid $jid $id $chunk_size \
+					    $profile $command] \
 	-connection $connid
-
-    vwait [namespace current]::connection(status,$id)
-    return $connection(status,$id)
 }
 
-proc si::connect_response {connid jid id profile res child} {
+###############################################################################
+
+proc si::connect_response {connid jid id chunk_size profile command res child} {
     variable connection
     variable transport
 
     if {$res != "OK"} {
-	set connection(status,$id) [list 0 [error_to_string $child]]
+	uplevel #0 $command [list [list 0 [error_to_string $child]]]
 	return
     }
 
@@ -82,7 +84,6 @@
 	}
     }
 
-
     set opts {}
 
     foreach item $children {
@@ -99,14 +100,14 @@
     if {[llength $opts] == 1 && [lcontain $options [lindex $opts 0]]} {
 	set name [lindex $opts 0]
 	set connection(transport,$id) $name
-	set connection(status,$id) \
-	    [eval $transport(connect,$name) [list $connid $jid $id]]
+	eval $transport(connect,$name) [list $connid $jid $id $chunk_size $command]
 	return
     }
-    set connection(status,$id) \
-	[list 0 [::msgcat::mc "Stream method negotiation failed"]]
+    uplevel #0 $command \
+	    [list [list 0 [::msgcat::mc "Stream method negotiation failed"]]]
 }
 
+###############################################################################
 
 proc si::set_readable_handler {id handler} {
     variable connection
@@ -118,12 +119,16 @@
     set connection(closed_handler,$id) $handler
 }
 
-proc si::send_data {id data} {
+###############################################################################
+
+proc si::send_data {id data command} {
     variable connection
     variable transport
-    eval $transport(send,$connection(transport,$id)) [list $id $data]
+    eval $transport(send,$connection(transport,$id)) [list $id $data $command]
 }
 
+###############################################################################
+
 proc si::recv_data {id data} {
     variable connection
     debugmsg si "RECV_DATA [list $id $data]"
@@ -134,6 +139,8 @@
     }
 }
 
+###############################################################################
+
 proc si::read_data {id} {
     variable connection
 
@@ -142,6 +149,8 @@
     return $data
 }
 
+###############################################################################
+
 proc si::close {id} {
     variable connection
     variable transport
@@ -149,6 +158,8 @@
     set_status [::msgcat::mc "SI connection closed"]
 }
 
+###############################################################################
+
 proc si::closed {id} {
     variable connection
     if {[info exists connection(closed_handler,$id)]} {
@@ -156,7 +167,9 @@
     }
 }
 
+###############################################################################
 
+
 proc si::parse_negotiation {child} {
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 

Modified: trunk/tkabber/userinfo.tcl
===================================================================
--- trunk/tkabber/userinfo.tcl	2006-09-20 09:44:58 UTC (rev 725)
+++ trunk/tkabber/userinfo.tcl	2006-09-21 19:44:55 UTC (rev 726)
@@ -101,9 +101,9 @@
 #        set bgcolor [lindex [$g.$name configure -background] 4]
         set bgcolor [option get $g background Notebook]
 	if {[info tclversion] >= 8.4} {
-    	    $g.$name configure -state readonly -highlightcolor $bgcolor -takefocus 0
+    	    $g.$name configure -state readonly -relief flat -highlightcolor $bgcolor -takefocus 0
 	} else {
-	    $g.$name configure -state disabled -background $bgcolor
+	    $g.$name configure -state disabled -relief flat -background $bgcolor
 	}
     }
 
@@ -121,7 +121,7 @@
     set w [w_from_jid $jid]
 
     label $g.l$name -text $text
-    text $g.$name -height 1 -state disabled -background [option get $g background Notebook]
+    text $g.$name -height 1 -state disabled -relief flat -background [option get $g background Notebook]
     $g.$name tag configure emphasized -elide 1
     $g.$name tag configure nonemphasized -elide 0
     fill_user_description $g.$name userinfo($name,$jid) 0



More information about the Tkabber-dev mailing list