#  socks5.tcl ---
#
#      Package for using the SOCKS5 method for connecting TCP sockets.
#      Some code plus idee from Kerem 'Waster_' HADIMLI.
#      Made from RFC 1928.
#
#  Copyright (c) 2000  Kerem 'Waster_' HADIMLI (minor parts)
#  Copyright (c) 2003-2007  Mats Bengtsson
#  Modifications Copyright (c) 2007 Sergei Golovan <sgolovan@nes.ru>
#
#  This source file is distributed under the BSD license.
#
# $Id: socks5.tcl 1282 2007-10-26 17:40:59Z sergei $
#
# TODO:  GSSAPI authentication which is a MUST is missing.
#        Only CMD CONNECT implemented.
#        Do not report English text in callback but rather error keys like
#        rsp_notallowed etc. Client done, server to go.

package require autoconnect 0.2

package provide autoconnect::socks5 1.0

namespace eval socks5 {
    namespace export connect

    # Constants:
    # ver:                Socks version
    # nomatchingmethod:   No matching methods
    # cmd_connect:        Connect command
    # rsv:                Reserved
    # atyp_*:             Address type
    # auth_*:             Authorication version
    variable const
    array set const {
	ver                 \x05
	auth_no             \x00
	auth_gssapi         \x01
	auth_userpass       \x02
	nomatchingmethod    \xFF
	cmd_connect         \x01
	cmd_bind            \x02
	rsv                 \x00
	atyp_ipv4           \x01
	atyp_domainname     \x03
	atyp_ipv6           \x04
	rsp_succeeded       \x00
	rsp_failure         \x01
	rsp_notallowed      \x02
	rsp_netunreachable  \x03
	rsp_hostunreachable \x04
	rsp_refused         \x05
	rsp_expired         \x06
	rsp_cmdunsupported  \x07
	rsp_addrunsupported \x08
    }

    # Practical when mapping errors to error codes.
    variable iconst
    array set iconst {
	0    rsp_succeeded
	1    rsp_failure
	2    rsp_notallowed
	3    rsp_netunreachable
	4    rsp_hostunreachable
	5    rsp_refused
	6    rsp_expired
	7    rsp_cmdunsupported
	8    rsp_addrunsupported
    }

    variable ipv4_num_re {([0-9]{1,3}\.){3}[0-9]{1,3}}
    variable ipv6_num_re {([0-9a-fA-F]{4}:){7}[0-9a-fA-F]{4}}

    variable msg
    array set msg {
	1 "General SOCKS server failure"
	2 "Connection not allowed by ruleset"
	3 "Network unreachable"
	4 "Host unreachable"
	5 "Connection refused"
	6 "TTL expired"
	7 "Command not supported"
	8 "Address type not supported"
    }

    variable debug 0

    autoconnect::register socks5 [namespace current]::connect
}

# socks5::connect --
#
#       Negotiates with a SOCKS server.
#
# Arguments:
#       sock:       an open socket token to the SOCKS server
#       addr:       the peer address, not SOCKS server
#       port:       the peer's port number
#       args:
#               -command    tclProc {status socket}
#               -username   username
#               -password   password
#               -timeout    millisecs (default 60000)
#
# Results:
#       The connect socket or error if no -command, else empty string.
#
# Side effects:
#	Socket is prepared for data transfer.
#	If -command specified, the callback tclProc is called with
#	status OK and socket or ERROR and error message.

proc socks5::connect {sock addr port args} {
    variable msg
    variable const

    Debug 2 "socks5::init $addr $port $args"

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.

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

    array set state {
	-password         ""
	-timeout          60000
	-username         ""
	async             0
	auth              0
	bnd_addr          ""
	bnd_port          ""
	state             ""
	status            ""
    }
    array set state [list     \
      addr          $addr     \
      port          $port     \
      sock          $sock]
    array set state $args

    if {[string length $state(-username)] ||  \
      [string length $state(-password)]} {
	set state(auth) 1
    }
    if {[info exists state(-command)] && [string length $state(-command)]} {
	set state(async) 1
    }
    if {$state(auth)} {
	set methods  "$const(auth_no)$const(auth_userpass)"
    } else {
	set methods  "$const(auth_no)"
    }
    set nmethods [binary format c [string length $methods]]

    fconfigure $sock -translation {binary binary} -blocking 0
    fileevent $sock writable {}

    Debug 2 "\tsend: ver nmethods methods"

    # Request authorization methods
    if {[catch {
	puts -nonewline $sock "$const(ver)$nmethods$methods"
	flush $sock
    } err]} {
	catch {close $sock}
	if {$state(async)} {
	    after idle [list $state(-command) ERROR network-failure]
	    Free $token
	    return
	} else {
	    Free $token
	    return -code error $err
	}
    }

    # Setup timeout timer.
    set state(timeoutid)  \
	[after $state(-timeout) [namespace current]::Timeout $token]

    fileevent $sock readable  \
	[list [namespace current]::ResponseMethod $token]

    if {$state(async)} {
	return
    } else {
	# We should not return from this proc until finished!
	vwait $token\(status)

	set status $state(status)
	set sock $state(sock)

	Free $token

	if {[string equal $status OK]} {
	    return $sock
	} else {
	    catch {close $sock}
	    return -code error $sock
	}
    }
}

# socks5::ResponseMethod --
#
#	Receive the reply from a proxy and choose authorization method.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	The negotiation is finished with error or continues with chosen
#	method.

proc socks5::ResponseMethod {token} {
    variable $token
    variable const
    upvar 0 $token state

    Debug 2 "socks5::ResponseMethod"

    set sock $state(sock)

    if {[catch {read $sock 2} data] || [eof $sock]} {
	Finish $token network-failure
	return
    }
    set serv_ver ""
    set method $const(nomatchingmethod)
    binary scan $data cc serv_ver smethod
    Debug 2 "\tserv_ver=$serv_ver, smethod=$smethod"

    if {![string equal $serv_ver 5]} {
	Finish $token err_version
	return
    }

    if {[string equal $smethod 0]} {
	# Now, request address and port.
	Request $token
    } elseif {[string equal $smethod 2]} {
	# User/Pass authorization required
	if {$state(auth) == 0} {
	    Finish $token err_authorization_required
	    return
	}

	# Username & Password length (binary 1 byte)
	set ulen [binary format c [string length $state(-username)]]
	set plen [binary format c [string length $state(-password)]]

	Debug 2 "\tsend: auth_userpass ulen -username plen -password"
	if {[catch {
	    puts -nonewline $sock  \
		"$const(auth_userpass)$ulen$state(-username)$plen$state(-password)"
	    flush $sock
	} err]} {
	    Finish $token network-failure
	    return
	}

	fileevent $sock readable  \
	    [list [namespace current]::ResponseAuth $token]
    } else {
	Finish $token err_unsupported_method
    }
    return
}

# socks5::ResponseAuth --
#
#	Receive the authorization reply from a proxy.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	The negotiation is finished with error or continues with address and
#	port request.

proc socks5::ResponseAuth {token} {
    variable $token
    upvar 0 $token state

    Debug 2 "socks5::ResponseAuth"

    set sock $state(sock)

    if {[catch {read $sock 2} data] || [eof $sock]} {
	Finish $token network-failure
	return
    }

    set auth_ver -1
    set status -1
    binary scan $data cc auth_ver status
    Debug 2 "\tauth_ver=$auth_ver, status=$status"

    if {![string equal $auth_ver 1]} {
	Finish $token err_authentication_unsupported
	return
    }
    if {![string equal $status 0]} {
	Finish $token err_authorization
	return
    }

    # Now, request address and port.
    Request $token
    return
}

# socks5::Request --
#
#	Request connect to specified address and port.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	The negotiation is finished with error or continues with address and
#	port request.

proc socks5::Request {token} {
    variable $token
    variable const
    variable ipv4_num_re
    variable ipv6_num_re
    upvar 0 $token state

    Debug 2 "socks5::Request"

    set sock $state(sock)

    # Network byte-ordered port (2 binary-bytes, short)
    set bport [binary format S $state(port)]

    # Figure out type of address given to us.
    if {[regexp $ipv4_num_re $state(addr)]} {
	Debug 2 "\tipv4"

	# IPv4 numerical address.
	set atyp_addr_port $const(atyp_ipv4)
    	foreach i [split $state(addr) .] {
	    append atyp_addr_port [binary format c $i]
	}
	append atyp_addr_port $bport
    } elseif {[regexp $ipv6_num_re $state(addr)]} {
	# todo
    } else {
	Debug 2 "\tdomainname"

	# Domain name.
	# Domain length (binary 1 byte)
	set dlen [binary format c [string length $state(addr)]]
	set atyp_addr_port \
	  "$const(atyp_domainname)$dlen$state(addr)$bport"
    }

    # We send request for connect
    Debug 2 "\tsend: ver cmd_connect rsv atyp_domainname dlen addr port"
    set aconst "$const(ver)$const(cmd_connect)$const(rsv)"
    if {[catch {
	puts -nonewline $sock "$aconst$atyp_addr_port"
	flush $sock
    } err]} {
	Finish $token network-failure
	return
    }

    fileevent $sock readable  \
	[list [namespace current]::Response $token]
    return
}

# socks5::Response --
#
#	Receive the final reply from a proxy and finish the negotiations.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	The negotiation is finished with either success or error.

proc socks5::Response {token} {
    variable $token
    upvar 0 $token state
    variable iconst

    Debug 2 "socks5::Response"

    set sock $state(sock)
    fileevent $sock readable {}

    # Start by reading ver+cmd+rsv.
    if {[catch {read $sock 3} data] || [eof $sock]} {
	Finish $token network-failure
	return
    }
    set serv_ver ""
    set rep ""
    binary scan $data ccc serv_ver rep rsv

    if {![string equal $serv_ver 5]} {
	Finish $token err_version
	return
    }
    if {$rep == 0} {
	# OK
    } elseif {[info exists iconst($rep)]} {
	Finish $token $iconst($rep)
	return
    } else {
	Finish $token err_unknown
	return
    }

    # Now parse the variable length atyp+addr+host.
    if {[catch {ParseAtypAddr $token addr port} err]} {
	Finish $token $err
	return
    }

    # Store in our state array.
    set state(bnd_addr) $addr
    set state(bnd_port) $port

    # And finally let the client know that the bytestream is set up.
    Finish $token
    return
}

# socks5::ParseAtypAddr --
#
#	Receive and parse destination address type and IP or name.
#
# Arguments:
#	token	    A connection token.
#	addrVar	    A variable for destination address.
#	portVar	    A variable for destination port.
#
# Result:
#	An empty string or error if address and port can't be parsed.
#
# Side effects:
#	The address type and IP or name is read from the socket.

proc socks5::ParseAtypAddr {token addrVar portVar} {
    variable $token
    variable const
    upvar 0 $token state
    upvar $addrVar addr
    upvar $portVar port

    Debug 2 "socks5::ParseAtypAddr"

    set sock $state(sock)

    # Start by reading atyp.
    if {[catch {read $sock 1} data] || [eof $sock]} {
	return -code error network-failure
    }
    set atyp ""
    binary scan $data c atyp
    Debug 2 "\tatyp=$atyp"

    # Treat the three address types in order.
    switch -- $atyp {
	1 {
	    if {[catch {read $sock 6} data] || [eof $sock]} {
		return -code error network-failure
	    }
	    binary scan $data ccccS i0 i1 i2 i3 port
	    set addr ""
	    foreach n [list $i0 $i1 $i2 $i3] {
		# Translate to unsigned!
		append addr [expr ( $n + 0x100 ) % 0x100]
		if {$n <= 2} {
		    append addr .
		}
	    }
	    # Translate to unsigned!
	    set port [expr ( $port + 0x10000 ) % 0x10000]
	}
	3 {
	    if {[catch {read $sock 1} data] || [eof $sock]} {
		return -code error network-failure
	    }
	    binary scan $data c len
	    Debug 2 "\tlen=$len"
	    set len [expr ( $len + 0x100 ) % 0x100]
	    if {[catch {read $sock $len} data] || [eof $sock]} {
		return -code error network-failure
	    }
	    set addr $data
	    Debug 2 "\taddr=$addr"
	    if {[catch {read $sock 2} data] || [eof $sock]} {
		return -code error network-failure
	    }
	    binary scan $data S port
	    # Translate to unsigned!
	    set port [expr ( $port + 0x10000 ) % 0x10000]
	    Debug 2 "\tport=$port"
	}
	4 {
	    # todo
	}
	default {
	    return -code error err_unknown_address_type
	}
    }
}

proc socks5::GetIpAndPort {token} {
    variable $token
    upvar 0 $token state
    return [list $state(bnd_addr) $state(bnd_port)]
}

# socks5::Timeout --
#
#	This proc is called in case of timeout.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	A proxy negotiation is finished with error.

proc socks5::Timeout {token} {
    Finish $token timeout
    return
}

# socks5::Free --
#
#	Frees a connection token.
#
# Arguments:
#	token	    A connection token.
#
# Result:
#	An empty string.
#
# Side effects:
#	A connection token and its state informationa are destroyed.

proc socks5::Free {token} {
    variable $token
    upvar 0 $token state

    catch {after cancel $state(timeoutid)}
    catch {unset state}
}

# socks5::Finish --
#
#	Finishes a negotiation process.
#
# Arguments:
#	token	    A connection token.
#	errormsg    (optional) error message.
#
# Result:
#	An empty string.
#
# Side effects:
#	If connection is asynchronous then a callback is executed.
#	Otherwise state(status) is set to allow https::connect to return
#	with either success or error.

proc socks5::Finish {token {errormsg ""}} {
    variable $token
    upvar 0 $token state

    Debug 2 "socks5::Finish errormsg=$errormsg"

    catch {after cancel $state(timeoutid)}

    if {$state(async)} {
	# In case of asynchronous connection we do the cleanup.
	if {[string length $errormsg]} {
	    catch {close $state(sock)}
	    uplevel #0 $state(-command) [list ERROR $errormsg]
	} else {
	    uplevel #0 $state(-command) [list OK $state(sock)]
	}
	Free $token
    } else {
	# Otherwise we trigger state(status).
	if {[string length $errormsg]} {
	    catch {close $state(sock)}
	    set state(sock) $errormsg
	    set state(status) ERROR
	} else {
	    set state(status) OK
	}
    }
    return
}

# socks5::serverinit --
#
#       The SOCKS5 server. Negotiates with a SOCKS5 client.
#       Sets up bytestreams between client and DST.
#
# Arguments:
#       sock:       socket connected to the servers socket
#       ip:         ip address
#       port:       it's port number
#       command:    tclProc for callabcks {token type args}
#       args:
#               -blocksize     bytes
#               -bytestream    boolean
#               -opendstsocket boolean
#               -timeout       millisecs
#
# Results:
#       token.

proc socks5::serverinit {sock ip port command args} {
    variable msg
    variable const

    Debug 2 "socks5::serverinit"

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.

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

    array set state {
	-blocksize        8192
	-bytestream       1
	-opendstsocket    1
	-timeout          60000
	auth              0
	state             ""
	status            ""
    }
    array set state [list        \
      command       $command     \
      sock          $sock]
    array set state $args

    fconfigure $sock -translation {binary binary} -blocking 0
    fileevent $sock writable {}

    # Start by reading the method stuff.
    if {[catch {read $sock 2} data] || [eof $sock]} {
	serv_finish $token network-failure
	return
    }
    set ver ""
    set method $const(nomatchingmethod)
    binary scan $data cc ver nmethods
    set nmethods [expr ( $nmethods + 0x100 ) % 0x100]
    Debug 2 "\tver=$ver, nmethods=$nmethods"

    # Error checking. Must have either noauth or userpasswdauth.
    if {![string equal $ver 5]} {
	serv_finish $token "Socks server isn't version 5!"
	return
    }
    for {set i 0} {$i < $nmethods} {incr i} {
	if {[catch {read $sock 1} data] || [eof $sock]} {
	    serv_finish $token network-failure
	    return
	}
	binary scan $data c method
	set method [expr ( $method + 0x100 ) % 0x100]
	Debug 2 "\tmethod=$method"
	if {[string equal $method 0]} {
	    set noauthmethod 1
	} elseif {[string equal $method 2]} {
	    set userpasswdmethod 1
	}
    }
    set isok 1
    if {[info exists userpasswdmethod]} {
	set ans "$const(ver)$const(auth_userpass)"
	set state(auth) 1
    } elseif {[info exists noauthmethod]} {
	set ans "$const(ver)$const(auth_no)"
    } else {
	set ans "$const(ver)$const(nomatchingmethod)"
	set isok 0
    }

    Debug 2 "\tsend: ver method"
    if {[catch {
	puts -nonewline $sock $ans
	flush $sock
    } err]} {
	serv_finish $token $err
	return
    }
    if {!$isok} {
	serv_finish $token "Unrecognized method requested by client"
	return
    }

    if {$state(auth)} {
	fileevent $sock readable  \
	  [list [namespace current]::serv_auth $token]
    } else {
	fileevent $sock readable  \
	  [list [namespace current]::serv_request $token]
    }
    return $token
}

proc socks5::serv_auth {token} {
    variable $token
    variable const
    upvar 0 $token state

    Debug 2 "socks5::serv_auth"

    set sock $state(sock)
    fileevent $sock readable {}

    if {[catch {read $sock 2} data] || [eof $sock]} {
	serv_finish $token network-failure
	return
    }
    set auth_ver ""
    set method $const(nomatchingmethod)
    binary scan $data cc auth_ver ulen
    set ulen [expr ( $ulen + 0x100 ) % 0x100]
    Debug 2 "\tauth_ver=$auth_ver, ulen=$ulen"
    if {![string equal $auth_ver 2]} {
	serv_finish $token "Wrong authorization method"
	return
    }
    if {[catch {read $sock $ulen} data] || [eof $sock]} {
	return -code error network-failure
    }
    set state(username) $data
    Debug 2 "\tusername=$data"
    if {[catch {read $sock 1} data] || [eof $sock]} {
	serv_finish $token network-failure
	return
    }
    binary scan $data c plen
    set plen [expr ( $plen + 0x100 ) % 0x100]
    Debug 2 "\tplen=$plen"
    if {[catch {read $sock $plen} data] || [eof $sock]} {
	serv_finish $token network-failure
	return
    }
    set state(password) $data
    Debug 2 "\tpassword=$data"

    set ans [uplevel #0 $state(command) [list $token authorize \
      -username $state(username) -password $state(password)]]
    if {!$ans} {
	catch {
	    puts -nonewline $state(sock) "\x00\x01"
	}
	serv_finish $token notauthorized
	return
    }

    # Write auth response.
    if {[catch {
	puts -nonewline $sock "\x01\x00"
	flush $sock
    } err]} {
	serv_finish $token $err
	return
    }
    fileevent $sock readable  \
      [list [namespace current]::serv_request $token]
}

proc socks5::serv_request {token} {
    variable $token
    variable const
    variable msg
    variable ipv4_num_re
    variable ipv6_num_re
    upvar 0 $token state

    Debug 2 "socks5::serv_request"

    set sock $state(sock)

    # Start by reading ver+cmd+rsv.
    if {[catch {read $sock 3} data] || [eof $sock]} {
	serv_finish $token network-failure
	return
    }
    set ver ""
    set cmd ""
    set rsv ""
    binary scan $data ccc ver cmd rsv
    Debug 2 "\tver=$ver, cmd=$cmd, rsv=$rsv"

    if {![string equal $ver 5]} {
	serv_finish $token "Socks server isn't version 5!"
	return
    }
    if {![string equal $cmd 1]} {
	serv_finish $token "Unsuported CMD, must be CONNECT"
	return
    }

    # Now parse the variable length atyp+addr+host.
    if {[catch {ParseAtypAddr $token addr port} err]} {
	serv_finish $token $err
	return
    }

    # Store in our state array.
    set state(dst_addr) $addr
    set state(dst_port) $port

    # Init the SOCKS connection to dst if wanted. Else???
    if {$state(-opendstsocket)} {
	if {[catch {socket -async $addr $port} sock_dst]} {
	    serv_finish $token network-failure
	    return
	}
	set state(sock_dst) $sock_dst

	# Setup timeout timer.
	set state(timeoutid)  \
	  [after $state(-timeout) [namespace current]::ServTimeout $token]
	fileevent $sock_dst writable  \
	  [list [namespace current]::serv_dst_connect $token]
    } else {

	# ???
	uplevel #0 $state(command) [list $token reply]
    }
}

proc socks5::serv_dst_connect {token} {
    variable $token
    upvar 0 $token state

    Debug 2 "socks5::serv_dst_connect"
    fileevent $state(sock_dst) writable {}
    after cancel $state(timeoutid)

    set sock_dst $state(sock_dst)
    if {[eof $sock_dst]} {
	serv_finish $token network-failure
	return
    }

    if {[catch {
	fconfigure $sock_dst -translation {binary binary} -blocking 0
	foreach {bnd_ip bnd_addr bnd_port} [fconfigure $sock_dst -sockname] \
	  break
    } err]} {
	Debug 2 "\tfconfigure failed: $err"
	serv_finish $token network-failure
	return
    }
    array set state [list bnd_ip $bnd_ip bnd_addr $bnd_addr bnd_port $bnd_port]
    serv_reply $token
}

proc socks5::serv_reply {token} {
    variable $token
    variable const
    upvar 0 $token state

    Debug 2 "socks5:serv_reply"
    set sock $state(sock)
    set bnd_addr $state(bnd_addr)
    set bnd_port $state(bnd_port)
    Debug 2 "\tbnd_addr=$bnd_addr, bnd_port=$bnd_port"

    set aconst "$const(ver)$const(rsp_succeeded)$const(rsv)"

    # Domain length (binary 1 byte)
    set dlen [binary format c [string length $bnd_addr]]

    # Network byte-ordered port (2 binary-bytes, short)
    set bport [binary format S $bnd_port]
    set atyp_addr_port \
      "$const(atyp_domainname)$dlen$bnd_addr$bport"

    # We send SOCKS server's reply to client.
    Debug 2 "\tsend: ver rep rsv atyp_domainname dlen bnd_addr bnd_port"
    if {[catch {
	puts -nonewline $sock "$aconst$atyp_addr_port"
	flush $sock
    } err]} {
	serv_finish $token $err
	return
    }

    # New we are ready to stream data if wanted.
    if {$state(-bytestream)} {
	establish_bytestreams $token
    } else {
	# ???
	serv_finish $token
    }
}

proc socks5::establish_bytestreams {token} {
    variable $token
    upvar 0 $token state

    Debug 2 "socks5::establish_bytestreams"
    set sock $state(sock)
    set sock_dst $state(sock_dst)

    # Forward client stream to dst.
    fileevent $sock readable  \
      [list [namespace current]::read_stream $token $sock $sock_dst]

    # Forward dst stream to client.
    fileevent $sock_dst readable  \
      [list [namespace current]::read_stream $token $sock_dst $sock]
}

proc socks5::read_stream {token in out} {
    variable $token
    upvar 0 $token state

    set primary [string equal $state(sock) $in]
    Debug 3 "::socks5::read_stream primary=$primary: in=$in, out=$out"

    # If any of client (sock) or dst (sock_dst) closes down we shall
    # close down everthing.
    # Only client or dst can determine if a close down is premature.

    if {[catch {eof $in} iseof] || $iseof} {
	serv_finish $token
    } elseif {[catch {eof $out} iseof] || $iseof} {
	serv_finish $token
    } elseif {[catch {read $in} data]} {
	serv_finish $token network-failure
    } else {

	# We could wait here (in the event loop) for channel to be writable
	# to avoid any blocking...
	# BUT, this would keep $data in memory for a while which is a bad idee.
	if {0} {
	    fileevent $out writable  \
	      [list [namespace current]::stream_writeable $token $primary]
	    vwait $token\(writetrigger${primary})
	}
	if {[catch {puts -nonewline $out $data; flush $out}]} {
	    serv_finish $token network-failure
	}
    }
}

proc socks5::stream_writeable {token primary} {
    variable $token
    upvar 0 $token state

    incr state(writetrigger${primary})
}

proc socks5::serv_finish {token {errormsg ""}} {
    variable $token
    upvar 0 $token state

    Debug 2 "socks5::serv_finish"
    if {$state(-bytestream)} {
	catch {close $state(sock)}
	catch {close $state(sock_dst)}
    }
    if {[string length $errormsg]} {
	uplevel #0 $state(command) [list $token $errormsg]
    } else {
	uplevel #0 $state(command) [list $token ok]
    }
    unset state
}

#       Just a trigger for vwait.

proc socks5::readable {token} {
    variable $token
    upvar 0 $token state

    incr state(trigger)
}

proc socks5::ServTimeout {token} {
    variable $token
    upvar 0 $token state

    serv_finish $token timeout
}

proc socks5::Debug {num str} {
    variable debug
    if {$num <= $debug} {
	puts $str
    }
}

# Test code...

if {0} {

    # Server
    proc serv_cmd {token status} {
	puts "server: token=$token, status=$status"
	switch -- $status {
	    ok {

	    }
	    authorize {
		# Here we should check that the username and password is ok.
		return 1
	    }
	    default {
		puts "error $status"
	    }
	}
    }
    proc server_connect {sock ip port} {
	fileevent $sock readable  \
	  [list socks5::serverinit $sock $ip $port serv_cmd]
    }
    socket -server server_connect 1080
}

if {0} {
    # Client
    proc cb {status socket} {
	puts "client: status=$status, socket=$socket"
	if {$status eq "OK"} {
	    fconfigure $socket -buffering none
	    close $socket
	}
    }
    proc dump {} {
	puts "dump:"
    }
    set s [socket 192.168.0.1 1080]
    #socks5::connect $s jabber.ru 5222 -command cb
    socks5::connect $s jabber.ru 5222 -command cb -username xxx -password xxx
}

