#  jlibcompress.tcl --
#  
#      This file is part of the jabberlib. It provides support for the
#      compressed jabber stream.
#      
#  Copyright (c) 2005 Sergei Golovan <sgolovan@nes.ru>
#  
# $Id: jlibcompress.tcl 1488 2008-08-25 10:14:35Z sergei $
#
# SYNOPSIS
#   jlibcompress::new connid args
#	creates auth token
#	args: -command callback
#
#   token configure args
#	configures token parameters
#	args: the same as in jlibcompress::new
#
#   token start args
#	starts COMPRESS procedure
#	args: the same as in jlibcompress::new
#
#   token free
#	frees token resourses

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

package require zlib 1.0
package require namespaces 1.0

package provide jlibcompress 1.0

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

namespace eval jlibcompress {
    variable uid 0
    variable supported_methods {zlib}

    foreach {lcode type cond description} [list \
	409 modify setup-failed		[::msgcat::mc "Compression setup failed"] \
	409 modify unsupported-method	[::msgcat::mc "Unsupported compression method"]] \
    {
	stanzaerror::register_error $lcode $type $cond $description
    }
}

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

proc jlibcompress::new {connid args} {
    variable uid

    set token [namespace current]::[incr uid]
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::new $connid) $token"

    set state(-connid) $connid

    proc $token {cmd args} \
	"eval {[namespace current]::\$cmd} {$token} \$args"

    eval [list configure $token] $args

    jlib::register_xmlns $state(-connid) $::NS(fcompress) \
	[namespace code [list parse $token]]
    jlib::register_xmlns $state(-connid) $::NS(compress) \
	[namespace code [list parse $token]]

    return $token
}

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

proc jlibcompress::free {token} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::free $token)"

    jlib::unregister_xmlns $state(-connid) $::NS(fcompress)
    jlib::unregister_xmlns $state(-connid) $::NS(compress)

    catch { unset state }
    catch { rename $token "" }
}

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

proc jlibcompress::configure {token args} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::configure $token)"

    foreach {key val} $args {
	switch -- $key {
	    -command {
		set state($key) $val
	    }
	    default {
		return -code error "Illegal option \"$key\""
	    }
	}
    }
}

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

proc jlibcompress::parse {token xmldata} {
    variable $token
    upvar 0 $token state

    jlib::wrapper:splitxml $xmldata tag vars isempty cdata children

    switch -- $tag {
	compression {
	    set methods {}
	    foreach child $children {
		jlib::wrapper:splitxml $child tag1 vars1 isempty1 cdata1 children1
		if {$tag1 == "method"} {
		    lappend methods $cdata1
		}
	    }
	    set state(-methods) $methods
	}
	compressed {
	    compressed $token
	}
	failure {
	    failure $token $children
	}
    }
}

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

proc jlibcompress::start {token args} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::start $token)"

    eval [list configure $token] $args

    jlib::trace_stream_features $state(-connid) \
	[namespace code [list continue $token]]
}

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

proc jlibcompress::continue {token} {
    variable supported_methods
    variable $token
    upvar 0 $token state
    
    ::LOG "(jlibcompress::continue $token)"

    if {![info exists state(-methods)]} {
	set err [stanzaerror::error modify not-acceptable -text \
		     [::msgcat::mc \
			  "Server haven't provided compress feature"]]
	finish $token ERR [concat modify $err]
	return
    } else {
	catch { unset state(-method) }
	foreach m $supported_methods {
	    if {[lcontain $state(-methods) $m]} {
		set state(-method) $m
		break
	    }
	    if {![info exists state(-method)]} {
		set err [stanzaerror::error modify not-acceptable \
			     -text [::msgcat::mc \
				  "Server haven't provided supported\
				   compress method"]]
		finish $token ERR [concat modify $err]
		return
	    }
	}
    }

    set data [jlib::wrapper:createtag compress \
		  -vars [list xmlns $::NS(compress)] \
		  -subtags [list [jlib::wrapper:createtag method \
				      -chdata $state(-method)]]]
    
    jlib::outmsg [jlib::wrapper:createxml $data] -connection $state(-connid)
}

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

proc jlibcompress::failure {token children} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::failure $token)"

    set error [lindex $children 0]
    if {$error == ""} {
	set err [stanzaerror::error modify undefined-condition \
		     -text [::msgcat::mc "Compression negotiation failed"]]
    } else {
	jlib::wrapper:splitxml $error tag vars empty cdata children
	set err [stanzaerror::error modify $tag]
    }
    finish $token ERR [concat modify $err]
}

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

proc jlibcompress::compressed {token} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::proceed $token)"

    set transport $::jlib::lib($state(-connid),transport)

    jlib::transport::${transport}::to_compress $state(-connid) $state(-method)

    jlib::reset $state(-connid)

    jlib::start_stream [jlib::connection_server $state(-connid)] \
		       -xml:lang [jlib::get_lang] -version "1.0" \
		       -connection $state(-connid)
    finish $token OK {}
}

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

proc jlibcompress::finish {token res xmldata} {
    variable $token
    upvar 0 $token state

    ::LOG "(jlibcompress::finish $token) res"

    if {$res != "OK"} {
	jlib::client status [::msgcat::mc "Compression negotiation failed"]
    } else {
	jlib::client status [::msgcat::mc "Compression negotiation successful"]
    }
    if {[info exists state(-command)]} {
	uplevel #0 $state(-command) [list $res $xmldata]
    }
}

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

