[vkvalli] 16-Aug-2014: This program acts as a bandwidth throttling proxy. ====== usage: proxy.tcl The last parameter is optional. The bandwidth is in bytes/per second. Function: It throttles the downstream bandwidth and not the upstream bandwidth. period regulates the burstness of traffic. The default is 50. This is optimal for interactive applications like rdp. For filetransfer like applications - 200 + might be optimal. The bandwidth applies to each connection and not sum of all connections. Requirements: It needs TclOO . So version 8.5 and above required. Bugs: error catching on local socket read is not done. It assumes one char is one byte. Keeping period too low, ie 10, will increase cpu load significantly. Logic: The core is handler object. It is created on a connection. It's method local_read and remote_read act as handlers for readable fileevent on the channels. From the bandwidth input, what is the bytes to be read per time-period is calculated. The default time-period is 50 millisec. global variables lbuflength and period carry these values. There is quota allocated for each time-period. As remote_read keeps reading data from remote_host, this quota keeps decreasing. Once quota becomes zero, remote_read stops reading from chan. A timer gets activated at the beginning of time-period and sets the quota to max, ie lbuflength. The quota is maintained by instance variable limit. Methods: initialize - chan configuration, event handler setup to object methods, starts timer finalize - channel closing, timer stopping, self-destruction timer - start - starts the timer, stops - stops it. resets quota on start local_read - reads local chan remote_read - if quota available, reads remote, decreases quota limit_reset - resets quota to max, ie lbuflength ====== ---- package require TclOO set debug_level 3 proc debug {level msg} { global debug_level if {$debug_level > $level} { puts $msg } } oo::class create handler {} oo::define handler { method initialize {lchan1 rchan1} { my variable lchan my variable rchan my variable lbuffer set lchan $lchan1 set rchan $rchan1 fconfigure $lchan -translation binary -buffering none -blocking 0 fconfigure $rchan -translation binary -buffering none -blocking 0 fileevent $lchan readable [list [self] local_read ] fileevent $rchan readable [list [self] remote_read ] my timer start # dumper register [self] debug 1 "handler [self] created" } method finalize {} { my variable lchan my variable rchan my variable lbuffer my timer stop catch {close $lchan} catch {close $rchan} # dumper deregister [self] after 0 [self] destroy } method local_read {} { my variable lchan my variable rchan if [eof $lchan] { my finalize return } set data [read $lchan] if [catch {puts -nonewline $rchan $data}] { my finalize } } method remote_read {} { my variable lchan my variable rchan my variable limit if [eof $rchan] { my finalize } if {$limit > 0} { set data [read $rchan $limit] incr limit -[string length $data] if [eof $lchan] { my finalize return } if [catch {puts -nonewline $lchan $data}] { my finalize return } } } method timer {mode} { global period my variable timer_id switch $mode { start { my limit_reset set timer_id [after $period [list [self] timer start] ] } stop { after cancel $timer_id } } } method limit_reset {} { my variable limit global lbuflength set limit $lbuflength } } if {[llength $argv] < 4} { puts "usage: args: lport rhost rport bandwidth" exit } set lport [lindex $argv 0] set rhost [lindex $argv 1] set rport [lindex $argv 2] set bwidth [lindex $argv 3] set period [lindex $argv 4] if {$period eq ""} { set period 50 } set lbuflength [expr ($bwidth * $period ) / 1000 ] proc accept {sock addr p} { global rhost rport set conn [socket -async $rhost $rport] set obj_name handler_$sock handler create $obj_name $obj_name initialize $sock $conn } set server [socket -server accept $lport] vwait forever ---- [Category Networking]