79 |
# so that we can have basic support for multiple server connections. |
# so that we can have basic support for multiple server connections. |
80 |
set ::server-idx $idx |
set ::server-idx $idx |
81 |
callraw $from $key $arg |
callraw $from $key $arg |
82 |
|
traffic irc in [string length $line] |
83 |
} else { |
} else { |
84 |
Error {EOF} {Got EOF From Server} |
Error {EOF} {Got EOF From Server} |
85 |
} |
} |
95 |
set hostname ${my-hostname} |
set hostname ${my-hostname} |
96 |
} |
} |
97 |
if {[valididx $idx]} { |
if {[valididx $idx]} { |
98 |
putidx $idx "NICK $nick" |
set ::server-idx $idx |
99 |
putidx $idx "USER $username $hostname $username :$realname" |
putquick "NICK $nick" |
100 |
|
putquick "USER $username $hostname $username :$realname" |
101 |
} else { |
} else { |
102 |
Error SOCKET {Unknown error} |
Error SOCKET {Unknown error} |
103 |
} |
} |
107 |
proc ::tcldrop::server::quit {{reason {}}} { |
proc ::tcldrop::server::quit {{reason {}}} { |
108 |
callevent predisconnect-server |
callevent predisconnect-server |
109 |
global server-online server real-server server-idx |
global server-online server real-server server-idx |
110 |
if {[valididx ${server-idx}]} { |
putnow "QUIT :$reason" |
111 |
putidx ${server-idx} "QUIT :$reason" |
killidx ${server-idx} |
|
killidx ${server-idx} |
|
|
} |
|
112 |
set server-online 0 |
set server-online 0 |
113 |
set server-idx 0 |
set server-idx 0 |
114 |
set server {} |
set server {} |
268 |
# Takes lines into the outgoing server queue, |
# Takes lines into the outgoing server queue, |
269 |
# sends them immediately if it's able to burst, |
# sends them immediately if it's able to burst, |
270 |
# and flushes lines out when it calls itself. |
# and flushes lines out when it calls itself. |
271 |
# $queue should be a number, the lower the number the higher up the queue $line will be. |
# $queue should be a number, the lower the number the higher priority the $line will be. |
272 |
# Please note that queue 0 is reserved. Use 1 or higher when specifying queues. |
# Please note that queue 0 is reserved. Use 1 or higher when specifying queues. |
273 |
# $line is the text you want to send to the server. |
# $line is the text you want to send to the server. |
274 |
# $option can be either -normal or -next (Like in Eggdrop). |
# $option can be either -normal or -next (Like in Eggdrop). |
309 |
putloglev v * "\[$a->\] $line" |
putloglev v * "\[$a->\] $line" |
310 |
putnow $line |
putnow $line |
311 |
# The time (in milliseconds) before we try again.. |
# The time (in milliseconds) before we try again.. |
312 |
set SentData(penalty) [GetPenalty $line] |
if {[set SentData(penalty) [GetPenalty $line]] > 0} { |
|
if {$SentData(penalty) > 0} { |
|
313 |
# Try again after the penalty expires (plus a tad longer): |
# Try again after the penalty expires (plus a tad longer): |
314 |
after [expr {$SentData(penalty) + 99}] [list ::tcldrop::server::Queue 0] |
after [expr {$SentData(penalty) + 99}] [list ::tcldrop::server::Queue 0] |
315 |
# Get out of here, there's nothing more we should do since we have to wait... |
# Get out of here, there's nothing more we should do since we have to wait... |
332 |
proc ::tcldrop::server::putnow {text} { |
proc ::tcldrop::server::putnow {text} { |
333 |
if {[valididx ${::server-idx}]} { |
if {[valididx ${::server-idx}]} { |
334 |
putidx ${::server-idx} $text |
putidx ${::server-idx} $text |
335 |
|
traffic irc out [string length $text] |
336 |
} else { |
} else { |
337 |
clearqueue {all} |
clearqueue {all} |
338 |
} |
} |
343 |
# $option can be -normal or -next (Like in Eggdrop). |
# $option can be -normal or -next (Like in Eggdrop). |
344 |
proc ::tcldrop::server::putqueue {queue text {option {-normal}}} { |
proc ::tcldrop::server::putqueue {queue text {option {-normal}}} { |
345 |
variable QueueAliases |
variable QueueAliases |
346 |
if {[info exists QueueAliases($queue)]} { |
if {[info exists QueueAliases($queue)]} { set priority $QueueAliases($queue) } |
|
set priority $QueueAliases($queue) |
|
|
} |
|
347 |
variable Queue |
variable Queue |
348 |
# Unlike Eggdrop, we deal with people sending multiple lines at once.. |
# Unlike Eggdrop, we deal with people sending multiple lines at once.. |
349 |
foreach line [split $text \n] { |
foreach line [split $text \n] { |
358 |
} |
} |
359 |
} |
} |
360 |
|
|
361 |
# putquick command: |
proc ::tcldrop::server::putquick {text {option {-normal}}} { putqueue mode $text $option } |
|
proc ::tcldrop::server::putquick {text {option {-normal}}} { |
|
|
putqueue mode $text $option |
|
|
} |
|
362 |
|
|
363 |
proc ::tcldrop::server::putserv {text {option {-normal}}} { |
proc ::tcldrop::server::putserv {text {option {-normal}}} { putqueue server $text $option } |
|
putqueue server $text $option |
|
|
} |
|
364 |
|
|
365 |
proc ::tcldrop::server::puthelp {text {option {-normal}}} { |
proc ::tcldrop::server::puthelp {text {option {-normal}}} { putqueue help $text $option } |
|
putqueue help $text $option |
|
|
} |
|
366 |
|
|
367 |
# Reply to server PINGs: |
# Reply to server PINGs: |
368 |
bind raw - PING ::tcldrop::server::PING 99 |
bind raw - PING ::tcldrop::server::PING 99 |
369 |
proc ::tcldrop::server::PING {from key arg} { |
proc ::tcldrop::server::PING {from key arg} { putquick "PONG $arg" } |
|
putquick "PONG $arg" |
|
|
} |
|
370 |
|
|
371 |
# Handle server ERRORs: |
# Handle server ERRORs: |
372 |
bind raw - ERROR ::tcldrop::server::ERROR 99 |
bind raw - ERROR ::tcldrop::server::ERROR 99 |
373 |
proc ::tcldrop::server::ERROR {from key arg} { |
proc ::tcldrop::server::ERROR {from key arg} { |
374 |
if {${::servererror-quit}} { |
if {${::servererror-quit}} { Error {ERROR} $arg } |
|
Error {ERROR} $arg |
|
|
} |
|
375 |
} |
} |
376 |
|
|
377 |
# Set our basic info (botnick, etc) and call the init-server event: |
# Set our basic info (botnick, etc) and call the init-server event: |
381 |
set ::real-server $from |
set ::real-server $from |
382 |
set ::botnick [lindex [split $arg] 0] |
set ::botnick [lindex [split $arg] 0] |
383 |
# Eval $init-server (obsolete in Eggdrop): |
# Eval $init-server (obsolete in Eggdrop): |
384 |
catch { eval ${::init-server} } |
if {[info exists ::init-server]} { catch { eval ${::init-server} } } |
385 |
# Call the init-server binds: |
# Call the init-server binds: |
386 |
callevent init-server |
callevent init-server |
387 |
} |
} |
398 |
bind evnt - prerestart ::tcldrop::server::PreRestart |
bind evnt - prerestart ::tcldrop::server::PreRestart |
399 |
proc ::tcldrop::server::PreRestart {type} { |
proc ::tcldrop::server::PreRestart {type} { |
400 |
quit $type |
quit $type |
401 |
} |
} |