# dtcp.tcl --
#
#       This file is a part of Jidlink Tkabber plugin. It implements
#       Direct TCP connection protocol.

namespace eval dtcp {}
namespace eval dtcp::active {}
namespace eval dtcp::passive {}

proc dtcp::load {} {
    jidlink::register_transport dtcp-active dtcp-passive 25 disabled \
                [namespace current]::active::connect \
                [namespace current]::active::send_data \
                [namespace current]::active::close

    ::xmpp::iq::register set query jabber:iq:dtcp \
                         [namespace current]::iq_set_handler

    jidlink::register_transport dtcp-passive dtcp-active 50 disabled \
                [namespace current]::passive::connect \
                [namespace current]::passive::send_data \
                [namespace current]::passive::close
}

proc dtcp::unload {} {
    #jidlink::unregister_transport dtcp-active

    ::xmpp::iq::unregister set query jabber:iq:dtcp

    #jidlink::unregister_transport dtcp-passive

    namespace delete [namespace current]
}

proc dtcp::active::connect {xlib jid key} {
    variable connection

    set_status [::msgcat::mc "Opening DTCP active connection"]

    ::xmpp::sendIQ $xlib set \
        -query [::xmpp::xml::create query \
                        -xmlns jabber:iq:dtcp \
                        -subelement [::xmpp::xml::create key \
                                            -cdata $key] \
                        -subelement [::xmpp::xml::create comment \
                                        -subelement [::xmpp::xml::create key \
                                                            -cdata $key]]] \
        -to $jid \
        -command [list [namespace current]::recv_connect_response \
                       $xlib $jid $key]

    vwait [namespace current]::connection(status,$key)
}

proc dtcp::active::recv_connect_response {xlib jid key status xml} {
    variable connection

    if {$status != "ok"} {
        # TODO
        set connection(status,$key) 0
        return
    }

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {$tag == "query"} {
        set hosts {}
        foreach item $subels {
            ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
            switch -- $stag {
                verify {
                    set verify $scdata
                    debugmsg jidlink "VERIFY: $verify"
                }
                host {
                    lappend hosts [list $scdata \
                                       [::xmpp::xml::getAttr $sattrs port]]
                }
            }
        }

        if {[info exists verify]} {
            variable verify_key
            variable key_verify

            set verify_key($verify) $key
            set key_verify($key) $verify

            set connection(xlib,$key) $xlib
            set connection(jid,$key) $jid

            foreach host $hosts {
                lassign $host addr port
                debugmsg jidlink "CONNECTING TO $addr:$port..."
                if {[catch {set sock \
                                [::pconnect::socket $addr $port \
                                        -proxyfilter ::proxy::proxyfilter]}]} {
                    continue
                }
                debugmsg jidlink "CONNECTED"
                fconfigure $sock -encoding binary
                set connection(sock,$key) $sock
                puts $sock "key:$key"
                flush $sock

                fileevent $sock readable \
                    [list [namespace current]::wait_for_verify $key $sock]
                return
            }

            debugmsg jidlink "FAILED"

            set connection(status,$key) 0
            return
        } else {
            # TODO
        }
    } else {
        # TODO
    }
    set connection(status,$key) 0
}

proc dtcp::active::sock_connect {key hosts} {
    variable connection
    variable verify_key
    variable key_verify


    foreach host $hosts {
        lassign $host addr port
        debugmsg jidlink "CONNECTING TO $addr:$port..."
        if {[catch {set sock [::pconnect::socket $addr $port \
                                    -proxyfilter ::proxy::proxyfilter]}]} {
            continue
        }
        debugmsg jidlink "CONNECTED"
        fconfigure $sock -encoding binary
        set connection(sock,$key) $sock
        puts $sock "key:$key"
        flush $sock

        fileevent $sock readable \
            [list [namespace current]::wait_for_verify $key $sock]
        return
    }

    debugmsg jidlink "FAILED"

    set connection(status,$key) 0

}

proc dtcp::active::send_data {key data} {
    variable connection
    variable key_stream

    puts -nonewline $connection(sock,$key) $data
    flush $connection(sock,$key)

    return 1
}

proc dtcp::active::close {key} {
    variable connection
    variable key_stream

    ::close $connection(sock,$key)
}


proc dtcp::active::wait_for_verify {key chan} {
    variable connection
    variable key_verify

    set s [gets $chan]
    debugmsg jidlink "WFV: [list $s]"

    if {[string range $s 0 6] == "verify:"} {
        set verify [string range $s 7 end]
        if {$verify == $key_verify($key)} {
            fconfigure $chan -translation binary -blocking no
            fileevent $chan readable \
                [list [namespace parent]::readable $key $chan]
            set connection(status,$key) 1
            return
        }
    }
    ::close $chan
    jidlink::closed $key
}

proc dtcp::passive::connect {xlib jid key} {
    variable connection

    set_status [::msgcat::mc "Opening DTCP passive connection"]

    set servsock [socket -server [list [namespace current]::accept $key] 0]
    lassign [fconfigure $servsock -sockname] addr hostname port
    set ip [::xmpp::ip $xlib]

    ::xmpp::sendIQ $xlib set \
        -query [::xmpp::xml::create query \
                        -xmlns jabber:iq:dtcp \
                        -subelement [::xmpp::xml::create key \
                                            -cdata $key] \
                        -subelement [::xmpp::xml::create host \
                                            -attrs [list port $port] \
                                            -cdata $ip] \
                        -subelement [::xmpp::xml::create comment \
                                        -subelement [::xmpp::xml::create key \
                                                            -cdata $key]]] \
        -to $jid \
        -command [list [namespace current]::recv_connect_response \
                       $xlib $jid $key]

    vwait [namespace current]::connection(status,$key)
}

proc dtcp::passive::recv_connect_response {xlib jid key status xml} {
    variable connection

    if {$status != "ok"} {
        # TODO
        set connection(status,$key) 0
        return
    }

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {$tag == "query"} {
        set hosts {}
        foreach item $subels {
            ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
            switch -- $stag {
                verify {
                    set verify $scdata
                    debugmsg jidlink "VERIFY: $verify"
                }
                host {
                    lappend hosts [list $scdata \
                                       [::xmpp::xml::getAttr $attrs port]]
                }
            }
        }

        if {[info exists verify]} {
            variable verify_key
            variable key_verify

            set verify_key($verify) $key
            set key_verify($key) $verify

            set connection(xlib,$key) $xlib
            set connection(jid,$key) $jid

            #set connection(status,$key) 1
            return
        } else {
            # TODO
        }
    } else {
        # TODO
    }
    set connection(status,$key) 0
}

proc dtcp::passive::send_data {key data} {
    variable connection
    variable key_stream

    puts -nonewline $connection(sock,$key) $data
    flush $connection(sock,$key)

    return 1
}

proc dtcp::passive::close {key} {
    variable connection
    variable key_stream

    ::close $connection(sock,$key)
}

proc dtcp::passive::accept {key chan addr port} {
    variable connection
    variable key_verify

    debugmsg jidlink "CONNECT FROM $addr:$port"

    set connection(sock,$key) $chan

    fileevent $chan readable \
        [list [namespace current]::wait_for_key $key $chan]
}

proc dtcp::passive::wait_for_key {key chan} {
    variable connection
    variable key_verify

    set s [gets $chan]

    if {[string range $s 0 3] == "key:"} {
        set key2 [string range $s 4 end]
        if {$key == $key2} {
            debugmsg jidlink [array get key_verify]
            puts $chan "verify:$key_verify($key)"
            flush $chan
            fconfigure $chan -translation binary -blocking no
            fileevent $chan readable \
                [list [namespace parent]::readable $key $chan]
            set connection(status,$key) 1
            return
        }
    }
    puts $chan error
    flush $chan
}

proc dtcp::readable {key chan} {
    if {![eof $chan]} {
        set buf [read $chan 4096]
        jidlink::recv_data $key $buf
    } else {
        fileevent $chan readable {}
        jidlink::closed $key
    }
}

proc dtcp::iq_set_handler {xlib from xml args} {
    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {$tag == "query"} {
        set hosts {}
        foreach item $subels {
            ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
            switch -- $stag {
                comment {
                    foreach sitem $ssubels {
                        ::xmpp::xml::split $sitem \
                                        sstag ssxmlns ssattrs sscdata sssubels
                        if {$sstag == "key"} {
                            set key $sscdata
                            debugmsg jidlink "KEY: $key"
                        }
                    }
                }
                key {
                    set key $scdata
                    debugmsg jidlink "KEY: $key"
                }
                host {
                    lappend hosts [list $scdata \
                                       [::xmpp::xml::getAttr $sattrs port]]
                }
            }
        }

        if {[info exists key]} {
            set verify [rand 1000000000]

            if {$hosts == {}} {
                variable passive::verify_key
                variable passive::key_verify
                set passive::verify_key($verify) $key
                set passive::key_verify($key) $verify

                set servsock \
                    [socket -server \
                         [list [namespace current]::passive::accept $key] 0]
                lassign [fconfigure $servsock -sockname] addr hostname port
                set ip [::xmpp::ip $xlib]


                set res [::xmpp::xml::create query \
                                -xmlns jabber:iq:dtcp \
                                -subelement [::xmpp::xml::create verify \
                                                    -cdata $verify] \
                                -subelement [::xmpp::xml::create host \
                                                    -attrs [list port $port] \
                                                    -cdata $ip]]
            } else {
                variable active::verify_key
                variable active::key_verify
                set active::verify_key($verify) $key
                set active::key_verify($key) $verify

                debugmsg jidlink [list $hosts]
                after idle [list [namespace current]::active::sock_connect \
                                 $key $hosts]
                set res [::xmpp::xml::create query \
                                -xmlns jabber:iq:dtcp \
                                -subelement [::xmpp::xml::create verify \
                                                    -cdata $verify]]
            }
            return [list result $res]
        } else {
            # TODO
        }
    } else {
        # TODO
    }
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
