TCPProxy

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.

Please note that the actual proxying code is roughly 60 lines and 175 with UI and persistent settings. I just love short Tcl solutions.

-- PS

 #!/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