In our network, we have one place that can access a database through a VPN connection. But I want everyone to be able to access that, so I wrote a [TCPProxy], which works very similar to [sockspy] except it doesn't do any fancy logging.

-- [PS]

-----
 #!/bin/sh
 # \
      exec wish "$0" ${1+"$@"}


 wm title . "TCP Proxy"

 #init defailts:
 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
 }

-----