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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Nov 5 00:15:39 MSK 2006


Author: sergei
Date: 2006-11-05 00:15:36 +0300 (Sun, 05 Nov 2006)
New Revision: 784

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/filetransfer.tcl
   trunk/tkabber/plugins/filetransfer/http.tcl
   trunk/tkabber/plugins/filetransfer/jidlink.tcl
   trunk/tkabber/plugins/filetransfer/si.tcl
Log:
	* filetransfer.tcl, plugins/filetransfer/http.tcl,
	  plugins/filetransfer/jidlink.tcl, plugins/filetransfer/si.tcl:
	  Moved send file user interface to filetransfer.tcl (unfinished
	  yet).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-11-04 18:51:30 UTC (rev 783)
+++ trunk/tkabber/ChangeLog	2006-11-04 21:15:36 UTC (rev 784)
@@ -1,5 +1,10 @@
 2006-11-04  Sergei Golovan  <sgolovan at nes.ru>
 
+	* filetransfer.tcl, plugins/filetransfer/http.tcl,
+	  plugins/filetransfer/jidlink.tcl, plugins/filetransfer/si.tcl:
+	  Moved send file user interface to filetransfer.tcl (unfinished
+	  yet).
+
 	* plugins/richtext/emoticons.tcl, plugins/richtext/stylecodes.tcl,
 	  plugins/richtext/urls.tcl: Removed 'enable' options, added
 	  all customize groups to Chat group. Changed emoticons theme

Modified: trunk/tkabber/filetransfer.tcl
===================================================================
--- trunk/tkabber/filetransfer.tcl	2006-11-04 18:51:30 UTC (rev 783)
+++ trunk/tkabber/filetransfer.tcl	2006-11-04 21:15:36 UTC (rev 784)
@@ -1,9 +1,10 @@
 # $Id$
 
+###############################################################################
+
 namespace eval ft {
-    
-    custom::defgroup FileTransfer [::msgcat::mc "File Transfer options."] \
-	-group Tkabber -tag "File Transfer"
+    custom::defgroup {File Transfer} [::msgcat::mc "File Transfer options."] \
+	-group Tkabber
 
     switch -- $::tcl_platform(platform) {
 	windows {
@@ -20,31 +21,69 @@
     # TODO macintosh?
     custom::defvar options(download_dir) $default_dir \
 	[::msgcat::mc "Default directory for downloaded files."] \
-	-type string -group FileTransfer
+	-type string -group {File Transfer}
 
-    custom::defvar options(cascaded_menu) 0 \
-	[::msgcat::mc "Use cascaded (otherwise flat) file transfer menu."] \
-	-type boolean -group FileTransfer
-
-    plugins::load [file join plugins filetransfer] -uplevel 1
+    variable winid 0
 }
 
+###############################################################################
 
-proc ft::create_menu {m connid jid} {
-    variable options
-    
-    if {$options(cascaded_menu)} {
-	set mm [menu $m.filetransfer -tearoff 0]
-	hook::run create_filetransfer_menu_hook $mm 1 $jid -connection $connid
-	if {![hook::is_flag create_filetransfer_menu_hook transport]} {
-	    $m add cascad -label [::msgcat::mc "Send file"] -menu $mm
+proc ft::register_protocol {name args} {
+    variable protocols
+
+    set priority 50
+    set label $name
+
+    foreach {key val} $args {
+	switch -- $key {
+	    -priority { set priority $val }
+	    -label    { set label $val }
+	    -options  { set options $val }
+	    -send     { set send $val }
+	    -receive  { set receive $val }
+	    -close    { set close $val }
+	    -closed   { set closed $val }
+	    default   {
+		return -code error "[namespace current]::register_protocol:\
+				    Illegal option $key"
+	    }
 	}
-    } else {
-	hook::run create_filetransfer_menu_hook $m 0 $jid -connection $connid
     }
-    
+
+    lappend protocols(names) [list $name $priority]
+    set protocols(names) [lsort -integer -index 1 $protocols(names)]
+
+    set protocols(label,$name) $label
+
+    foreach option {options send receive close closed} {
+	if {[info exists $option]} {
+	    set protocols($option,$name) [set $option]
+	}
+    }
 }
 
+plugins::load [file join plugins filetransfer]
+
+###############################################################################
+
+namespace eval ft {
+    variable protocols
+
+    set values {}
+    foreach name_prio $protocols(names) {
+	lassign $name_prio name priority
+	lappend values $name $protocols(label,$name)
+    }
+
+    custom::defvar options(default_proto) [lindex $values 0] \
+	[::msgcat::mc "Default protocol for sending files."] \
+	-type options \
+	-values $values \
+	-group {File Transfer}
+}
+
+###############################################################################
+
 proc ft::get_POSIX_error_desc {} {
     global errorCode
     set class [lindex $errorCode 0]
@@ -74,6 +113,19 @@
     catch {destroy $f.errormsg}
 }
 
+###############################################################################
+
+proc ft::create_menu {m connid jid} {
+    variable protocols
+
+    if {![lempty $protocols(names)]} {
+	$m add command -label [::msgcat::mc "Send file..."] \
+		       -command [list [namespace current]::send_file_dialog \
+				      $jid \
+				      -connection $connid]
+    }
+}
+
 hook::add chat_create_user_menu_hook \
     [namespace current]::ft::create_menu 46
 hook::add roster_create_groupchat_user_menu_hook \
@@ -85,3 +137,197 @@
 hook::add search_popup_menu_hook \
     [namespace current]::ft::create_menu 46
 
+###############################################################################
+#
+# Draw a send file dialog
+#
+
+proc ft::send_file_dialog {jid args} {
+    variable winid
+    variable options
+    variable protocols
+
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -connection { set connid $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	error "[namespace current]::send_file_dialog: -connection option\
+	       is mandatory"
+    }
+
+    set token [namespace current]::[incr winid]
+    upvar #0 $token state
+
+    set w .sfd$winid
+    set state(w) $w
+    set state(jid) $jid
+    set state(connid) $connid
+
+    Dialog $w -title [format [::msgcat::mc "Send file to %s"] $jid] \
+	      -separator 1 -anchor e -modal none \
+	      -default 0 -cancel 1
+
+    $w add -text [::msgcat::mc "Send"] \
+	   -command [list [namespace current]::send_file_negotiate $token]
+    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+
+    bind $w <Destroy> [list [namespace current]::send_file_close $token %W]
+
+    set f [$w getframe]
+    set state(f) $f
+
+    label $f.lfile -text [::msgcat::mc "File to send:"]
+    entry $f.file -textvariable ${token}(filename)
+    button $f.browsefile -text [::msgcat::mc "Browse..."] \
+	-command [list [namespace current]::set_send_file_name $token]
+
+    label $f.ldesc -text [::msgcat::mc "Description:"]
+    set sw [ScrolledWindow $f.sw -scrollbar vertical]
+    textUndoable $f.desc -width 60 -height 5 -wrap word
+    $sw setwidget $f.desc
+
+    set values {}
+    foreach name_prio $protocols(names) {
+	lassign $name_prio name priority
+	lappend values $protocols(label,$name)
+	if {$options(default_proto) == $name} {
+	    set state(protocol) $protocols(label,$name)
+	}
+    }
+    if {![info exists state(protocol)]} {
+	set state(protocol) [lindex $values 0]
+    }
+    label $f.lproto -text [::msgcat::mc "Protocol:"]
+    eval [list OptionMenu $f.proto ${token}(protocol)] $values
+
+    ProgressBar $f.pb -variable ${token}(progress)
+    set state(pb) $f.pb
+    set state(progress) 0
+
+    # Grid row 0 is used for displaying error messages
+
+    grid $f.lfile      -row 1 -column 0 -sticky e
+    grid $f.file       -row 1 -column 1 -sticky ew
+    grid $f.browsefile -row 1 -column 2 -sticky ew
+    
+    grid $f.ldesc -row 2 -column 0 -sticky en
+    grid $f.sw    -row 2 -column 1 -sticky ewns -columnspan 2 -pady 1m
+
+    grid $f.lproto -row 3 -column 0 -sticky e
+    grid $f.proto  -row 3 -column 1 -sticky ew -columnspan 2 -pady 1m
+
+    # Grid row 4 vill be used for displaying protocol options
+
+    grid $f.pb -row 5 -column 0 -sticky ew -columnspan 3 -pady 2m
+
+    grid columnconfigure $f 1 -weight 1
+    grid rowconfigure $f 2 -weight 1
+
+    $w draw $f.file
+}
+
+proc ft::set_send_file_name {token} {
+    variable $token
+    upvar 0 $token state
+
+    set file [tk_getOpenFile]
+    if {$file != ""} {
+	set state(filename) $file
+    }
+}
+
+###############################################################################
+
+proc ft::send_file_negotiate {token} {
+    upvar #0 $token state
+    variable chunk_size
+    variable protocols
+
+    hide_error_msg $state(f)
+    $state(w) itemconfigure 0 -state disabled
+
+    set state(desc) [$state(f).desc get 0.0 "end -1c"]
+
+    if {[catch {open $state(filename)} fd]} {
+	report_cannot_open_file $state(f) $state(filename) [get_POSIX_error_desc]
+	$state(w) itemconfigure 0 -state normal
+	return
+    }
+
+    debugmsg filetransfer "SENDFILE: $state(filename)"
+
+    set state(fd) $fd
+    fconfigure $fd -translation binary
+
+    set state(name) [file tail $state(filename)]
+    set size [file size $state(filename)]
+    set state(size) $size
+
+    if {$size == 0} {
+	$state(pb) configure -maximum 1
+	set state(progress) -1
+    } else {
+	$state(pb) configure -maximum $size
+    }
+
+    foreach name_prio $protocols(names) {
+	lassign $name_prio proto priority
+	if {$state(protocol) == $protocols(label,$proto)} {
+	    break
+	}
+    }
+    set state(proto) $proto
+
+    set state(command) [list [namespace current]::send_file_callback $token]
+
+    # Use $token as filetransfer ID and state array variable
+    eval $protocols(send,$proto) [list $token]
+}
+
+###############################################################################
+
+proc ft::send_file_close {token w} {
+    upvar #0 $token state
+    variable protocols
+
+    if {[winfo toplevel $w] != $w} return
+
+    catch {eval $protocols(close,$state(proto)) $token}
+    catch {close $state(fd)}
+    catch {unset $token}
+}
+
+###############################################################################
+
+proc ft::send_file_callback {token res {msg ""}} {
+    upvar #0 $token state
+
+    # Peer's reply may arrive after window is closed.
+    if {![info exists state(w)] || ![winfo exists $state(w)]} return
+
+    switch -- $res {
+	ERR {
+	    if {$state(size) > 0} {
+		set state(progress) 0
+	    }
+	    report_error $state(f) $msg
+	    catch {eval $protocols(close,$state(proto)) $token}
+	    catch {close $state(fd)}
+	    $state(w) itemconfigure 0 -state normal
+	}
+	PROGRESS {
+	    if {$state(size) > 0} {
+		set state(progress) $msg
+	    }
+	}
+	default {
+	    destroy $state(w)
+	}
+    }
+}
+
+###############################################################################
+

Modified: trunk/tkabber/plugins/filetransfer/http.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/http.tcl	2006-11-04 18:51:30 UTC (rev 783)
+++ trunk/tkabber/plugins/filetransfer/http.tcl	2006-11-04 21:15:36 UTC (rev 784)
@@ -1,5 +1,9 @@
 # $Id$
 
+# File transfer via Out of Band Data (XEP-0066)
+
+###############################################################################
+
 namespace eval http {
     variable winid 0
     variable chunk_size 4096
@@ -8,277 +12,162 @@
 
     custom::defgroup HTTP \
 	[::msgcat::mc "HTTP options."] \
-	-group FileTransfer
+	-group {File Transfer}
 
     custom::defvar options(enable) 1 \
 	[::msgcat::mc "Enable HTTP transport for outgoing file transfers."] \
 	-group HTTP -type boolean
 
     custom::defvar options(port) 0 \
-        [::msgcat::mc "Port for outgoing HTTP file transfers (0 for assigned automatically).\
-	This is useful when sending files from behind a NAT with a forwarded port."] \
+        [::msgcat::mc "Port for outgoing HTTP file transfers (0 for assigned\
+		       automatically). This is useful when sending files from\
+		       behind a NAT with a forwarded port."] \
 	-group HTTP -type integer
 
     custom::defvar options(host) "" \
-        [::msgcat::mc "Force advertising this hostname (or IP address) for outgoing HTTP file transfers."] \
+        [::msgcat::mc "Force advertising this hostname (or IP address) for\
+		       outgoing HTTP file transfers."] \
 	-group HTTP -type string
 
 }
 
-proc http::send_file_dialog {user args} {
-    variable winid
+###############################################################################
+
+proc http::send_file {token} {
+    upvar #0 $token state
     variable options
+    
+    if {![info exists state(fd)]} return
 
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
+    #set ip [$f.ip get]
+    #label $f.lip -text [::msgcat::mc "IP address:"]
+    #entry $f.ip -textvariable [list [namespace current]::ip$winid]
+    #variable ip$winid 127.0.0.1
 
-    while {[winfo exists .ftsfd$winid]} {
-	incr winid
-    }
-    set w .ftsfd$winid
-
-    variable filename$winid
-
-    Dialog $w -title [format [::msgcat::mc "Send file to %s"] $user] \
-	-separator 1 -anchor e -modal none \
-	-default 0 -cancel 1
-
-    set f [$w getframe]
-
-    label $f.lfile -text [::msgcat::mc "File to send:"]
-    entry $f.file -textvariable [list [namespace current]::filename$winid]
-    button $f.browsefile -text [::msgcat::mc "Browse..."] \
-	-command [list [namespace current]::set_send_file_name $winid]
-
-    label $f.ldesc -text [::msgcat::mc "Description:"]
-    textUndoable $f.desc -width 50 -height 5 -wrap word
-
-    label $f.lip -text [::msgcat::mc "IP address:"]
-    entry $f.ip -textvariable [list [namespace current]::ip$winid]
-    variable ip$winid 127.0.0.1
-
+    set host 127.0.0.1
     if {[string compare $options(host) ""] != 0} {
-	set ip$winid $options(host)
+	set host $options(host)
     } else {
 	catch {
-	    set ip$winid [info hostname]
-	    set ip$winid [lindex [host_info addresses [set ip$winid]] 0]
+	    set host [info hostname]
+	    set host [lindex [host_info addresses $host] 0]
 	}
-	if {[jlib::socket_ip $connid] != ""} {
-	    set ip$winid [jlib::socket_ip $connid]
+	if {[jlib::socket_ip $state(connid)] != ""} {
+	    set host [jlib::socket_ip $state(connid)]
 	}
     }
+    set state(host) $host
 
-    ProgressBar $f.pb \
-	-variable [list [namespace current]::progress$f.pb]
-    variable progress$f.pb 0
+    set state(servsock) \
+	[socket -server \
+	     [list [namespace current]::send_file_accept $token] $options(port)]
 
-    grid $f.lfile      -row 0 -column 0 -sticky e
-    grid $f.file       -row 0 -column 1 -sticky ew
-    grid $f.browsefile -row 0 -column 2 -sticky ew
-    
-    grid $f.ldesc -row 1 -column 0 -sticky en
-    grid $f.desc  -row 1 -column 1 -sticky ewns -columnspan 2 -pady 1m
+    lassign [fconfigure $state(servsock) -sockname] addr hostname port
 
-    grid $f.lip -row 2 -column 0 -sticky e
-    grid $f.ip  -row 2 -column 1 -sticky ew -columnspan 2
+    set url [cconcat "http://$state(host):$port/" [file tail $state(filename)]]
 
-    grid $f.pb -row 3 -column 0 -sticky ew -columnspan 3 -pady 2m
-
-    grid columnconfigure $f 1 -weight 1
-    grid rowconfigure $f 1 -weight 1
-
-    $w add -text [::msgcat::mc "Send"] \
-	-command [list [namespace current]::send_file_start $winid $f \
-		       $user -connection $connid]
-    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
-
-    incr winid
-    $w draw $f.file
+    jlib::send_iq set [jlib::wrapper:createtag query \
+			   -vars {xmlns jabber:iq:oob} \
+			   -subtags [list [jlib::wrapper:createtag url \
+					       -chdata $url] \
+					  [jlib::wrapper:createtag desc \
+					       -chdata $state(desc)]]] \
+	-to $state(jid) \
+	-command [list [namespace current]::send_file_error_handler $token] \
+	-connection $state(connid)
 }
 
-proc http::set_send_file_name {winid} {
-    variable filename$winid
+###############################################################################
 
-    set file [tk_getOpenFile]
-    if {$file != ""} {
-	set filename$winid $file
-    }
-}
+proc http::send_file_error_handler {token res child} {
+    upvar #0 $token state
 
-proc http::send_file_start {winid f user args} {
-    
-    .ftsfd$winid itemconfigure 0 -state disabled
+    if {![info exists state(fd)]} return
+    if {[cequal $res OK]} return
 
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
-
-    set filename [$f.file get]
-    set desc [$f.desc get 0.0 "end -1c"]
-    set ip [$f.ip get]
-
-    if {![file isfile $filename]} {
-	MessageDlg .ftfile_not_found$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
-	.ftsfd$winid itemconfigure 0 -state normal
-	return
-    }
-
-    set fsize [file size $filename]
-    $f.pb configure -maximum $fsize
-
-    debugmsg filetransfer "SENDFILE: $filename; $desc; $ip"
-
-    set servsock \
-	[send_file_offer $winid $user $filename $desc $ip -connection $connid]
-
-    bind .ftsfd$winid <Destroy> \
-	[list [namespace current]::send_file_cancel $winid $servsock]
+    eval $state(command) ERR \
+	 [list [::msgcat::mc "Request failed: %s" [error_to_string $child]]]
 }
 
-proc http::send_file_offer {winid user filename desc ip args} {
-    variable options
+###############################################################################
 
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
+proc http::send_file_accept {token chan addr port} {
+    upvar #0 $token state
 
-    set servsock \
-	[socket -server \
-	     [list [namespace current]::send_file_accept $winid $filename] $options(port)]
+    if {![info exists state(fd)]} return
 
-    lassign [fconfigure $servsock -sockname] addr hostname port
-
-    set url [cconcat "http://$ip:$port/" [file tail $filename]]
-
-    jlib::send_iq set [jlib::wrapper:createtag query \
-			   -vars {xmlns jabber:iq:oob} \
-			   -subtags [list [jlib::wrapper:createtag url \
-					       -chdata $url] \
-					  [jlib::wrapper:createtag desc \
-					       -chdata $desc]]] \
-	-to [get_jid_of_user $connid $user] \
-	-command [list [namespace current]::send_file_error_handler $winid $servsock] \
-	-connection $connid
-
-    return $servsock
-}
-
-proc http::send_file_accept {winid filename chan addr port} {
-    variable fds
-    variable chans
     variable chanreadable$chan
 
-    if {[info exists chans($winid)]} {
+    if {[info exists state(chan)]} {
 	close $chan
 	return
     } else {
-	set chans($winid) $chan
+	set state(chan) $chan
     }
 
-    fconfigure $chan -blocking 0 -encoding binary -buffering line
+    set size $state(size)
 
+    fconfigure $chan -blocking 0 -encoding binary -buffering line
     fileevent $chan readable [list set [namespace current]::chanreadable$chan 1]
 
     set request " "
     
     while {$request != ""} {
-	debugmsg filetransfer $request
 	vwait [namespace current]::chanreadable$chan
 	set request [gets $chan]
+	debugmsg filetransfer $request
     }
 
     fileevent $chan readable {}
+    unset chanreadable$chan
 
-    set fsize [file size $filename]
-
-    #debugmsg filetransfer $request
     fconfigure $chan -translation binary
 
     puts -nonewline $chan "HTTP/1.0 200 OK\n"
-    puts -nonewline $chan "Content-Length: $fsize\n"
-    puts -nonewline $chan "Content-Type: application/data\n\n"
+    puts -nonewline $chan "Content-Length: $size\n"
+    puts -nonewline $chan "Content-Type: application/octet-stream\n\n"
 
-    set fd [open $filename]
-    fconfigure $fd -translation binary
-    set fds($winid) $fd
-
     fileevent $chan writable \
-	[list [namespace current]::send_file_transfer_chunk $winid $fd $chan]
+	[list [namespace current]::send_file_transfer_chunk $token $chan]
 }
 
-proc http::send_file_transfer_chunk {winid fd chan} {
+###############################################################################
+
+proc http::send_file_transfer_chunk {token chan} {
+    upvar #0 $token state
     variable chunk_size
-    variable chans
-    variable fds
 
-    set chunk [read $fd $chunk_size]
-    if {$chunk != "" && ![catch { puts -nonewline $chan $chunk }]} {
-	set pb [.ftsfd$winid getframe].pb
-	variable progress$pb
-	set progress$pb [tell $fd]
+    if {![info exists state(fd)]} return
+
+    set chunk [read $state(fd) $chunk_size]
+    if {$chunk != ""} {
+	if {[catch {puts -nonewline $chan $chunk}]} {
+	    eval $state(command) [list ERR "File transfer failed"]
+	} else {
+	    eval $state(command) [list PROGRESS [tell $state(fd)]]
+	}
     } else {
-	fileevent $chan writable {}
-	close $fd
-	close $chan
-	unset fds($winid)
-	unset chans($winid)
-	destroy .ftsfd$winid
+	eval $state(command) OK
     }
 }
 
-proc http::send_file_cancel {winid sock} {
-    variable chans
-    variable fds
+###############################################################################
 
-    if {[info exists chans($winid)]} {
-	close $chans($winid)
-	unset chans($winid)
-    }
-    if {[info exists fds($winid)]} {
-	close $fds($winid)
-	unset fds($winid)
-    }
+proc http::send_file_close {token} {
+    upvar #0 $token state
 
-    bind .ftsfd$winid <Destroy> {}
+    if {![info exists state(fd)]} return
 
-    close $sock
-    destroy .ftsfd$winid
+    catch {close $state(chan)}
+    catch {close $state(servsock)}
+    catch {
+	variable chanreadable$state(chan)
+	unset chanreadable$state(chan)
+    }
 }
 
-proc http::send_file_error_handler {winid sock res child} {
-
-    if {[cequal $res OK]} return
-    if {![winfo exists .ftsfd$winid]} return
-    
-    send_file_cancel $winid $sock
-    MessageDlg .ftsend_error$winid -aspect 50000 -icon error \
-	-message [format [::msgcat::mc \
-		    "Error while sending file. Peer reported: %s"] \
-		    [error_to_string $child]] \
-	-type user -buttons ok -default 0 -cancel 0
-}
-
 ###############################################################################
+###############################################################################
 
 proc http::recv_file_dialog {from urls desc} {
     variable winid
@@ -439,6 +328,7 @@
     set result($winid) {error cancel not-allowed -text "File Transfer Refused"}
 }
 
+###############################################################################
 
 proc http::iq_handler {connid from lang child} {
     jlib::wrapper:splitxml $child tag vars isempty chdata children
@@ -460,25 +350,13 @@
 iq::register_handler set query jabber:iq:oob \
     [namespace current]::http::iq_handler
 
+###############################################################################
 
+ft::register_protocol http \
+    -priority 30 \
+    -label "HTTP" \
+    -send [namespace current]::http::send_file \
+    -close [namespace current]::http::send_file_close
 
-proc http::add_menu_item {m cascad jid args} {
-    variable options
+###############################################################################
 
-    if {!$options(enable)} return
-
-    if {$cascad} {
-	set label [::msgcat::mc "via HTTP..."]
-    } else {
-	set label [::msgcat::mc "Send file via HTTP..."] \
-    }
-    $m add command -label $label \
-	-command [list eval \
-		      [list [namespace current]::send_file_dialog $jid] $args]
-
-    hook::unset_flag create_filetransfer_menu_hook transport
-}
-
-hook::add create_filetransfer_menu_hook \
-    [namespace current]::http::add_menu_item 20
-

Modified: trunk/tkabber/plugins/filetransfer/jidlink.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/jidlink.tcl	2006-11-04 18:51:30 UTC (rev 783)
+++ trunk/tkabber/plugins/filetransfer/jidlink.tcl	2006-11-04 21:15:36 UTC (rev 784)
@@ -6,274 +6,146 @@
 namespace eval ftjl {
     set winid 0
     set id 0
-    set chunk_size 4096
+    set chunk_size 1024
     
     variable options
 
     custom::defgroup Jidlink \
 	[::msgcat::mc "Jidlink options."] \
-	-group FileTransfer
+	-group {File Transfer}
 
     custom::defvar options(enable) 0 \
 	[::msgcat::mc "Enable Jidlink transport for outgoing file transfers (it is obsolete)."] \
 	-group Jidlink -type boolean
 }
 
-hook::add create_filetransfer_menu_hook \
-    [namespace current]::ftjl::add_menu_item 30
+###############################################################################
 
-proc ftjl::add_menu_item {m cascad jid args} {
-    variable options
+proc ftjl::send_file {token} {
+    upvar #0 $token state
+    variable id
+    variable files
 
-    if {!$options(enable)} return
+    if {![info exists state(fd)]} return
 
-    if {$cascad} {
-	set label [::msgcat::mc "via Jidlink..."]
-    } else {
-	set label [::msgcat::mc "Send file via Jidlink..."] \
-    }
-    $m add command -label $label \
-        -command [list eval [list [namespace current]::send_file_dialog $jid] $args]
+    incr id
+    set state(id) $id
+    set files(token,$id) $token
 
-    hook::unset_flag create_filetransfer_menu_hook transport
+    jlib::send_iq set \
+	[jlib::wrapper:createtag query \
+	     -vars {xmlns jabber:iq:filexfer} \
+	     -subtags [list [jlib::wrapper:createtag file \
+				 -vars [list id $id \
+					    name $state(name) \
+					    size $state(size)] \
+				 -chdata $state(desc)]]] \
+	-to $state(jid) \
+	-command [list [namespace current]::send_file_result $token] \
+	-connection $state(connid)
 }
 
-proc ftjl::send_file_dialog {user args} {
-    variable winid
+###############################################################################
 
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
+proc ftjl::send_file_result {token res child} {
+    upvar #0 $token state
 
-    while {[winfo exists .sfd$winid]} {
-	incr winid
-    }
-    set w .sfd$winid
+    if {![info exists state(fd)]} return
 
-    variable filename$winid
+    if {[cequal $res OK]} return
 
-    Dialog $w -title [format [::msgcat::mc "Send file to %s"] $user] \
-	-separator 1 -anchor e -modal none \
-	-default 0 -cancel 1
-
-    set f [$w getframe]
-
-    label $f.lfile -text [::msgcat::mc "File to send:"]
-    entry $f.file -textvariable [list [namespace current]::filename$winid]
-    button $f.browsefile -text [::msgcat::mc "Browse..."] \
-	-command [list [namespace current]::set_send_file_name $winid]
-
-    label $f.ldesc -text [::msgcat::mc "Description:"]
-    textUndoable $f.desc -width 50 -height 5 -wrap word
-
-    ProgressBar $f.pb -variable [namespace current]::progress$f.pb
-    variable progress$f.pb 0
-
-    grid $f.lfile      -row 0 -column 0 -sticky e
-    grid $f.file       -row 0 -column 1 -sticky ew
-    grid $f.browsefile -row 0 -column 2 -sticky ew
-    
-    grid $f.ldesc -row 1 -column 0 -sticky en
-    grid $f.desc  -row 1 -column 1 -sticky ewns -columnspan 2 -pady 1m
-
-    grid $f.pb -row 2 -column 0 -sticky ew -columnspan 3 -pady 2m
-
-    grid columnconfigure $f 1 -weight 1
-    grid rowconfigure $f 1 -weight 1
-
-    $w add -text [::msgcat::mc "Send"] \
-	-command [list [namespace current]::send_file_start $winid $f \
-		       $user -connection $connid]
-    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
-
-    incr winid
-    $w draw $f.file
+    eval $state(command) ERR \
+	 [list [::msgcat::mc "Request failed: %s" [error_to_string $child]]]
 }
 
-proc ftjl::set_send_file_name {winid} {
-    variable filename$winid
+###############################################################################
 
-    set file [tk_getOpenFile]
-    if {$file != ""} {
-	set filename$winid $file
-    }
-}
+proc ftjl::send_file_request {connid from id offset} {
+    variable files
 
-proc ftjl::send_file_start {winid f user args} {
-
-    .sfd$winid itemconfigure 0 -state disabled
-
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
+    if {![info exists files(token,$id)]} {
+	return [list error cancel not-allowed -text "Invalid file ID"]
     }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
 
-    set filename [$f.file get]
-    set desc [$f.desc get 0.0 "end -1c"]
+    set token $files(token,$id)
+    upvar #0 $token state
 
-    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
-	return
+    if {![info exists state(fd)]} {
+	return [list error cancel not-allowed -text "Transfer is expired"]
     }
 
-    set fsize [file size $filename]
-    $f.pb configure -maximum $fsize
-
-    debugmsg filetransfer "SENDFILE: $filename; $desc"
-
-    send_file_offer $winid $user $filename $desc -connection $connid
-    #bind .sfd$winid <Destroy> [list [namespace current]::send_file_cancel $winid $servsock]
-}
-
-proc ftjl::send_file_offer {winid user filename desc args} {
-    variable id
-    variable files
-
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
+    if {$state(connid) != $connid || $state(jid) != $from} {
+	return [list error cancel not-allowed -text "Invalid file ID"]
     }
-    if {![info exists connid]} {
-	set connid [jlib::route $user]
-    }
 
-    incr id
-    set name [file tail $filename]
-    set size [file size $filename]
-
-    set files(filename,$id) $filename
-    set files(w,$id) .sfd$winid
-
-    jlib::send_iq set \
+    set state(key) [random 1000000000]
+    set state(offset) $offset
+    set res \
 	[jlib::wrapper:createtag query \
 	     -vars {xmlns jabber:iq:filexfer} \
 	     -subtags [list [jlib::wrapper:createtag file \
-				 -vars [list id $id \
-					    name $name \
-					    size $size] \
-				 -chdata $desc]]] \
-	-to $user \
-	-command [list [namespace current]::send_file_offer_reply $winid] \
-	-connection $connid
+				 -vars [list id $id] \
+				 -subtags [list [jlib::wrapper:createtag key \
+						     -chdata $state(key)]]]]]
+    after idle [list [namespace current]::send_file_setup_connection $token]
+    return [list result $res]
 }
 
-proc ftjl::send_file_offer_reply {winid res child} {
+###############################################################################
 
-    if {[cequal $res OK]} return
-    if {![winfo exists .sfd$winid]} return
-
-    bind .sfd$winid <Destroy> {}
-    destroy .sfd$winid
-    after idle \
-	[list MessageDlg .auth_err -aspect 50000 -icon error \
-	      -message [format [::msgcat::mc "Send file request failed: %s"] \
-			    [error_to_string $child]] -type user \
-	      -buttons ok -default 0 -cancel 0]
-}
-
-proc ftjl::send_file_request {connid from id offset} {
-    variable files
-
-    if {[info exists files(filename,$id)]} {
-	set key [random 1000000000]
-	set res \
-	    [jlib::wrapper:createtag query \
-		 -vars {xmlns jabber:iq:filexfer} \
-		 -subtags [list \
-			       [jlib::wrapper:createtag file \
-				    -vars [list id $id] \
-				    -subtags [list [jlib::wrapper:createtag \
-							key \
-							-chdata $key]]]]]
-	after idle [list [namespace current]::send_file_setup_connection \
-			$connid $from $id $offset $key]
-	return [list result $res]
-    } else {
-	return [list error cancel not-allowed -text "Invalid file id"]
-    }
-}
-
-proc ftjl::send_file_setup_connection {connid user id offset key} {
-    variable files
+proc ftjl::send_file_setup_connection {token} {
+    upvar #0 $token state
     variable chunk_size
 
-    set res [jidlink::connect $connid $user $key]
+    if {![info exists state(fd)]} return
 
-    set w $files(w,$id)
+    set res [jidlink::connect $state(connid) $state(jid) $state(key)]
 
     if {$res == 0} {
-	catch {
-	    bind $w <Destroy> {}
-	    destroy $w
+	if {[info exists state(command)]} {
+	    eval $state(command) ERR [::msgcat::mc "Jidlink connection failed"]
 	}
-	# TODO: error message
 	return
     }
 
-    if {![winfo exists $w]} {
-	jidlink::close $key
-	return
-    }
-
-    bind $w <Destroy> [list [namespace current]::send_file_close $key]
-
-    set filename $files(filename,$id)
-    set fd [open $filename]
-    fconfigure $fd -translation binary
-
-    set files(rfd,$key) $fd
-
-    set pb [$files(w,$id) getframe].pb
-    variable progress$pb
-    $pb configure -maximum [file size $filename]
-
-    #set chunk [read $fd]
     set_status [::msgcat::mc "Transferring..."]
 
-    set chunk [read $fd $chunk_size]
-    catch {
-	while {$chunk != "" && [winfo exists $w]} {
-	    jidlink::send_data $key $chunk
-	    update idletasks
-	    set progress$pb [tell $fd]
-	    debugmsg filetransfer [set progress$pb]
-	    after 1000
-	    set chunk [read $fd $chunk_size]
+    # Transfer window may be destroyed during jidlink::connect
+    if {![info exists state(fd)]} return
+
+    set chunk [read $state(fd) $chunk_size]
+    if {[catch {
+	     while {$chunk != ""} {
+		 jidlink::send_data $state(key) $chunk
+		 update idletasks
+		 eval $state(command) [list PROGRESS [tell $state(fd)]]
+		 after 1000
+		 set chunk [read $state(fd) $chunk_size]
+	     }
+	 }]} {
+	if {[info exists state(command)]} {
+	    eval $state(command) ERR [::msgcat::mc "Jidlink transfer failed"]
 	}
+	return
     }
 
-    catch { close $fd }
-    catch { destroy $w }
-
-    jidlink::close $key
+    eval $state(command) OK
 }
 
-proc ftjl::send_file_close {key} {
+###############################################################################
+
+proc ftjl::send_file_close {token} {
+    upvar #0 $token state
     variable files
 
-    catch { close $files(rfd,$key) }
-    #set w $files(w,$id)
-    #jidlink::close $key
-    #destroy $w
+    if {![info exists state(fd)]} return
+
+    catch {unset files(token,$state(id))}
+    catch {jidlink::close $state(key)}
 }
 
 ###############################################################################
+###############################################################################
 
 proc ftjl::recv_file_dialog {connid from id name size date hash desc} {
     variable winid
@@ -348,6 +220,8 @@
     return $res
 }
 
+###############################################################################
+
 proc ftjl::set_receive_file_name {winid dir fname} {
     variable saveas$winid
 
@@ -357,6 +231,8 @@
     }
 }
 
+###############################################################################
+
 proc ftjl::recv_file_start {winid size pbvar connid user id} {
     variable saveas$winid
     variable files
@@ -379,6 +255,8 @@
 	-connection $connid
 }
 
+###############################################################################
+
 proc ftjl::recv_file_reply {winid size pbvar user id filename res child} {
     variable files
 
@@ -422,6 +300,8 @@
     }
 }
 
+###############################################################################
+
 proc ftjl::recv_file_chunk {pbvar key} {
     variable files
 
@@ -439,6 +319,8 @@
 
 }
 
+###############################################################################
+
 proc ftjl::recv_file_failed {winid} {
     variable result
 
@@ -447,6 +329,8 @@
 	{error modify undefined-condition -text "File Transfer Failed"}
 }
 
+###############################################################################
+
 proc ftjl::recv_file_finish {winid size key} {
     variable files
     variable result
@@ -479,6 +363,8 @@
     set result($winid) {result {}}
 }
 
+###############################################################################
+
 proc ftjl::recv_file_cancel {winid} {
     variable result
 
@@ -490,35 +376,47 @@
 	{error cancel not-allowed -text "File Transfer Refused"}
 }
 
+###############################################################################
+
 proc ftjl::iq_set_handler {connid from lang child} {
     debugmsg filetransfer "FTJL set: [list $from $child]"
 
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
-    if {$tag == "query"} {
-	foreach item $children {
-	    jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
-	    if {$tag1 == "file"} {
-		if {[jlib::wrapper:getattr $vars1 name] != ""} {
-		    return [recv_file_dialog $connid $from \
-			[jlib::wrapper:getattr $vars1 id] \
-			[jlib::wrapper:getattr $vars1 name] \
-			[jlib::wrapper:getattr $vars1 size] \
-			[jlib::wrapper:getattr $vars1 date] \
-			[jlib::wrapper:getattr $vars1 hash] \
-			$chdata1]
-		} else {
-		    return [send_file_request $connid $from \
-				[jlib::wrapper:getattr $vars1 id] \
-				[jlib::wrapper:getattr $vars1 offset]]
-		}
+    if {$tag != "query"} {
+	return {error modify bad-request}
+    }
+
+    foreach item $children {
+	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
+	if {$tag1 == "file"} {
+	    if {[jlib::wrapper:getattr $vars1 name] != ""} {
+		return [recv_file_dialog $connid $from \
+		       [jlib::wrapper:getattr $vars1 id] \
+		       [jlib::wrapper:getattr $vars1 name] \
+		       [jlib::wrapper:getattr $vars1 size] \
+		       [jlib::wrapper:getattr $vars1 date] \
+		       [jlib::wrapper:getattr $vars1 hash] \
+		       $chdata1]
+	    } else {
+		return [send_file_request $connid $from \
+			    [jlib::wrapper:getattr $vars1 id] \
+			    [jlib::wrapper:getattr $vars1 offset]]
 	    }
 	}
-    } else {
-	return {error modify bad-request}
     }
 }
 
 iq::register_handler set query jabber:iq:filexfer \
     [namespace current]::ftjl::iq_set_handler
 
+###############################################################################
+
+ft::register_protocol jidlink \
+    -priority 20 \
+    -label "Jidlink" \
+    -send [namespace current]::ftjl::send_file \
+    -close [namespace current]::ftjl::send_file_close
+
+###############################################################################
+

Modified: trunk/tkabber/plugins/filetransfer/si.tcl
===================================================================
--- trunk/tkabber/plugins/filetransfer/si.tcl	2006-11-04 18:51:30 UTC (rev 783)
+++ trunk/tkabber/plugins/filetransfer/si.tcl	2006-11-04 21:15:36 UTC (rev 784)
@@ -12,7 +12,7 @@
 
     custom::defgroup {Stream Initiation} \
 	[::msgcat::mc "Stream initiation options."] \
-	-group FileTransfer
+	-group {File Transfer}
 
     custom::defvar options(enable) 1 \
 	[::msgcat::mc "Enable SI transport for outgoing file transfers."] \
@@ -22,149 +22,41 @@
 set ::NS(file-transfer) http://jabber.org/protocol/si/profile/file-transfer
 
 ###############################################################################
-#
-# Draw a send file dialog
-#
 
-proc si::send_file_dialog {jid args} {
-    variable winid
-
-    foreach {opt val} $args {
-	switch -- $opt {
-	    -connection { set connid $val }
-	}
-    }
-    if {![info exists connid]} {
-	error "[namespace current]::send_file_dialog: -connection option\
-	       is mandatory"
-    }
-
-    set token [namespace current]::[incr winid]
+proc si::send_file {token} {
     upvar #0 $token state
-
-    set w .sfd$winid
-    set state(w) $w
-    set state(jid) $jid
-    set state(connid) $connid
-
-    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 ${token}(filename)
-    button $f.browsefile -text [::msgcat::mc "Browse..."] \
-	-command [list [namespace current]::set_send_file_name $token]
-
-    label $f.ldesc -text [::msgcat::mc "Description:"]
-    textUndoable $f.desc -width 50 -height 5 -wrap word
-
-    ProgressBar $f.pb -variable ${token}(progress)
-    set state(pb) $f.pb
-    set state(progress) 0
-
-    # grid row 0 is used for displaying error messages
-
-    grid $f.lfile      -row 1 -column 0 -sticky e
-    grid $f.file       -row 1 -column 1 -sticky ew
-    grid $f.browsefile -row 1 -column 2 -sticky ew
-    
-    grid $f.ldesc -row 2 -column 0 -sticky en
-    grid $f.desc  -row 2 -column 1 -sticky ewns -columnspan 2 -pady 1m
-
-    grid $f.pb -row 3 -column 0 -sticky ew -columnspan 3 -pady 2m
-
-    grid columnconfigure $f 1 -weight 1
-    grid rowconfigure $f 2 -weight 1
-
-    $w add -text [::msgcat::mc "Send"] \
-	   -command [list [namespace current]::send_file_negotiate $token]
-    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
-
-    bind $w <Destroy> [list [namespace current]::send_file_close $token $w %W]
-
-    $w draw $f.file
-}
-
-proc si::set_send_file_name {token} {
-    variable $token
-    upvar 0 $token state
-
-    set file [tk_getOpenFile]
-    if {$file != ""} {
-	set state(filename) $file
-    }
-}
-
-###############################################################################
-
-proc si::send_file_negotiate {token} {
-    upvar #0 $token state
     variable chunk_size
 
-    ft::hide_error_msg $state(f)
-    $state(w) itemconfigure 0 -state disabled
+    if {![info exists state(fd)]} return
 
-    set desc [$state(f).desc get 0.0 "end -1c"]
-
-    if {[catch {open $state(filename)} fd]} {
-	ft::report_cannot_open_file $state(f) $state(filename) \
-				    [ft::get_POSIX_error_desc]
-	$state(w) itemconfigure 0 -state normal
-	return
-    }
-
-    debugmsg filetransfer "SENDFILE: $state(filename); $desc"
-
-    set state(fd) $fd
-    fconfigure $fd -translation binary
-
-    set name [file tail $state(filename)]
-    set size [file size $state(filename)]
-    set state(size) $size
-
-    if {$size == 0} {
-	$state(pb) configure -maximum 1
-	set state(progress) -1
-    } else {
-	$state(pb) configure -maximum $size
-    }
-
     set state(stream) [si::newout $state(connid) $state(jid)]
 
     set profile [jlib::wrapper:createtag file \
 		     -vars [list xmlns $::NS(file-transfer) \
-				 name $name \
-				 size $size] \
+				 name $state(name) \
+				 size $state(size)] \
 		     -subtags [list [jlib::wrapper:createtag desc \
-					 -chdata $desc]]]
+					 -chdata $state(desc)]]]
 
     si::connect $state(stream) $chunk_size application/octet-stream \
 		$::NS(file-transfer) $profile \
-		[list [namespace current]::send_file $token]
+		[list [namespace current]::send_file_result $token]
 }
 
 ###############################################################################
 
-proc si::send_file {token res} {
+proc si::send_file_result {token res} {
     upvar #0 $token state
 
-    # Peer's reply may arrive after window is closed.
-    if {![info exists state(w)] || ![winfo exists $state(w)]} return
+    if {![info exists state(fd)]} return
 
     if {![lindex $res 0]} {
-	ft::report_error $state(f) \
-			 [::msgcat::mc "Request failed: %s" [lindex $res 1]]
-	close $state(fd)
-	$state(w) itemconfigure 0 -state normal
+	eval $state(command) ERR \
+	     [list [::msgcat::mc "Request failed: %s" [lindex $res 1]]]
 	return
     }
 
     set_status [::msgcat::mc "Transferring..."]
-
     after idle [list [namespace current]::send_chunk $token]
 }
 
@@ -179,47 +71,34 @@
 	si::send_data $state(stream) $chunk \
 		      [list [namespace current]::send_chunk_response $token]
     } else {
-	destroy $state(w)
+	eval $state(command) OK
     }
 }
 
 proc si::send_chunk_response {token res} {
     upvar #0 $token state
 
-    # Peer's reply may arrive after window is closed.
-    if {![info exists state(w)] || ![winfo exists $state(w)]} return
-    if {![info exists state(stream)]} return
+    if {![info exists state(fd)]} return
 
     if {![lindex $res 0]} {
-	ft::report_error $state(f) \
-			 [::msgcat::mc "Transfer failed: %s" [lindex $res 1]]
-	if {$state(size) > 0} {
-	    set state(progress) 0
-	}
-	si::close $state(stream)
-	si::freeout $state(stream)
-	close $state(fd)
-	$state(w) itemconfigure 0 -state normal
+	eval $state(command) ERR \
+	     [list [::msgcat::mc "Transfer failed: %s" [lindex $res 1]]]
 	return
     }
 
-    if {$state(size) > 0} {
-	set state(progress) [tell $state(fd)]
-    }
+    eval $state(command) [list PROGRESS [tell $state(fd)]]
     after idle [list [namespace current]::send_chunk $token]
 }
 
 ###############################################################################
 
-proc si::send_file_close {token w1 w2} {
+proc si::send_file_close {token} {
     upvar #0 $token state
 
-    if {$w1 != $w2} return
+    if {![info exists state(stream)]} return
 
-    catch { si::close $state(stream) }
-    catch { si::freeout $state(stream) }
-    catch { close $state(fd) }
-    catch { unset $token }
+    catch {si::close $state(stream)}
+    catch {si::freeout $state(stream)}
 }
 
 ###############################################################################
@@ -450,25 +329,11 @@
 
 ###############################################################################
 
-proc si::add_menu_item {m cascad jid args} {
-    variable options
+ft::register_protocol si \
+    -priority 10 \
+    -label "Stream Initiation" \
+    -send [namespace current]::si::send_file \
+    -close [namespace current]::si::send_file_close
 
-    if {!$options(enable)} return
-
-    if {$cascad} {
-	set label [::msgcat::mc "via SI..."]
-    } else {
-	set label [::msgcat::mc "Send file via SI..."] \
-    }
-    $m add command -label $label \
-        -command [list eval \
-		      [list [namespace current]::send_file_dialog $jid] $args]
-
-    hook::unset_flag create_filetransfer_menu_hook transport
-}
-
-hook::add create_filetransfer_menu_hook \
-    [namespace current]::si::add_menu_item 10
-
 ###############################################################################
 



More information about the Tkabber-dev mailing list