--- /dev/null
+# socks4.tcl ---
+#
+# Package for using the SOCKS4a method for connecting TCP sockets.
+# Only client side.
+#
+# (c) 2007 Mats Bengtsson
+#
+# This source file is distributed under the BSD license.
+#
+# $Id: socks4.tcl,v 1.7 2007/01/17 08:54:55 matben Exp $
+
+package provide socks4 0.1
+
+namespace eval socks4 {
+
+ variable const
+ array set const {
+ ver \x04
+ cmd_connect \x01
+ cmd_bind \x02
+ rsp_granted \x5a
+ rsp_failure \x5b
+ rsp_errconnect \x5c
+ rsp_erruserid \x5d
+ }
+
+ # Practical when mapping errors to error codes.
+ variable iconst
+ array set iconst {
+ \x04 ver
+ \x01 cmd_connect
+ \x02 cmd_bind
+ \x5a rsp_granted
+ \x5b rsp_failure
+ \x5c rsp_errconnect
+ \x5c rsp_erruserid
+ }
+}
+
+# socks4::init --
+#
+# 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 {token status}
+# -username userid
+# -timeout millisecs
+#
+# Results:
+# token if -command, else ?.
+
+proc socks4::init {sock addr port args} {
+ variable const
+
+ set token [namespace current]::$sock
+ variable $token
+ upvar 0 $token state
+
+ array set state {
+ -command ""
+ -timeout 60000
+ -username ""
+ async 0
+ bnd_addr ""
+ bnd_port ""
+ trigger 0
+ }
+ array set state [list \
+ addr $addr \
+ port $port \
+ sock $sock]
+ array set state $args
+
+ if {[string length $state(-command)]} {
+ set state(async) 1
+ }
+
+ # Network byte-ordered port (2 binary-bytes, short)
+ set bport [binary format S $port]
+
+ # This corresponds to IP address 0.0.0.x, with x nonzero.
+ set bip \x00\x00\x00\x01
+
+ set bdata "$const(ver)$const(cmd_connect)$bport$bip"
+ append bdata "$state(-username)\x00$addr\x00"
+ fconfigure $sock -translation {binary binary} -blocking 0
+ fileevent $sock writable {}
+ if {[catch {
+ puts -nonewline $sock $bdata
+ flush $sock
+ } err]} {
+ return -code error network-failure
+ }
+
+ # Setup timeout timer. !async remains!
+ set state(timeoutid) \
+ [after $state(-timeout) [namespace current]::timeout $token]
+
+ if {$state(async)} {
+ fileevent $sock readable \
+ [list [namespace current]::response $token]
+ return $token
+ } else {
+
+ # We should not return from this proc until finished!
+ fileevent $sock readable \
+ [list [namespace current]::readable $token]
+ vwait $token\(trigger)
+ return [response $token]
+ }
+}
+
+proc socks4::response {token} {
+ variable $token
+ upvar 0 $token state
+ variable const
+ variable iconst
+
+ puts "socks4::response"
+
+ set sock $state(sock)
+ fileevent $sock readable {}
+
+ # Read and parse status.
+ if {[catch {read $sock 2} data] || [eof $sock]} {
+ finish $token network-failure
+ return
+ }
+ binary scan $data cc null status
+ if {![string equal $null \x00]} {
+ finish $token err_version
+ return
+ }
+ if {![string equal $status $const(rsp_granted)]} {
+ if {[info exists iconst($status)]} {
+ finish $token $iconst($status)
+ } else {
+ finish $token error
+ }
+ return
+ }
+
+ # Read and parse port (2 bytes) and ip (4 bytes).
+ if {[catch {read $sock 6} data] || [eof $sock]} {
+ finish $token network-failure
+ return
+ }
+ 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]
+ set state(bnd_port) $port
+ set state(bnd_addr) $addr
+
+ return [finish $token]
+}
+
+proc socks4::readable {token} {
+ variable $token
+ upvar 0 $token state
+ puts "socks4::readable"
+ incr state(trigger)
+}
+
+proc socks4::timeout {token} {
+ finish $token timeout
+}
+
+proc socks4::getipandport {token} {
+ variable $token
+ upvar 0 $token state
+ return [list $state(bnd_addr) $state(bnd_port)]
+}
+
+proc socks4::free {token} {
+ variable $token
+ upvar 0 $token state
+ catch {after cancel $state(timeoutid)}
+ unset -nocomplain state
+}
+
+proc socks4::finish {token {errormsg ""}} {
+ global errorInfo errorCode
+ variable $token
+ upvar 0 $token state
+
+ puts "socks4::finish token=$token, errormsg=$errormsg"
+ parray state
+
+ catch {after cancel $state(timeoutid)}
+
+ # In case of error we do the cleanup.
+ if {$state(async)} {
+ if {[string length $errormsg]} {
+ catch {close $state(sock)}
+ uplevel #0 $state(-command) [list $token $errormsg]
+ free $token
+ } else {
+ uplevel #0 $state(-command) [list $token ok]
+ }
+ } else {
+ if {[string length $errormsg]} {
+ catch {close $state(sock)}
+ free $token
+ return -code error $errormsg
+ } else {
+ return
+ }
+ }
+}
+
+# Test
+if {0} {
+ set s [socket 127.0.0.1 3000]
+ set t [socks4::init $s google.com 80 -username mats]
+ socks4::free $t
+}
+
--- /dev/null
+# socks5.tcl ---
+#
+# Package for using the SOCKS5 method for connecting TCP sockets.
+# Some code plus idee from Kerem 'Waster_' HADIMLI.
+# Made from RFC 1928.
+#
+# (C) 2000 Kerem 'Waster_' HADIMLI (minor parts)
+# (c) 2003-2007 Mats Bengtsson
+#
+# This source file is distributed under the BSD license.
+#
+# $Id: socks5.tcl,v 1.20 2007/07/19 06:28:11 matben Exp $
+#
+# 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 provide socks5 0.1
+
+namespace eval socks5 {
+
+ # 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 {
+ \x00 rsp_succeeded
+ \x01 rsp_failure
+ \x02 rsp_notallowed
+ \x03 rsp_netunreachable
+ \x04 rsp_hostunreachable
+ \x05 rsp_refused
+ \x06 rsp_expired
+ \x07 rsp_cmdunsupported
+ \x08 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
+ variable uid 0
+}
+
+# socks5::init --
+#
+# 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 {token status}
+# -username username
+# -password password
+# -timeout millisecs
+#
+# Results:
+# token if -command, else ?.
+
+proc socks5::init {sock addr port args} {
+ variable msg
+ variable const
+ variable uid
+
+ 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]::[incr uid]
+ variable $token
+ upvar 0 $token state
+
+ array set state {
+ -password ""
+ -timeout 60000
+ -username ""
+ async 0
+ auth 0
+ bnd_addr ""
+ bnd_port ""
+ state ""
+ status ""
+ trigger 0
+ }
+ 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"
+ if {[catch {
+ puts -nonewline $sock "$const(ver)$nmethods$methods"
+ flush $sock
+ } err]} {
+ return -code error network-failure
+ }
+
+ # Setup timeout timer. !async remains!
+ set state(timeoutid) \
+ [after $state(-timeout) [namespace current]::timeout $token]
+
+ if {$state(async)} {
+ fileevent $sock readable \
+ [list [namespace current]::response_method $token]
+ return $token
+ } else {
+
+ # We should not return from this proc until finished!
+ fileevent $sock readable \
+ [list [namespace current]::readable $token]
+ vwait $token\(trigger)
+ return [response_method $token]
+ }
+}
+
+proc socks5::response_method {token} {
+ variable $token
+ variable const
+ upvar 0 $token state
+
+ debug 2 "socks5::response_method"
+
+ 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
+ }
+
+ if {$state(async)} {
+ fileevent $sock readable \
+ [list [namespace current]::response_auth $token]
+ return
+ } else {
+
+ # We should not return from this proc until finished!
+ fileevent $sock readable [list [namespace current]::readable $token]
+ vwait $token\(trigger)
+ return [response_auth $token]
+ }
+ } else {
+ finish $token err_unsupported_method
+ return
+ }
+}
+
+proc socks5::response_auth {token} {
+ variable $token
+ upvar 0 $token state
+
+ debug 2 "socks5::response_auth"
+
+ set sock $state(sock)
+
+ if {[catch {read $sock 2} data] || [eof $sock]} {
+ finish $token network-failure
+ return
+ }
+ set auth_ver ""
+ set status \x00
+ 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.
+ return [request $token]
+}
+
+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
+ }
+
+ if {$state(async)} {
+ fileevent $sock readable \
+ [list [namespace current]::response $token]
+ return
+ } else {
+
+ # We should not return from this proc until finished!
+ fileevent $sock readable \
+ [list [namespace current]::readable $token]
+ vwait $token\(trigger)
+ return [response $token]
+ }
+}
+
+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 {parse_atyp_addr $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.
+ return [finish $token]
+}
+
+proc socks5::parse_atyp_addr {token addrVar portVar} {
+ variable $token
+ variable const
+ upvar 0 $token state
+ upvar $addrVar addr
+ upvar $portVar port
+
+ debug 2 "socks5::parse_atyp_addr"
+
+ 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::finish {token {errormsg ""}} {
+ global errorInfo errorCode
+ variable $token
+ upvar 0 $token state
+
+ debug 2 "socks5::finish errormsg=$errormsg"
+ catch {after cancel $state(timeoutid)}
+
+ # In case of error we do the cleanup.
+ if {$state(async)} {
+ if {[string length $errormsg]} {
+ catch {close $state(sock)}
+ uplevel #0 $state(-command) [list $token $errormsg]
+ free $token
+ } else {
+ uplevel #0 $state(-command) [list $token ok]
+ }
+ } else {
+ if {[string length $errormsg]} {
+ catch {close $state(sock)}
+ free $token
+ return -code error $errormsg
+ } else {
+ return
+ }
+ }
+}
+
+proc socks5::getipandport {token} {
+ variable $token
+ upvar 0 $token state
+ return [list $state(bnd_addr) $state(bnd_port)]
+}
+
+proc socks5::timeout {token} {
+ finish $token timeout
+}
+
+proc socks5::free {token} {
+ variable $token
+ upvar 0 $token state
+ unset -nocomplain state
+}
+
+# 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
+ variable uid
+
+ 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]::[incr uid]
+ 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 {parse_atyp_addr $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]::serv_timeout $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::serv_timeout {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
+
+ # Client
+ proc cb {token status} {
+ global s
+ puts "client: token=$token, status=$status"
+ if {$status eq "ok"} {
+ fconfigure $s -buffering none
+ }
+ }
+ proc dump {} {
+ puts "dump:"
+ }
+ set s [socket 127.0.0.1 1080]
+ socks5::init $s localhost 3344 -command cb
+ #socks5::init $s localhost 3344 -command cb -username xxx -password yyy
+}
+
+#-------------------------------------------------------------------------------
projects / Bullfrog / commitdiff