Version 1 of TCPProxy

Updated 2002-11-14 14:23:01

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
 }

Category Internet