#!/bin/sh
# \
exec wish "$0" ${1+"$@"}
wm title . "TCP Proxy"
#init defaults:
set config(listenport) 2222
set config(server) 127.0.0.1
set config(serverport) 22
set config(connected) 0
set serversocket ""
set params [frame .params]
set status [frame .status]
set llisten [label $params.llisten -height 1 \
-borderwidth 2 -relief flat \
-text "Listen port: "]
set elistenport [entry $params.listen -width 5 \
-borderwidth 2 -relief raised \
-textvariable config(listenport)]
set lserver [label $params.lserver -height 1 \
-borderwidth 2 -relief flat \
-text "Connect to host: "]
set eserver [entry $params.server -width 5 -width 25 \
-borderwidth 2 -relief raised \
-textvariable config(server)]
set lserverport [label $params.lserverport -height 1 \
-borderwidth 2 -relief flat \
-text "Port: "]
set eserverport [entry $params.port -width 5 \
-borderwidth 2 -relief raised \
-textvariable config(serverport)]
set startstop [button $params.start -height 1 -text "Start" \
-borderwidth 2 -command doStartStop]
pack $params -side top -fill x
pack $llisten $elistenport $lserver $eserver $lserverport \
$eserverport $startstop -side left -fill x
set log [text $status.log -width 80 -height 20 \
-borderwidth 2 -relief raised -setgrid true]
pack $log -side top -fill x
pack $status -side bottom -fill x
proc log { msg } {
$::log insert end "$msg\n"
$::log see end
}
proc doStartStop { } {
#start or stop listening.
#but stop does not imply 'close all active connections'!
if { [string equal $::serversocket ""] } {
set ::serversocket [socket -server acceptConnection \
$::config(listenport)]
set ::acceptServer $::config(server)
set ::acceptPort $::config(serverport)
set ::config(connected) 1
$::startstop configure -text "Stop"
log "Now listening on $::config(listenport)"
saveConfig
} else {
close $::serversocket
set ::serversocket ""
$::startstop configure -text "Start"
log "No longer accepting new connections"
set ::config(connected) 0
}
}
proc acceptConnection { channel peer peerport } {
fconfigure $channel -translation binary -blocking 0 -buffering none
if { [catch {
set proxy [socket $::acceptServer $::acceptPort]
} res ] } {
close $channel
log "Could not connect to $::acceptServer $::acceptPort\nReason: $res"
return
}
fconfigure $proxy -translation binary -blocking 0 -buffering none
set ::peers($channel) $proxy
set ::peers($proxy) $channel
set peer [fconfigure $channel -peername]
set peer2 [fconfigure $::peers($channel) -peername]
log "Connection from [lindex $peer 1] -> [lindex $peer2 1] established "
fileevent $channel readable "pipeData $channel"
fileevent $proxy readable "pipeData $proxy"
}
proc pipeData { channel } {
set data [read $channel]
if { [string length $data] == 0} {
if { [info exists ::peers($channel)] } {
set peer [fconfigure $channel -peername]
set peer2 [fconfigure $::peers($channel) -peername]
close $::peers($channel)
close $channel
unset ::peers($::peers($channel))
unset ::peers($channel)
log "Connection [lindex $peer 1]/[lindex $peer2 1] closed"
}
} else {
puts -nonewline $::peers($channel) $data
}
}
proc saveConfig { } {
global config
set fd [open "proxyrc" w]
puts $fd [array get config]
close $fd
}
proc loadConfig { } {
global config
catch {
set fd [open "proxyrc" r]
array set config [read $fd]
close $fd
}
}
proc pleaseQuit { } {
set conns 0
if { [array exists ::peers] } {
set conns [expr [array size ::peers] / 2]
}
if { $conns > 0 } {
set msg "Warning: there are $conns active connections,\ndo you really want to quit?"
} else {
set msg "Do you really want to quit?\n(there are no active connections)"
}
if {[tk_messageBox \
-icon question \
-type yesno \
-default no \
-message $msg \
-title "Quit TCP Proxy?"] == "yes"} {
saveConfig
exit
}
}
wm protocol . WM_DELETE_WINDOW pleaseQuit
#start listening:
loadConfig
if { $::config(connected) } {
doStartStop
}Category Internet - Category Networking
