Working bi-directional proxy system.

        proc IPC {src dest} {
                (your code here)
        }

        proc STAMP {} {
                return [clock seconds]
        }

#        Initialize component SERVER socket

        if {[catch {socket -server ACCEPT $srcport} accept]} {
                DEBUG ERROR([STAMP]): $accept
                exit
        }

#        Global variables

        set ::proxyon                off
        set ::socksver                5
        set ::sockshost                4.3.2.1
        set ::socksport                1080
        set ::socksuser                ""
        set ::sockspass                ""
        set ::srcport                1234
        set ::desthost                1.2.3.4
        set ::destport                1234

#        Basic network functions.

        proc CLOSE {} {
                global client server

                catch {
                        close $client
                        set client 0
                }
                catch {
                        close $server
                        set server 0
                }
        }

        proc ACCEPT {sock addr port} {
                global proxyon socksver sockshost socksport socksuser sockspass desthost destport
                global client server socksconnected

                CLOSE

                DEBUG ACCEPT([STAMP]): sock=$sock addr=$addr port=$port

                set client $sock

                if {[catch {
                        if {$proxyon} {
                                socket $sockshost $socksport
                        } else {
                                socket $desthost $destport
                        }
                } server]} {
                        CLOSE
                        DEBUG SOCKET ERROR([STAMP]): $server
                        return
                } elseif {[catch {FCFG $client [list IPC $client $server]} errmsg]} {
                        CLOSE
                        DEBUG FCFG-CLIENT ERROR([STAMP]): $errmsg
                        return
                } elseif {[catch {
                        if {$proxyon} {
                                set socksconnected off
                                FCFG $server [list SOCKS $server $client]
                                switch -exact $socksver {
                                        4 {
                                                set data [binary format ccS 0x04 0x01 $destport]
                                                if {[regexp {[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+} $desthost]} {
                                                        append data [binary format c4c [split $desthost .] 0x00]
                                                } else {
                                                        append data [binary format c4c*cc*c [split 0.0.0.1 .] $socksuser 0x00 [split $desthost ""] 0x00]
                                                }

                                                SEND $server $data
                                        }
                                        5 {
                                                SEND $server [binary format ccc 0x05 0x01 0x00]
                                        }
                                }
                        } else {
                                FCFG $server [list IPC $server $client]
                        }
                } errmsg]} {
                        CLOSE
                        DEBUG FCFG-SERVER ERROR([STAMP]): $errmsg
                        return
                }
        }

        proc SOCKS {src dest} {
                global socksver socksuser sockspass desthost destport
                global socksconnected

                if {[READ $src 2 data] > 1 && [binary scan $data cc ver etc] > 1} {
                        switch -exact $ver {
                                0 {
                                        if {$socksver ne 4} {
                                                CLOSE
                                                DEBUG SOCKS([STAMP]): ver=0x[format %X $ver] etc=0x[format %X $etc] Wrong version!
                                                return
                                        } elseif {$etc eq 0x5B} {
                                                CLOSE
                                                DEBUG SOCKS([STAMP]): Connection failed!
                                                return
                                        }
                                        set length 6
                                        if {[READ $src $length data] eq $length} {
                                                FCFG $src [list IPC $src $dest]
                                        }
                                        return
                                }
                                5 {
                                        if {$socksver ne 5} {
                                                CLOSE
                                                DEBUG SOCKS([STAMP]): ver=0x[format %X $ver] etc=0x[format %X $etc] Wrong version!
                                                return
                                        }
                                        if {$socksconnected} {
                                                set length 2
                                                if {!$etc && [READ $src $length data] eq $length && [binary scan $data cc rsv type] > 1} {
                                                        switch -exact $type {
                                                                1 {
                                                                        READ $src 6 data
                                                                }
                                                                3 {
                                                                        READ $src 1 data
                                                                        binary scan $data c length
                                                                        READ $src [expr {2 + $length}] data
                                                                }
                                                                4 {
                                                                        READ $src 18 data
                                                                }
                                                        }
                                                        FCFG $src [list IPC $src $dest]
                                                        return
                                                }
                                        } else {
                                                set socksconnected yes
                                                if {[regexp {[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+} $desthost]} {
                                                        set data [binary format ccccc4S 0x05 0x01 0x00 0x01 [split $desthost .] $destport]
                                                } else {
                                                        set data [binary format cccccc*S 0x05 0x01 0x00 0x03 [string length $desthost] [split $desthost ""] $destport]
                                                }
                                                SEND $src $data
                                                return
                                        }
                                }
                                default {
                                        DEBUG SOCKS([STAMP]): ver=$ver etc=$etc
                                }
                        }
                }
                CLOSE
                DEBUG SOCKS([STAMP]): Closing
        }

        proc READ {sock length var} {
                upvar $var _var
                set _var {}
                while {$length > 0} {
                        if {[eof $sock]} {
                                CLOSE
                                DEBUG READ([STAMP]): Closing
                                return
                        }
                        set packet [read $sock $length]
                        set length [expr {$length - [string length $packet]}]
                        lappend _var $packet
                }
                set _var [join $_var ""]
                return [string length $_var]
        }

----
[Category Networking]