/[tcldrop]/tcldrop/modules/server/server.tcl
ViewVC logotype

Diff of /tcldrop/modules/server/server.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by fireegl, Fri Nov 21 01:37:27 2003 UTC revision 1.11 by fireegl, Sat Nov 22 03:32:05 2003 UTC
# Line 79  proc ::tcldrop::server::Read {idx line} Line 79  proc ::tcldrop::server::Read {idx line}
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          }          }
# Line 94  proc ::tcldrop::server::Write {idx} { Line 95  proc ::tcldrop::server::Write {idx} {
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          }          }
# Line 105  proc ::tcldrop::server::Write {idx} { Line 107  proc ::tcldrop::server::Write {idx} {
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 {}
# Line 268  proc ::tcldrop::server::GetPenalty {line Line 268  proc ::tcldrop::server::GetPenalty {line
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).
# Line 309  proc ::tcldrop::server::Queue {{queue {9 Line 309  proc ::tcldrop::server::Queue {{queue {9
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...
# Line 333  proc ::tcldrop::server::Queue {{queue {9 Line 332  proc ::tcldrop::server::Queue {{queue {9
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          }          }
# Line 343  proc ::tcldrop::server::putnow {text} { Line 343  proc ::tcldrop::server::putnow {text} {
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] {
# Line 360  proc ::tcldrop::server::putqueue {queue Line 358  proc ::tcldrop::server::putqueue {queue
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:
# Line 394  proc ::tcldrop::server::001 {from key ar Line 381  proc ::tcldrop::server::001 {from key ar
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  }  }
# Line 411  proc ::tcldrop::server::Loaded {type} { Line 398  proc ::tcldrop::server::Loaded {type} {
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  }  }

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26