# $Id: si.tcl 1168 2007-07-31 09:30:24Z sergei $
#
# Stream Initiation (XEP-0095) implementation
#

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

namespace eval si {
    set transport(list) {}
}

set ::NS(si) http://jabber.org/protocol/si

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

proc si::newout {connid jid} {
    variable streams

    set id [rand 1000000000]
    while {[info exists streams(out,$connid,$jid,$id)]} {
	set id [rand 1000000000]
    }
    set streamid 0
    set stream [namespace current]::0
    while {[info exists $stream]} {
	set stream [namespace current]::[incr streamid]
    }
    upvar #0 $stream state

    set state(connid) $connid
    set state(jid) $jid
    set state(id) $id
    set streams(out,$connid,$jid,$id) $stream

    return $stream
}

proc si::freeout {stream} {
    variable streams
    upvar #0 $stream state

    catch {
	set connid $state(connid)
	set jid $state(jid)
	set id $state(id)

	unset state
	unset streams(out,$connid,$jid,$id)
    }
}

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

proc si::newin {connid jid id} {
    variable streams

    if {[info exists streams(in,$connid,$jid,$id)]} {
	return -code error
    }

    set streamid 0
    set stream [namespace current]::0
    while {[info exists $stream]} {
	set stream [namespace current]::[incr streamid]
    }
    upvar #0 $stream state

    set state(connid) $connid
    set state(jid) $jid
    set state(id) $id
    set streams(in,$connid,$jid,$id) $stream

    return $stream
}

proc si::in {connid jid id} {
    variable streams

    return $streams(in,$connid,$jid,$id)
}

proc si::freein {stream} {
    variable streams
    upvar #0 $stream state

    catch {
	set connid $state(connid)
	set jid $state(jid)
	set id $state(id)

	unset state
	unset streams(in,$connid,$jid,$id)
    }
}

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

proc si::connect {stream chunk_size mimetype profile profile_el command} {
    variable transport
    upvar #0 $stream state

    set trans [lsort -unique -index 1 $transport(list)]
    set options {}
    foreach t $trans {
	set name [lindex $t 0]
	if {![info exists transport(allowed,$name)] || \
		$transport(allowed,$name)} {
	    lappend options $transport(oppos,$name)
	}
    }

    set opttags {}
    foreach opt $options {
	lappend opttags [jlib::wrapper:createtag option \
			     -subtags [list [jlib::wrapper:createtag value \
						 -chdata $opt]]]
    }

    set feature \
	[jlib::wrapper:createtag feature \
	     -vars [list xmlns http://jabber.org/protocol/feature-neg] \
	     -subtags \
	     [list [jlib::wrapper:createtag x \
			-vars [list xmlns jabber:x:data type form] \
			-subtags \
			[list [jlib::wrapper:createtag \
				   field \
				   -vars [list var stream-method \
					       type list-single] \
				   -subtags $opttags]]]]]


    set_status [::msgcat::mc "Opening SI connection"]

    jlib::send_iq set \
	[jlib::wrapper:createtag si \
	     -vars [list xmlns $::NS(si) \
			id $state(id) \
			mime-type $mimetype \
			profile $profile] \
	     -subtags [list $profile_el $feature]] \
	-to $state(jid) \
	-command [list si::connect_response $stream $chunk_size \
					    $profile $command] \
	-connection $state(connid)
}

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

proc si::connect_response {stream chunk_size profile command res child} {
    variable transport
    upvar #0 $stream state

    if {![info exists state(id)]} {
	# TODO: It would be good to send some error message to a receiver
	# (but it is not supported by the protocol).
	uplevel #0 $command [list [list 0 [::msgcat::mc "File transfer aborted"]]]
	return
    }

    if {$res != "OK"} {
	uplevel #0 $command [list [list 0 [error_to_string $child]]]
	return
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set trans [lsort -unique -index 1 $transport(list)]
    set options {}
    foreach t $trans {
	set name [lindex $t 0]
	if {![info exists transport(allowed,$name)] || \
		$transport(allowed,$name)} {
	    lappend options $transport(oppos,$name)
	}
    }

    set opts {}

    foreach item $children {
	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	set xmlns [jlib::wrapper:getattr $vars1 xmlns]
	    if {[string equal $xmlns $profile]} {
		# TODO
	    } elseif {[string equal $xmlns \
			   http://jabber.org/protocol/feature-neg]} {
		set opts [parse_negotiation_res $item]
	    }
    }

    if {[llength $opts] == 1 && [lcontain $options [lindex $opts 0]]} {
	set name [lindex $opts 0]
	set state(transport) $name
	eval $transport(connect,$name) [list $stream $chunk_size $command]
	return
    }
    uplevel #0 $command \
	    [list [list 0 [::msgcat::mc "Stream method negotiation failed"]]]
}

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

proc si::send_data {stream data command} {
    variable transport
    upvar #0 $stream state

    eval $transport(send,$state(transport)) [list $stream $data $command]
}

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

proc si::close {stream} {
    variable transport
    upvar #0 $stream state

    eval $transport(close,$state(transport)) [list $stream]
    set_status [::msgcat::mc "SI connection closed"]
}

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

proc si::set_readable_handler {stream handler} {
    upvar #0 $stream state

    set state(readable_handler) $handler
}

proc si::set_closed_handler {stream handler} {
    upvar #0 $stream state

    set state(closed_handler) $handler
}

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

proc si::recv_data {stream data} {
    upvar #0 $stream state

    debugmsg si "RECV_DATA [list $state(id) $data]"

    append state(data) $data
    eval $state(readable_handler) [list $stream]
}

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

proc si::read_data {stream} {
    upvar #0 $stream state

    set data $state(data)
    set state(data) {}
    return $data
}

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

proc si::closed {stream} {
    upvar #0 $stream state

    if {[info exists state(closed_handler)]} {
	eval $state(closed_handler) [list $stream]
    }
}

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

proc si::parse_negotiation {child} {
    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set options {}
    foreach item $children {
	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	set xmlns [jlib::wrapper:getattr $vars1 xmlns]
	if {[string equal $xmlns jabber:x:data]} {
	    foreach item $children1 {
		jlib::wrapper:splitxml $item \
		    tag2 vars2 isempty2 chdata2 children2
		set var [jlib::wrapper:getattr $vars2 var]
		if {[string equal $var stream-method]} {
		    foreach item $children2 {
			jlib::wrapper:splitxml $item \
			    tag3 vars3 isempty3 chdata3 children3
			foreach item $children3 {
			    jlib::wrapper:splitxml $item \
				tag4 vars4 isempty4 chdata4 children4
			    lappend options $chdata4
			}
		    }
		}
	    }
	}
    }
    return $options
}

proc si::parse_negotiation_res {child} {
    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set options {}
    foreach item $children {
	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	set xmlns [jlib::wrapper:getattr $vars1 xmlns]
	if {[string equal $xmlns jabber:x:data]} {
	    foreach item $children1 {
		jlib::wrapper:splitxml $item \
		    tag2 vars2 isempty2 chdata2 children2
		set var [jlib::wrapper:getattr $vars2 var]
		if {[string equal $var stream-method]} {
		    foreach item $children2 {
			jlib::wrapper:splitxml $item \
			    tag3 vars3 isempty3 chdata3 children3
			lappend options $chdata3
		    }
		}
	    }
	}
    }
    return $options
}

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

proc si::set_handler {connid from lang child} {
    variable profiledata
    variable transport

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set id [jlib::wrapper:getattr $vars id]
    set mimetype [jlib::wrapper:getattr $vars mime-type]
    set profile [jlib::wrapper:getattr $vars profile]
    set stream {}
    set profile_res {}

    if {[info exists profiledata($profile)]} {
	foreach item $children {
	    jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	    set xmlns [jlib::wrapper:getattr $vars1 xmlns]
	    if {[string equal $xmlns $profile]} {
		set profile_res [$profiledata($profile) \
				     $connid $from $lang $id $mimetype $item]
	    } elseif {[string equal $xmlns \
			   http://jabber.org/protocol/feature-neg]} {
		set options [parse_negotiation $item]

		set trans [lsort -unique -index 1 $transport(list)]
		set myoptions {}
		foreach t $trans {
		    set name [lindex $t 0]
		    if {![info exists transport(allowed,$name)] || \
			    $transport(allowed,$name)} {
			lappend myoptions $transport(oppos,$name)
		    }
		}

		foreach opt $options {
		    if {[lcontain $myoptions $opt]} {
			set stream $opt
			break
		    }
		}
	    }
	}
	
	if {[lindex $profile_res 0] == "error"} {
	    return $profile_res
	}
	if {$stream == {}} {
	    # no-valid-streams
	    return [list error modify bad-request]
	}
	set res_childs {}
	if {$profile_res != {}} {
	    lappend res_childs $profile_res
	}
	set opttags \
	    [list [jlib::wrapper:createtag value \
		       -chdata $opt]]
	lappend res_childs \
	    [jlib::wrapper:createtag feature \
		 -vars [list xmlns http://jabber.org/protocol/feature-neg] \
		 -subtags \
		 [list [jlib::wrapper:createtag x \
			    -vars [list xmlns jabber:x:data type submit] \
			    -subtags \
			    [list [jlib::wrapper:createtag \
				       field \
				       -vars [list var stream-method] \
				       -subtags $opttags]]]]]
	set res [jlib::wrapper:createtag si \
		     -vars [list xmlns $::NS(si)] \
		     -subtags $res_childs]
	return [list result $res]
    } else {
	# bad-profile
	return [list error modify bad-request]
    }
}

iq::register_handler set "" $::NS(si) si::set_handler

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

proc si::register_transport {name oppos prio connect send close} {
    variable transport

    lappend transport(list) [list $name $prio]
    set transport(oppos,$name) $oppos
    set transport(connect,$name) $connect
    set transport(send,$name) $send
    set transport(close,$name) $close
}

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

proc si::register_profile {profile handler} {
    variable profiledata
    set profiledata($profile) $handler
}

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

proc si::setup_customize {} {
    variable transport

    set trans [lsort -unique -index 1 $transport(list)]

    foreach t $trans {
	lassign $t name prio

	custom::defvar transport(allowed,$name) 1 \
	[format [::msgcat::mc "Enable SI transport %s."] $name] \
	-type boolean -group {Stream Initiation}
    }
}

hook::add finload_hook si::setup_customize 40

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

namespace eval si {
    plugins::load [file join plugins si] -uplevel 1
}

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

