# $Id: filetransfer.tcl 1209 2007-08-31 11:52:26Z sergei $

###############################################################################
# File transfer via Jidlink

namespace eval ftjl {
    set winid 0
    set id 0
    set chunk_size 1024
    
    variable options

    custom::defgroup Jidlink \
	[::msgcat::mc "Jidlink options."] \
	-group {File Transfer}
}

###############################################################################

proc ftjl::send_file {token} {
    upvar #0 $token state
    variable id
    variable files

    if {![info exists state(fd)]} return

    incr id
    set state(id) $id
    set files(token,$id) $token

    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_result {token res child} {
    upvar #0 $token state

    if {![info exists state(fd)]} return

    if {[cequal $res OK]} return

    eval $state(command) ERR \
	 [list [::msgcat::mc "Request failed: %s" [error_to_string $child]]]
}

###############################################################################

proc ftjl::send_file_request {connid from lang id offset} {
    variable files

    if {![info exists files(token,$id)]} {
	return [list error cancel not-allowed \
		     -text [::trans::trans $lang "Invalid file ID"]]
    }

    set token $files(token,$id)
    upvar #0 $token state

    if {![info exists state(fd)]} {
	return [list error cancel not-allowed \
		     -text [::trans::trans $lang "Transfer is expired"]]
    }

    if {$state(connid) != $connid || $state(jid) != $from} {
	return [list error cancel not-allowed \
		     -text [::trans::trans $lang "Invalid file ID"]]
    }

    set state(key) [rand 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] \
				 -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_setup_connection {token} {
    upvar #0 $token state
    variable chunk_size

    if {![info exists state(fd)]} return

    set res [jidlink::connect $state(connid) $state(jid) $state(key)]

    if {$res == 0} {
	if {[info exists state(command)]} {
	    eval $state(command) ERR [::msgcat::mc "Jidlink connection failed"]
	}
	return
    }

    set_status [::msgcat::mc "Transferring..."]

    # 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
    }

    eval $state(command) OK
}

###############################################################################

proc ftjl::send_file_close {token} {
    upvar #0 $token state
    variable files

    if {![info exists state(fd)]} return

    catch {unset files(token,$state(id))}
    catch {jidlink::close $state(key)}
}

###############################################################################
###############################################################################

proc ftjl::recv_file_dialog {connid from lang id name size date hash desc} {
    variable winid
    variable files
    variable result

    set w .rfd$winid

    while {[winfo exists $w]} {
	incr winid
	set w .rfd$winid
    }

    Dialog $w -title [format [::msgcat::mc "Receive file from %s"] $from] \
	-separator 1 -anchor e \
	-modal none -default 0 -cancel 1


    set f [$w getframe]

    label $f.lname -text [::msgcat::mc "Name:"]
    label $f.name -text $name

    label $f.lsize -text [::msgcat::mc "Size:"]
    label $f.size -text $size

    label $f.ldesc -text [::msgcat::mc "Description:"]
    message $f.desc -width 10c -text $desc

    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]
    button $f.browsefile -text [::msgcat::mc "Browse..."] \
	-command [list [namespace current]::set_receive_file_name $winid $dir $name]

    set pbvar [namespace current]::progress$f.pb
    ProgressBar $f.pb -variable $pbvar
    $f.pb configure -maximum $size
    set $pbvar 0

    grid $f.lname   -row 0 -column 0 -sticky e
    grid $f.name    -row 0 -column 1 -sticky w
    
    grid $f.lsize   -row 1 -column 0 -sticky e
    grid $f.size    -row 1 -column 1 -sticky w
    
    grid $f.ldesc   -row 2 -column 0 -sticky en
    grid $f.desc    -row 2 -column 1 -sticky ewns -columnspan 2 -pady 1m

    grid $f.lsaveas -row 3 -column 0 -sticky e
    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 $size $pbvar $connid $from $lang $id]
    $w add -text [::msgcat::mc "Cancel"] -command \
	[list [namespace current]::recv_file_cancel $winid $lang]
    bind .rfd$winid <Destroy> \
            [list [namespace current]::recv_file_failed $winid $lang]

    $w draw
    vwait [namespace current]::result($winid)
    set res $result($winid)
    unset result($winid)
    incr winid
    return $res
}

###############################################################################

proc ftjl::set_receive_file_name {winid dir fname} {
    variable saveas$winid

    set file [tk_getSaveFile -initialdir $dir -initialfile $fname]
    if {$file != ""} {
	set saveas$winid $file
    }
}

###############################################################################

proc ftjl::recv_file_start {winid size pbvar connid user lang id} {
    variable saveas$winid
    variable files

    set filename [set saveas$winid]

    .rfd$winid itemconfigure 0 -state disabled
    set $pbvar 0

    #set files(filename,$key) $filename

    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars {xmlns jabber:iq:filexfer} \
	     -subtags [list [jlib::wrapper:createtag file \
				 -vars [list id $id]]]] \
	-to $user \
	-command [list [namespace current]::recv_file_reply \
		       $winid $size $pbvar $user $lang $id $filename] \
	-connection $connid
}

###############################################################################

proc ftjl::recv_file_reply {winid size pbvar user lang id filename res child} {
    variable files

    if {$res != "OK"} {
	recv_file_failed $winid $lang
	after idle \
	    [list MessageDlg .auth_err -aspect 50000 -icon error \
		  -message [format [::msgcat::mc "Receiving file failed: %s"] \
			        [error_to_string $child]] -type user \
		  -buttons ok -default 0 -cancel 0]
	return
    }

    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"} {
		foreach item1 $children1 {
		    jlib::wrapper:splitxml $item1 tag2 vars2 isempty2 \
			chdata2 children2
		    if {$tag2 == "key"} {
			set key $chdata2
			set files(filename,$key) $filename
			debugmsg filetransfer "RECV KEY: $key"

			set fd [open $filename w]
			fconfigure $fd -translation binary

			set files(fd,$key) $fd

			jidlink::set_readable_handler \
			    $key [list [namespace current]::recv_file_chunk $pbvar]
			jidlink::set_closed_handler \
			    $key [list [namespace current]::recv_file_finish $winid $size]
		    }
		}
	    }
	}
    }
}

###############################################################################

proc ftjl::recv_file_chunk {pbvar key} {
    variable files

    if {[info exists files(filename,$key)]} {
	set data [jidlink::read_data $key]

	debugmsg filetransfer \
	    "RECV into $files(filename,$key) data length [string length $data]"

	puts -nonewline $files(fd,$key) $data

	incr $pbvar [string length $data]
	debugmsg filetransfer [set $pbvar]
    }

}

###############################################################################

proc ftjl::recv_file_failed {winid lang} {
    variable result

    bind .rfd$winid <Destroy> {}
    set result($winid) \
	[list error modify undefined-condition \
	      -text [::trans::trans $lang "File transfer is failed"]]
}

###############################################################################

proc ftjl::recv_file_finish {winid size key} {
    variable files
    variable result

    if {[info exists files(filename,$key)]} {
	debugmsg filetransfer CLOSE
	catch { close $files(fd,$key) }
	set fsize [file size $files(filename,$key)]
	unset files(filename,$key)
	set_status [::msgcat::mc "Connection closed"]
    }
    if {[winfo exists .rfd$winid]} {
	bind .rfd$winid <Destroy> {}
	destroy .rfd$winid
	
	if {$fsize != $size} {
	    if {$fsize < $size} {
		set msg "Transfer interrupted (File size is too small)"
	    } else {
		set msg "File size is too large"
	    }
	    after idle \
		[list MessageDlg .auth_err -aspect 50000 -icon error \
		      -message [format [::msgcat::mc "Receiving file failed: %s"] \
				    $msg] \
		      -type user \
		      -buttons ok -default 0 -cancel 0]
	}
    }
    set result($winid) {result {}}
}

###############################################################################

proc ftjl::recv_file_cancel {winid lang} {
    variable result

    catch {
	bind .rfd$winid <Destroy> {}
	destroy .rfd$winid
    }
    set result($winid) \
	[list error cancel not-allowed \
	      -text [::trans::trans $lang "File transfer is 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"} {
	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 $lang \
		       [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 $lang \
			    [jlib::wrapper:getattr $vars1 id] \
			    [jlib::wrapper:getattr $vars1 offset]]
	    }
	}
    }
}

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

###############################################################################

