#  ibb.tcl --
#  
#      This file is part of the jabberlib. 
#      It provides support for the ibb stuff (In Band Bytestreams).
#      
#  Copyright (c) 2005  Mats Bengtsson
#  
# This file is distributed under BSD style license.
#  
# $Id: ibb.tcl,v 1.22 2007-11-30 14:38:34 matben Exp $
# 
############################# USAGE ############################################
#
#   NAME
#      ibb - convenience command library for the ibb part of XMPP.
#      
#   SYNOPSIS
#      jlib::ibb::init jlibname
#
#   OPTIONS
#   
#	
#   INSTANCE COMMANDS
#      jlibName ib send_set jid command ?-key value?
#      
############################# CHANGES ##########################################
#
#       0.1         first version

package require jlib
package require base64     ; # tcllib
package require jlib::disco
package require jlib::si

package provide jlib::ibb 0.1

namespace eval jlib::ibb {

    variable inited 0
    variable xmlns
    set xmlns(ibb) "http://jabber.org/protocol/ibb"
    set xmlns(amp) "http://jabber.org/protocol/amp"

    jlib::si::registertransport $xmlns(ibb) $xmlns(ibb) 80  \
      [namespace current]::si_open   \
      [namespace current]::si_close
    
    jlib::disco::registerfeature $xmlns(ibb)

    # Note: jlib::ensamble_register is last in this file!
}

# jlib::ibb::init --
# 
#       Sets up jabberlib handlers and makes a new instance if an ibb object.
  
proc jlib::ibb::init {jlibname args} {

    #puts "jlib::ibb::init"
    
    variable inited
    variable xmlns
    
    if {!$inited} {
	InitOnce
    }    

    # Keep different state arrays for initiator (i) and target (t).
    namespace eval ${jlibname}::ibb {
	variable priv
	variable opts
	variable istate
	variable tstate
    }
    upvar ${jlibname}::ibb::priv  priv
    upvar ${jlibname}::ibb::opts  opts
    
    array set opts {
	-block-size     4096
    }
    array set opts $args
    
    # Each base64 byte takes 6 bits; need to translate to binary bytes.
    set binblock [expr {(6 * $opts(-block-size))/8}]
    set priv(binblock) [expr {6 * ($binblock/6)}]
    
    # Register some standard iq handlers that is handled internally.
    $jlibname iq_register    set $xmlns(ibb) [namespace current]::handle_set
    $jlibname message_register * $xmlns(ibb) [namespace current]::message_handler

    return
}

proc jlib::ibb::InitOnce { } {
    
    variable ampElem
    variable inited
    variable xmlns
    
    set rule1 [wrapper::createtag "rule"   \
      -attrlist {condition deliver-at value stored action error}]
    set rule2 [wrapper::createtag "rule"   \
      -attrlist {condition match-resource value exact action error}]
    set ampElem [wrapper::createtag "amp"  \
      -attrlist [list xmlns $xmlns(amp)]   \
      -subtags [list $rule1 $rule2]]

    set inited 1
}

# jlib::ibb::cmdproc --
#
#       Just dispatches the command to the right procedure.
#
# Arguments:
#       jlibname:   the instance of this jlib.
#       cmd:        
#       args:       all args to the cmd procedure.
#       
# Results:
#       none.

proc jlib::ibb::cmdproc {jlibname cmd args} {
    
    # Which command? Just dispatch the command to the right procedure.
    return [eval {$cmd $jlibname} $args]
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# These are all functions to use by a initiator (sender).

# jlib::ibb::si_open, si_close --
# 
#       Bindings for si.

proc jlib::ibb::si_open {jlibname jid sid args} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_open (i)"
    
    set istate($sid,sid) $sid
    set istate($sid,jid) $jid
    set istate($sid,seq) 0
    set istate($sid,status) ""
    set si_open_cb [namespace current]::si_open_cb
    eval {send_open $jlibname $jid $sid $si_open_cb} $args
    return
}

proc jlib::ibb::si_open_cb {jlibname sid type subiq args} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_open_cb (i)"    
    
    # Since this is an async call we may have been reset.
    if {![info exists istate($sid,sid)]} {
	return
    }    
    jlib::si::transport_open_cb $jlibname $sid $type $subiq
    
    # If all went well this far we initiate the read/write data process.
    if {$type eq "result"} {
	
	# Tell the profile to prepare to read data (open file).
	jlib::si::open_data $jlibname $sid
	si_read $jlibname $sid
    }    
}

proc jlib::ibb::si_read {jlibname sid} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_read (i)"
    
    # Since this is an async call we may have been reset.
    if {![info exists istate($sid,sid)]} {
	return
    }    
    
    # We have been reset or something.
    if {$istate($sid,status) eq "close"} {
	return
    }
    set data [jlib::si::read_data $jlibname $sid]
    set len [string length $data]

    if {$len > 0} {
	si_send $jlibname $sid $data
    } else {
	
	# Empty data from the reader means that we are done.
	jlib::si::close_data $jlibname $sid
    }
}

proc jlib::ibb::si_send {jlibname sid data} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_send (i)"
    
    set jid $istate($sid,jid)
    send_data $jlibname $jid $sid $data [namespace current]::si_send_cb

    # Trick to avoid UI blocking.
    # @@@ We should have a method to detect if xmpp socket writable.
    after idle [list after 0 [list \
      [namespace current]::si_read $jlibname $sid]]
}

# jlib::ibb::si_send_cb --
# 
#       XEP says that we SHOULD track each mesage, in case of error.

proc jlib::ibb::si_send_cb {jlibname sid type subiq args} {

    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_send_cb (i)"
    
    # We get this async so we may have been reset or something.
    if {![info exists istate($sid,sid)]} {
	return
    }
    if {[string equal $type "error"]} {
	jlib::si::close_data $jlibname $sid error
	ifree $jlibname $sid
    }
}

# jlib::ibb::si_close --
# 
#       The profile closes us down. It could be a reset.

proc jlib::ibb::si_close {jlibname sid} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_close (i)"

    # Keep a status so we can stop sending messages right away.
    set istate($sid,status) "close"
    set jid $istate($sid,jid)
    set cmd [namespace current]::si_close_cb

    send_close $jlibname $jid $sid $cmd
}

# jlib::ibb::si_close_cb --
# 
#       This is our destructor that ends it all.

proc jlib::ibb::si_close_cb {jlibname sid type subiq args} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::si_close_cb (i)"

    set jid $istate($sid,jid)
    
    jlib::si::transport_close_cb $jlibname $sid $type $subiq
    ifree $jlibname $sid
}

proc jlib::ibb::ifree {jlibname sid} {
    
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::ifree (i)"   

    array unset istate $sid,*
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

proc jlib::ibb::configure {jlibname args} {
    
    upvar ${jlibname}::ibb::opts opts

    # @@@ TODO
    
}

# jlib::ibb::send_open --
# 
#       Initiates a file transport. We must be able to configure 'block-size'
#       from the file-transfer profile.
#
# Arguments:
# 

proc jlib::ibb::send_open {jlibname jid sid cmd args} {    
    variable xmlns
    upvar ${jlibname}::ibb::opts opts
    
    #puts "jlib::ibb::send_open (i)"
    
    array set arr [list -block-size $opts(-block-size)]
    array set arr $args
        
    set openElem [wrapper::createtag "open"  \
      -attrlist [list sid $sid block-size $arr(-block-size) xmlns $xmlns(ibb)]]
    jlib::send_iq $jlibname set [list $openElem] -to $jid  \
      -command [concat $cmd [list $jlibname $sid]]
    return
}

# jlib::ibb::send_data --
# 
# 

proc jlib::ibb::send_data {jlibname jid sid data cmd} {    
    variable xmlns
    variable ampElem
    upvar ${jlibname}::ibb::istate istate
    #puts "jlib::ibb::send_data (i) sid=$sid, cmd=$cmd"

    set jid $istate($sid,jid)
    set seq $istate($sid,seq)
    set edata [base64::encode $data]
    set dataElem [wrapper::createtag "data"  \
      -attrlist [list xmlns $xmlns(ibb) sid $sid seq $seq]  \
      -chdata $edata]
    set istate($sid,seq) [expr {($seq + 1) % 65536}]

    jlib::send_message $jlibname $jid -xlist [list $dataElem $ampElem]  \
      -command [concat $cmd [list $jlibname $sid]]
}

# jlib::ibb::send_close --
# 
#       Sends the close tag.
#
# Arguments:
# 

proc jlib::ibb::send_close {jlibname jid sid cmd} {    
    variable xmlns
    #puts "jlib::ibb::send_close (i)"

    set closeElem [wrapper::createtag "close"  \
      -attrlist [list sid $sid xmlns $xmlns(ibb)]]
    jlib::send_iq $jlibname set [list $closeElem] -to $jid  \
      -command [concat $cmd [list $jlibname $sid]]
    return
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# These are all functions to use by a target (receiver) of a stream.

# jlib::ibb::handle_set --
# 
#       Parse incoming ibb iq-set open/close element.
#       It is being assumed that we already have accepted a stream initiation.

proc jlib::ibb::handle_set {jlibname from subiq args} {

    variable xmlns
    upvar ${jlibname}::ibb::tstate tstate
    
    #puts "jlib::ibb::handle_set (t)"
    
    set tag [wrapper::gettag $subiq]
    array set attr [wrapper::getattrlist $subiq]
    array set argsArr $args
    if {![info exists argsArr(-id)] || ![info exists attr(sid)]} {
	# We can't do more here.
	return 0
    }
    set sid $attr(sid)
    
    # We make sure that we have already got a si with this sid.
    if {![jlib::si::havesi $jlibname $sid]} {
	send_error $jlibname $from $argsArr(-id) $sid 404 cancel item-not-found
	return 1
    }

    switch -- $tag {
	open {
	    if {![info exists attr(block-size)]} {
		# @@@ better stanza!
		send_error $jlibname $from $argsArr(-id) $sid 501 cancel  \
		  feature_not_implemented
		return
	    }
	    set tstate($sid,sid)        $sid
	    set tstate($sid,jid)        $from
	    set tstate($sid,block-size) $attr(block-size)
	    set tstate($sid,seq)        0
	    
	    # Make a success response on open.
	    jlib::send_iq $jlibname "result" {} -to $from -id $argsArr(-id)
	}
	close {
	    
	    # Make a success response on close.
	    jlib::send_iq $jlibname "result" {} -to $from -id $argsArr(-id)
	    jlib::si::stream_closed $jlibname $sid
	    tfree $jlibname $sid
	}
	default {
	    return 0
	}
    }
    return 1
}

# jlib::ibb::message_handler --
# 
#       Message handler for incoming http://jabber.org/protocol/ibb elements.

proc jlib::ibb::message_handler {jlibname ns msgElem args} {

    variable xmlns
    upvar ${jlibname}::ibb::tstate tstate
    
    array set argsArr $args
    #puts "jlib::ibb::message_handler (t) ns=$ns"
    
    set jid [wrapper::getattribute $msgElem "from"]
    
    # Pack up the data and deliver to si.
    set dataElems [wrapper::getchildswithtagandxmlns $msgElem data $xmlns(ibb)]
    foreach dataElem $dataElems {
	array set attr [wrapper::getattrlist $dataElem]
	set sid $attr(sid)
	set seq $attr(seq)
		
	# We make sure that we have already got a si with this sid.
	# Since there can be many of these, reply with error only to first.
	if {![jlib::si::havesi $jlibname $sid]  \
	  || ![info exists tstate($sid,sid)]} {
	    if {[info exists argsArr(-id)]} {
		set id $argsArr(-id)
		jlib::send_message_error $jlibname $jid $id 404 cancel  \
		  item-not-found
	    }
	    return 1
	}
	
	# Check that no packets have been lost.
	if {$seq != $tstate($sid,seq)} {
	    if {[info exists argsArr(-id)]} {
		#puts "\t seq=$seq, expectseq=$expectseq"
		set id $argsArr(-id)
		jlib::send_message_error $jlibname $jid $id 400 cancel  \
		  bad-request
	    }
	    return 1
	}
	
	set encdata [wrapper::getcdata $dataElem]
	if {[catch {
	    set data [base64::decode $encdata]
	}]} {
	    if {[info exists argsArr(-id)]} {
		jlib::send_message_error $jlibname $jid $id 400 cancel bad-request
	    }
	    return 1
	}
	
	# Next expected 'seq'.
	set tstate($sid,seq) [expr {($seq + 1) % 65536}]

	# Deliver to si for further processing.
	jlib::si::stream_recv $jlibname $sid $data
    }
    return 1
}

proc jlib::ibb::send_error {jlibname jid id sid errcode errtype stanza} {

    jlib::send_iq_error $jlibname $jid $id $errcode $errtype $stanza    
    tfree $jlibname $sid
}

proc jlib::ibb::tfree {jlibname sid} {
    
    upvar ${jlibname}::ibb::tstate tstate
    #puts "jlib::ibb::tfree (t)"   

    array unset tstate $sid,*
}

# We have to do it here since need the initProc before doing this.

namespace eval jlib::ibb {

    jlib::ensamble_register ibb   \
      [namespace current]::init   \
      [namespace current]::cmdproc
}

#-------------------------------------------------------------------------------
