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
proc DEBUG args {
set msg [string toupper APP]
set args [string map {\" ""} [join $args \ ]]
foreach arg $args {
lappend msg [expr {[string length $arg] > 255 ? [string range $arg 0 32] : $arg}]
}
puts stdout $msg
}# 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*c [split 0.0.0.1 .] $socksuser 0x00] \
$desthost \0
}
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
set data [binary format ccc 0x05 0x01 0x00]
if {[regexp {[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+} $desthost]} {
append data [binary format cc4S 0x01 [split $desthost .] $destport]
} else {
append data \
[binary format cc 0x03 [string length $desthost]] \
$desthost \
[binary format S $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]
}
proc SEND {sock args} {
puts -nonewline $sock [join $args ""]
}
proc FCFG {sock cb {buffering none} {blocking off} {encoding binary} {translation binary}} {
if {[llength $cb] < 2} {
lappend cb $sock
}
fconfigure $sock -blocking $blocking
fconfigure $sock -buffering $buffering
fconfigure $sock -encoding $encoding
fconfigure $sock -translation $translation
fileevent $sock readable $cb
}