# $Id: http.tcl,v 1.2 2004/07/10 20:05:03 aleksey Exp $

namespace eval http {
    variable winid 0
    variable chunk_size 4096

    variable options

    custom::defgroup HTTP \
	[::msgcat::mc "HTTP options."] \
	-group FileTransfer

    custom::defvar options(enable) 1 \
	[::msgcat::mc "Enable HTTP transport for outgoing file transfers."] \
	-group HTTP -type boolean
}

proc http::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]
    }

    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:"]
    text $f.desc -width 50 -height 5

    label $f.lip -text [::msgcat::mc "IP address:"]
    entry $f.ip -textvariable [list [namespace current]::ip$winid]
    variable ip$winid 127.0.0.1
    catch {
        set ip$winid [info hostname]
	set ip$winid [lindex [host_info addresses [set ip$winid]] 0]
    }

    catch {
	set ip$winid [lindex [fconfigure $jlib::lib(sck) -sockname] 0]
    }

    ProgressBar $f.pb \
	-variable [list [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.lip -row 2 -column 0 -sticky e
    grid $f.ip  -row 2 -column 1 -sticky ew -columnspan 2

    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
}

proc http::set_send_file_name {winid} {
    variable filename$winid

    set file [tk_getOpenFile]
    if {$file != ""} {
	set filename$winid $file
    }
}

proc http::send_file_start {winid f user args} {
    
    .ftsfd$winid itemconfigure 0 -state disabled

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

proc http::send_file_offer {winid user filename desc ip args} {

    foreach {opt val} $args {
	switch -- $opt {
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	set connid [jlib::route $user]
    }

    set servsock \
	[socket -server \
	     [list [namespace current]::send_file_accept $winid $filename] 0]

    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 chans
    variable chanreadable$chan

    if {[info exists chans($winid)]} {
	close $chan
	return
    } else {
	set chans($winid) $chan
    }

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

    fileevent $chan readable {}

    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"

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

    fileevent $chan writable \
	[list [namespace current]::send_file_transfer_chunk $winid $fd $chan]
}

proc http::send_file_transfer_chunk {winid fd chan} {
    variable chunk_size
    variable chans

    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]
    } else {
	fileevent $chan writable {}
	close $fd
	close $chan
	unset chans($winid)
	destroy .ftsfd$winid
    }
}

proc http::send_file_cancel {winid sock} {
    variable chans

    if {[info exists chans($winid)]} {
	close $chans($winid)
	unset chans($winid)
    }

    bind .ftsfd$winid <Destroy> {}

    close $sock
    destroy .ftsfd$winid
}

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
    variable result

    set w .ftrfd$winid

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

    set url [lindex $urls 0]

    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.lurl -text [::msgcat::mc "URL:"]
    label $f.url -text $url

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

    set dir $ft::options(download_dir)
    set fname [file tail $url]
    label $f.lsaveas -text [::msgcat::mc "Save as:"]
    entry $f.saveas -textvariable [list [namespace current]::saveas$winid]
    variable saveas$winid [file join $dir $fname]
    button $f.browsefile -text [::msgcat::mc "Browse..."] \
	-command [list [namespace current]::set_receive_file_name $winid $dir $fname]

    ProgressBar $f.pb -variable [list [namespace current]::progress$f.pb]
    variable progress$f.pb 0

    grid $f.lurl    -row 0 -column 0 -sticky e
    grid $f.url     -row 0 -column 1 -sticky w -columnspan 2
    
    grid $f.ldesc   -row 1 -column 0 -sticky en
    grid $f.desc    -row 1 -column 1 -sticky ewns -columnspan 2 -pady 1m

    grid $f.lsaveas -row 2 -column 0 -sticky e
    grid $f.saveas  -row 2 -column 1 -sticky ew
    grid $f.browsefile -row 2 -column 2 -sticky ew

    grid $f.pb      -row 3 -column 0 -sticky ew -columnspan 3 -pady 2m

    grid columnconfigure $f 1 -weight 1 -minsize 8c
    grid rowconfigure $f 1 -weight 1
    
    $w add -text [::msgcat::mc "Receive"] \
	-command [list [namespace current]::recv_file_start $winid $from $url]
    $w add -text [::msgcat::mc "Cancel"] \
	-command [list destroy $w]
    bind .ftrfd$winid <Destroy> \
	[list [namespace current]::recv_file_cancel $winid]

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

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

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

package require http

proc http::recv_file_start {winid from url} {
    variable saveas$winid
    variable chunk_size
    variable result

    set filename [set saveas$winid]

    .ftrfd$winid itemconfigure 0 -state disabled
    set f [.ftrfd$winid getframe]

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

    set geturl \
	[list ::http::geturl $url -channel $fd \
	      -blocksize $chunk_size \
	      -progress [list [namespace current]::recv_file_progress $f.pb] \
	      -command [list [namespace current]::recv_file_finish $winid]]

    if {[package vcompare 2.3.3 [package require http]] <= 0} {
	lappend geturl -binary 1
    }

    if {[catch $geturl token]} {
	bind .ftrfd$winid <Destroy> {}
	destroy .ftrfd$winid
	# TODO: More precise error messages?
	set result($winid) {error cancel item-not-found -text "File Not Found"}
	after idle [list MessageDlg .ftrecv_error$winid \
			 -aspect 50000 -icon error \
			 -message [format [::msgcat::mc \
			 "Can't receive file: %s"] $token] -type user \
			 -buttons ok -default 0 -cancel 0]
    } else {
	bind .ftrfd$winid <Destroy> \
	    [list [namespace current]::recv_file_cancel $winid $token]
    }
}

proc http::recv_file_progress {pb token total current} {
    variable progress$pb
    debugmsg filetransfer "$total $current"
    $pb configure -maximum $total
    set progress$pb $current
}

proc http::recv_file_finish {winid token} {
    variable result

    upvar #0 $token state
    debugmsg filetransfer "transfer $state(status)"

    bind .ftrfd$winid <Destroy> {}
    destroy .ftrfd$winid
    set result($winid) {result {}}
}

proc http::recv_file_cancel {winid {token ""}} {
    variable result

    bind .ftrfd$winid <Destroy> {}

    if {![cequal $token ""]} {
	::http::reset $token cancelled
    }
    set result($winid) {error cancel not-allowed -text "File Transfer Refused"}
}


proc http::iq_handler {connid from child} {
    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set urls ""
    set desc ""

    foreach child $children {
	jlib::wrapper:splitxml $child tag vars isempty chdata children1
	switch -- $tag {
	    url  {lappend urls $chdata}
	    desc {set desc $chdata}
	}
    }

    return [recv_file_dialog $from $urls $desc]
}

iq::register_handler set query jabber:iq:oob \
    [namespace current]::http::iq_handler



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