59 |
::tcldrop::SetDefault botname {} |
::tcldrop::SetDefault botname {} |
60 |
::tcldrop::SetDefault botnick {} |
::tcldrop::SetDefault botnick {} |
61 |
::tcldrop::SetDefault max-queue-msg {99} |
::tcldrop::SetDefault max-queue-msg {99} |
62 |
|
::tcldrop::SetDefault network {Unknown} |
63 |
checkmodule conn |
checkmodule conn |
64 |
} |
} |
65 |
|
|
66 |
proc ::tcldrop::server::isbotnick {nick} { string equal -nocase $nick $::botnick } |
proc ::tcldrop::server::isbotnick {nick} { string equal -nocase $nick $::botnick } |
67 |
|
|
68 |
proc ::tcldrop::server::Read {idx line} { |
proc ::tcldrop::server::Read {idx line} { |
69 |
|
set starttime [clock clicks] |
70 |
if {[valididx $idx]} { |
if {[valididx $idx]} { |
71 |
putloglev r * "\[@\] $line" |
putloglev r * "\[@\] $line" |
72 |
set lline [split $line] |
set lline [split $line] |
87 |
} else { |
} else { |
88 |
Error {EOF} {Got EOF From Server} |
Error {EOF} {Got EOF From Server} |
89 |
} |
} |
90 |
|
putloglev d * "raw: process time: [expr {[clock clicks] - $starttime}]" |
91 |
} |
} |
92 |
|
|
93 |
# Sends the NICK and USER info to the IRC server as soon as the socket is open: |
# Sends the NICK and USER info to the IRC server as soon as the socket is open: |
113 |
callevent predisconnect-server |
callevent predisconnect-server |
114 |
global server-online server real-server server-idx |
global server-online server real-server server-idx |
115 |
putnow "QUIT :$reason" |
putnow "QUIT :$reason" |
|
killidx ${server-idx} |
|
116 |
set server-online 0 |
set server-online 0 |
117 |
set server-idx 0 |
set server-idx 0 |
118 |
set server {} |
set server {} |
122 |
|
|
123 |
proc ::tcldrop::server::server {{serv {}} {port 0} {password {}}} { |
proc ::tcldrop::server::server {{serv {}} {port 0} {password {}}} { |
124 |
global server servers default-port server-online my-ip server-timeout server-idx |
global server servers default-port server-online my-ip server-timeout server-idx |
125 |
|
# FixMe: There should be a global option to decide weather to choose a random server, |
126 |
|
# or to go in the same order as the $servers list. |
127 |
if {$serv == {}} { |
if {$serv == {}} { |
128 |
if {[set port [lindex [split [set serv [lindex $servers [rand [llength $servers]]]] :] 1]] != {}} { |
if {[set port [lindex [split [set serv [lindex $servers [rand [llength $servers]]]] :] 1]] != {}} { |
129 |
set serv [lindex [split $serv :] 0] |
set serv [lindex [split $serv :] 0] |
134 |
callevent connect-server |
callevent connect-server |
135 |
variable TimerID |
variable TimerID |
136 |
catch { killutimer $TimerID } |
catch { killutimer $TimerID } |
137 |
set fail [catch { connect $serv $port -timeout ${server-timeout} -myaddr ${my-ip} -control ::tcldrop::server::Read -errors ::tcldrop::server::ConnectErrors -writable ::tcldrop::server::Write } idx] |
set fail [catch { connect $serv $port -timeout [fuzz ${server-timeout}] -myaddr ${my-ip} -control ::tcldrop::server::Read -errors ::tcldrop::server::Error -writable ::tcldrop::server::Write } idx] |
138 |
if {!$fail} { |
if {!$fail} { |
139 |
::tcldrop::idx::ChInfo $idx [list handle (server) remote $serv hostname $serv port $port type SERVER other serv traffictype irc timestamp [set timestamp [unixtime]]] |
setidxinfo $idx [list handle (server) remote $serv hostname $serv port $port type SERVER other serv traffictype irc timestamp [set timestamp [unixtime]]] |
140 |
# Eggdrop compatibility stuff: |
# Eggdrop compatibility stuff: |
141 |
set server "$serv:$port" |
set server "$serv:$port" |
142 |
set server-online $timestamp |
set server-online $timestamp |
143 |
set server-idx $idx |
set server-idx $idx |
|
# The timeout here is so that we can try another server. |
|
|
set TimerID [utimer [expr { ${server-timeout} + 1 }] [list ::tcldrop::server::ConnectTimeout $idx]] |
|
144 |
} else { |
} else { |
145 |
set TimerID [utimer ${server-cycle-wait} [list ::tcldrop::server::server]] |
# Wait $server-cycle-wait before trying again. |
146 |
|
set TimerID [utimer [fuzz ${server-cycle-wait}] [list ::tcldrop::server::server]] |
147 |
} |
} |
148 |
return "$serv:$port" |
return "$serv:$port" |
149 |
} |
} |
150 |
|
|
|
proc ::tcldrop::server::ConnectTimeout {idx} { |
|
|
if {![valididx $idx]} { Error {CONNECT_TIMEOUT} "Timeout during connect" } |
|
|
} |
|
|
|
|
151 |
# This procs job is to close the current server connection, |
# This procs job is to close the current server connection, |
152 |
# and then wait until it's time to connect to another. |
# and then wait until it's time to connect to another. |
153 |
proc ::tcldrop::server::Error {type {reason {Error}}} { |
proc ::tcldrop::server::Error {idx {reason {Error}}} { |
154 |
quit "$type: $reason" |
quit $reason |
155 |
utimer ${::server-cycle-wait} [list ::tcldrop::server::server] |
utimer [fuzz ${::server-cycle-wait}] [list ::tcldrop::server::server] |
|
} |
|
|
|
|
|
proc ::tcldrop::server::ConnectErrors {idx reason} { |
|
|
Error {CONNECT_ERROR} $reason |
|
156 |
} |
} |
157 |
|
|
158 |
proc ::tcldrop::server::jump {{server {}} {port 0} {password {}}} { |
proc ::tcldrop::server::jump {{server {}} {port 0} {password {}}} { |
|
if {$port == 0} { set port ${::default-port} } |
|
159 |
if {${::server-online}} { quit {Changing Servers...} } |
if {${::server-online}} { quit {Changing Servers...} } |
160 |
server $server $port $password |
server $server $port $password |
161 |
} |
} |
214 |
variable SentData |
variable SentData |
215 |
# Add the current milliseconds for this line to the list.. |
# Add the current milliseconds for this line to the list.. |
216 |
lappend SentData(lastclicks) [clock clicks -milliseconds] |
lappend SentData(lastclicks) [clock clicks -milliseconds] |
217 |
# And make sure there's only at most 5 in the list.. |
# Make sure there's only at most 5 in the list.. |
218 |
if {[llength $SentData(lastclicks)] > 5} { set SentData(lastclicks) [lrange $SentData(lastclicks) end-4 end] } |
if {[llength $SentData(lastclicks)] > 5} { set SentData(lastclicks) [lrange $SentData(lastclicks) end-4 end] } |
219 |
set allowance 0 |
set allowance 0 |
220 |
# See how much allowance we've saved up for bursts: |
# See how much allowance we've saved up for bursts: |
221 |
foreach b $SentData(lastclicks) { |
foreach b $SentData(lastclicks) { incr allowance [expr {[clock clicks -milliseconds] - $b}] } |
222 |
incr allowance [expr {[clock clicks -milliseconds] - $b}] |
# > 50000 means we haven't bursted our 5 lines in 10 seconds allowance.. |
|
} |
|
|
putloglev d * "total allowance: $allowance" |
|
223 |
if {$allowance > 50000} { |
if {$allowance > 50000} { |
224 |
# > 50000 means we haven't bursted our 5 lines in 10 seconds allowance.. |
# Note, it's possible that this gives a percent over 100.. |
225 |
|
putloglev d * {burst: 1} |
226 |
# Let's spend our allowance! =D |
# Let's spend our allowance! =D |
227 |
set penalty 0 |
set penalty 0 |
228 |
} else { |
} else { |
229 |
|
putloglev d * {burst: 0} |
230 |
# We can't burst any more, so apply the penalties... |
# We can't burst any more, so apply the penalties... |
231 |
|
# Note that 1000 (ms) equals 1 second.... |
232 |
switch -- [string toupper [lindex [split $line] 0]] { |
switch -- [string toupper [lindex [split $line] 0]] { |
233 |
{INVITE} { set penalty 3000 } |
{INVITE} { set penalty 3000 } |
234 |
{JOIN} { set penalty 2000 } |
{JOIN} { set penalty 2000 } |
240 |
{ISON} { set penalty 1000 } |
{ISON} { set penalty 1000 } |
241 |
{WHOIS} { set penalty 2000 } |
{WHOIS} { set penalty 2000 } |
242 |
{DNS} { set penalty 2000 } |
{DNS} { set penalty 2000 } |
243 |
|
{PING} { set penalty 100 } |
244 |
|
{PONG} { set penalty 100 } |
245 |
{default} { |
{default} { |
246 |
# The number of destinations (targets) for the command: |
# The number of destinations (targets) for the command: |
247 |
# Note: it's possible that targets can be 0, if the command |
# Note: it's possible that targets can be 0, if the command |
319 |
# We process the next queue on the next iteration.. |
# We process the next queue on the next iteration.. |
320 |
} |
} |
321 |
} elseif {$queue == 0} { |
} elseif {$queue == 0} { |
322 |
# What?! We didn't wait long enough!? How is that possible! =P |
# What?! We didn't wait long enough!? How is that possible! =/ |
323 |
# Anyways, let's wait out the rest of the time, plus a little bit more and try again.. |
# Anyways, let's wait out the rest of the time, plus a little bit more and try again.. |
324 |
after [expr {$SentData(penalty) - $waited + 99}] [list ::tcldrop::server::Queue 0] |
after [expr {$SentData(penalty) - $waited + 99}] [list ::tcldrop::server::Queue 0] |
325 |
} |
} |
332 |
if {[valididx ${::server-idx}]} { |
if {[valididx ${::server-idx}]} { |
333 |
putidx ${::server-idx} $text |
putidx ${::server-idx} $text |
334 |
} else { |
} else { |
335 |
clearqueue {all} |
clearqueue all |
336 |
} |
} |
337 |
} |
} |
338 |
|
|