vkvalli 16-Aug-2014: This program acts as a bandwidth throttling proxy.
- usage:
- proxy.tcl <local_port> <remote_host> <remote_port> <bandwidth> <period>
-
- The last parameter <period> 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
