[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Tcldrop/CVS] tcldrop ./tcldrop doc/tcl-commands.txt modules/...
From: |
Philip Moore |
Subject: |
[Tcldrop/CVS] tcldrop ./tcldrop doc/tcl-commands.txt modules/... |
Date: |
Sat, 06 Dec 2003 02:45:19 -0500 |
CVSROOT: /cvsroot/tcldrop
Module name: tcldrop
Branch:
Changes by: Philip Moore <address@hidden> 03/12/06 02:45:19
Modified files:
. : tcldrop
doc : tcl-commands.txt
modules : conn.tcl core.tcl dcc.tcl
modules/server : server.tcl
Log message:
YAY! Savannah is back up. So this is all the changes I've made since
it was down.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/tcldrop.diff?tr1=1.6&tr2=1.7&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/doc/tcl-commands.txt.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/conn.tcl.diff?tr1=1.11&tr2=1.12&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/core.tcl.diff?tr1=1.32&tr2=1.33&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/dcc.tcl.diff?tr1=1.33&tr2=1.34&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/server/server.tcl.diff?tr1=1.17&tr2=1.18&r1=text&r2=text
Patches:
Index: tcldrop/doc/tcl-commands.txt
diff -u tcldrop/doc/tcl-commands.txt:1.4 tcldrop/doc/tcl-commands.txt:1.5
--- tcldrop/doc/tcl-commands.txt:1.4 Thu Nov 13 20:13:40 2003
+++ tcldrop/doc/tcl-commands.txt Sat Dec 6 02:45:19 2003
@@ -547,6 +547,8 @@
channel info <name>
Returns: a list of info about the specified channel's settings.
+ COMPATIBILITY WARNING: Tcldrop doesn't return the info in
+ the same format that Eggdrop does.
Module: channels
channel get <name> <setting>
Index: tcldrop/modules/conn.tcl
diff -u tcldrop/modules/conn.tcl:1.11 tcldrop/modules/conn.tcl:1.12
--- tcldrop/modules/conn.tcl:1.11 Tue Dec 2 22:39:41 2003
+++ tcldrop/modules/conn.tcl Sat Dec 6 02:45:19 2003
@@ -3,7 +3,7 @@
# * The connect and control commands, used for all outgoing
connections.
# Depends: idx.
#
-# $Id: conn.tcl,v 1.11 2003/12/03 03:39:41 fireegl Exp $
+# $Id: conn.tcl,v 1.12 2003/12/06 07:45:19 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -32,7 +32,7 @@
namespace eval ::tcldrop::conn {
variable version {0.7}
package provide tcldrop::conn $version
- variable rcsid {$Id: conn.tcl,v 1.11 2003/12/03 03:39:41 fireegl Exp $}
+ variable rcsid {$Id: conn.tcl,v 1.12 2003/12/06 07:45:19 fireegl Exp $}
variable Defaults
if {![info exists ::my-ip]} { set ::my-ip {} }
set Defaults(global) [list {async} {1} {buffering} {line} {myaddr}
${::my-ip} {blocking} {0} {timeout} {237}]
@@ -53,8 +53,7 @@
{GLOBAL} - {DEFAULTS} - {DEFAULT} - {*} - {} { set type
{global} }
{default} { set type [string tolower $type] }
}
- # Then override the global defaults with
- # the previously saved defaults for $type:
+ # Then override the global defaults with the previously saved defaults
for $type:
if {[info exists Defaults($type)]} { array set options $Defaults($type)
}
# Finally override those with the ones provided in $connoptions:
set proxynum 0
@@ -81,39 +80,29 @@
proc ::tcldrop::conn::config {{type {-}} args} { Config $type $args }
proc ::tcldrop::conn::connect {address port args} {
- set idx [::tcldrop::idx::Assign]
- ::tcldrop::idx::Register $idx [list idx $idx timestamp [unixtime]]
array set options [Config - $args]
- ::tcldrop::idx::ChInfo $idx [array get options]
if {$options(async)} { set async {-async} } else { set async {} }
- if {[info exists options(myaddr)] && $options(myaddr) != {}} {
- set fail [catch { eval {socket} $async {-myaddr}
{$options(myaddr)} {$address} {$port} } sock]
- } else {
- set fail [catch { eval {socket} $async {$address} {$port} }
sock]
- }
- if {!$fail} {
+ if {[info exists options(myaddr)] && $options(myaddr) != {}} { set
myaddr "-myaddr $options(myaddr)" } else { set myaddr {} }
+ if {![catch { eval {socket} $async $myaddr {$address} {$port} } sock]} {
fconfigure $sock -buffering $options(buffering) -blocking
$options(blocking)
+ set idx [::tcldrop::idx::Assign]
+ ::tcldrop::idx::Register $idx [concat [array get options] [list
idx $idx timestamp [clock seconds] sock $sock connecttimer [utimer
$options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]]]
fileevent $sock writable [list ::tcldrop::conn::Write $idx]
fileevent $sock readable [list ::tcldrop::conn::Read $idx]
- ::tcldrop::idx::ChInfo $idx [list sock $sock connecttimer
[utimer $options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]]
return $idx
} else {
- killidx $idx
return -code error $sock
}
}
proc ::tcldrop::conn::controlsock {sock args} {
if {![eof $sock]} {
- set idx [::tcldrop::idx::Assign]
- ::tcldrop::idx::Register $idx [list idx $idx timestamp
[unixtime]]
array set options [Config - $args]
- ::tcldrop::idx::ChInfo $idx [array get options]
- ::tcldrop::idx::ChInfo $idx [list sock $sock]
fconfigure $sock -buffering $options(buffering) -blocking
$options(blocking)
+ set idx [::tcldrop::idx::Assign]
fileevent $sock writable [list ::tcldrop::conn::Write $idx]
fileevent $sock readable [list ::tcldrop::conn::Read $idx]
- ::tcldrop::idx::ChInfo $idx [list connecttimer [utimer
$options(timeout) [list ::tcldrop::conn::ConnectTimeout $idx]]]
+ ::tcldrop::idx::Register $idx [concat [array get options] [list
sock $sock idx $idx timestamp [unixtime] connecttimer [utimer $options(timeout)
[list ::tcldrop::conn::ConnectTimeout $idx]]]]
return $idx
} else {
return -code error $sock
@@ -125,25 +114,32 @@
::tcldrop::idx::ChInfo $idx [list control $command]
}
+# FixMe: Clean up the duplicate code here.
proc ::tcldrop::conn::Read {idx} {
foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
if {[set error [fconfigure $idxinfo(sock) -error]] != {}} {
putloglev d * "net: error!(connect) idx $idx (${error})"
catch { killutimer $idxinfo(connecttimer) }
+ killidx $idx
# Send {} to the control proc and kill the sock/idx. Note, A
check on valididx (from the control proc) is one way to tell wether or not an
EOF has actually been received.
$idxinfo(control) $idx {}
- killidx $idx
+ if {[info exists idxinfo(errors)]} { $idxinfo(errors) $idx
$error }
} elseif {[eof $idxinfo(sock)]} {
putloglev d * "net: eof!(read) idx $idx"
+ killidx $idx
# Send {} to the control proc and kill the sock/idx. Note, A
check on valididx (from the control proc) is one way to tell wether or not an
EOF has actually been received.
$idxinfo(control) $idx {}
- killidx $idx
+ if {[info exists idxinfo(errors)]} { $idxinfo(errors) $idx
{EOF} }
} elseif {[info exists idxinfo(control)]} {
# For speed, we process all available lines. (This is
absolutely necessary when running inside an Eggdrop, because Eggdrop's event
loops are 1 second apart)
- while {[gets $idxinfo(sock) line] >= 1} { $idxinfo(control)
$idx $line }
+ while {[gets $idxinfo(sock) line] >= 1} {
+ set starttime [clock clicks]
+ $idxinfo(control) $idx $line
+ putloglev d * "conn: process time: [expr {[clock
clicks] - $starttime}]"
+ }
} else {
putloglev d * "net: control!(read) idx $idx (no control proc
defined!)"
- killidx $idx
+ # killidx $idx
}
}
@@ -160,4 +156,5 @@
catch { killutimer $idxinfo(connecttimer) }
catch { fileevent $idxinfo(sock) writable {} }
killidx $idx
+ if {[info exists idxinfo(errors)]} { $idxinfo(errors) $idx {Connect
Timeout} }
}
Index: tcldrop/modules/core.tcl
diff -u tcldrop/modules/core.tcl:1.32 tcldrop/modules/core.tcl:1.33
--- tcldrop/modules/core.tcl:1.32 Tue Dec 2 22:39:41 2003
+++ tcldrop/modules/core.tcl Sat Dec 6 02:45:19 2003
@@ -1,6 +1,6 @@
# core.tcl --
#
-# $Id: core.tcl,v 1.32 2003/12/03 03:39:41 fireegl Exp $
+# $Id: core.tcl,v 1.33 2003/12/06 07:45:19 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -30,8 +30,7 @@
# config-eval if it exists will be eval'd before searching for the config file.
# So if you set the config variable inside config-eval, the config file will
be loaded after the eval on config-eval is done.
-# FixMe: $config should be loaded first if the variable exists, before
-# we eval $config-eval.
+# FixMe: $config should be loaded first if the variable exists, before we eval
$config-eval.
# We create a namespace under this one called tcldrop..
# All procs and vars that should not be visible to 3rd-party scripters
@@ -42,12 +41,10 @@
set numversion {00040000}
set version [list $ver $numversion]
namespace eval tcldrop {
- # In case this command doesn't already exist:
- if {[info commands Stdout] == {}} { proc Stdout {levels channel text} {
puts "[clock format [clock seconds] -format {[%H:%M]}] $text" } }
- # Provide the users module:
+ variable rcsid {$Id: core.tcl,v 1.33 2003/12/06 07:45:19 fireegl Exp $}
variable version {0.4}
+ # Provide the core module:
package provide tcldrop::core $version
- variable rcsid {$Id: core.tcl,v 1.32 2003/12/03 03:39:41 fireegl Exp $}
# Initialize variables:
variable Binds
variable Timers
@@ -56,6 +53,8 @@
array set Traffic {}
# Export all the commands that should be available to 3rd-party
scripters:
namespace export bind unbind binds timer utimer killtimer killutimer
timers utimers maskhost isbotnetnick logfile traffic
+ # In case this command doesn't already exist:
+ if {[info commands Stdout] == {}} { proc Stdout {levels channel text} {
puts "[clock format [clock seconds] -format {[%H:%M]}] $text" } }
}
# Add our modules directory to the package require search path:
@@ -90,6 +89,23 @@
::tcldrop::SetDefault hourly-updates {00}
::tcldrop::SetDefault log-time {1}
+proc debugproc {name arg body} {
+ proc $name $arg "
+ global proctrack
+ if \{!\[info exists proctrack\($name\)\]\} \{
+ array set procinfo \[list count 0 clicks 0\]
+ \} else \{
+ array set procinfo \$proctrack\($name\)
+ \}
+ incr procinfo\(count\)
+ set StartTime \[clock clicks\]
+ set RetVal \[catch \{ $body \} Return\]
+ incr procinfo\(clicks\) \[expr \{ \[clock clicks\] -
\$StartTime \}\]
+ set proctrack\($name\) \[array get procinfo\]
+ return -code \$RetVal \$Return
+ "
+}
+
proc unixtime {} { clock seconds }
proc rand {maxint} { expr { int(rand()*$maxint) } }
@@ -317,21 +333,25 @@
array set bind $Binds($b)
lappend matchbinds [list $bind(type) $bind(flags) $bind(mask)
$bind(count) $bind(proc)]
}
- if {[llength $matchbinds] == 0} {
- # If none were found by type, we search by mask:
- # FixMe: This is too slow!
- foreach b [lsort -dictionary [array names Binds]] {
- array set bind $Binds($b)
- if {[string equal -nocase $typemask $bind(mask)]} {
- lappend matchbinds [list $bind(type)
$bind(flags) $bind(mask) $bind(count) $bind(proc)]
- }
- }
- }
- if {[info exists matchbinds]} { return $matchbinds } else { list }
+ # FixMe: Searching for masks this way is WAY too slow:
+ #if {[llength $matchbinds] == 0} {
+ # # If none were found by type, we search by mask:
+ # # FixMe: This is too slow!
+ # foreach b [lsort -dictionary [array names Binds]] {
+ # array set bind $Binds($b)
+ # if {[string equal -nocase $typemask $bind(mask)]} {
+ # lappend matchbinds [list $bind(type)
$bind(flags) $bind(mask) $bind(count) $bind(proc)]
+ # }
+ # }
+ #}
+ #if {[info exists matchbinds]} { return $matchbinds } else { list }
+ set matchbinds
}
# Counts how many times a bind has been triggered:
proc ::tcldrop::countbind {type mask proc {priority {*}}} {
+ # FixMe: Returning here, so I can speed test some other stuff.
+ return 0
variable Binds
foreach name [array names Binds $type,$priority,$proc,$mask] {
array set bind $Binds($name)
@@ -443,15 +463,17 @@
# often should use the timer command and its -1 (repeat forever) option.
proc ::tcldrop::calltime {} {
foreach {minute hour day month year} [set current [clock format [clock
seconds] -format {%M %H %e %m %Y}]] {}
- foreach b [binds time] { update
+ foreach b [binds time] {
foreach {type flags mask count proc} $b {}
if {[string match $mask $current]} {
- countbind $type $mask $proc
if {[catch { $proc $minute $hour $day $month $year }
err]} {
putlog "Error in $proc: $err"
puterrlog "$::errorInfo"
}
+ countbind $type $mask $proc
}
+ # Call update so other events can be triggered.. This is one
place where it should be safe to call [update] without the worry of having
events being triggered out of order.
+ update
}
}
@@ -461,6 +483,7 @@
# This proc is from address@hidden
# (Papillon) -> I've enabeled this to apply to ipv6 hosts aswell, it does not
mask them yet, but I'll look into it
# Note: This is untested and unmodified.
+# FixMe: I'd rather this not use regexp's if possible.. regexp is slow, and
therefore evil. =P
proc ::tcldrop::maskhost {x} {
if {[string match "*\**" [lindex [split $x @] 1]]} { return $x }
if {![regexp "address@hidden" $x]} { set x "address@hidden" }
@@ -491,7 +514,7 @@
array set info $Traffic($type)
} else {
# Initialize the counts.
- array set info [list total-in 0 total-out 0 daily-in 0
daily-out 0 restart [unixtime]]
+ array set info [list total-in 0 total-out 0 daily-in 0
daily-out 0 restart [clock seconds]]
}
# Increase the counters:
if {$bytes} {
@@ -499,8 +522,8 @@
incr info(daily-$direction) $bytes
}
# See if 24 hours have elapsed, and if it has then clear the
daily counts.
- if {[expr { [unixtime] - $info(restart) > 86400 }]} {
- array set info [list daily-in 0 daily-out 0 restart
[unixtime]]
+ if {[expr { [clock seconds] - $info(restart) > 86400 }]} {
+ array set info [list daily-in 0 daily-out 0 restart
[clock seconds]]
}
# Write the new counts back to the Traffic variable:
set Traffic($type) [array get info]
@@ -522,7 +545,7 @@
incr total(daily-out) $info(daily-out)
incr total(daily-in) $info(daily-in)
}
- list Total $total(daily-in) $total(total-in) $total(daily-out)
$total(total-out)
+ lappend out [list total $total(daily-in) $total(total-in)
$total(daily-out) $total(total-out)]
}
}
@@ -546,15 +569,8 @@
variable Modules
if {[info exists "::tcldrop::${module}::version"]} { set modver
[set "::tcldrop::${module}::version"] } else { set modver {0.0} }
set Modules($module) $modver
- # Import the commands...
- # This imports them into the tcldrop namespace:
- # Note, We could use -force here, but we need to see conflicts
when they show up and fix them...
- if {[catch { namespace eval tcldrop "namespace import
${module}::*" } err]} { puterrlog $err }
+ # Import the commands... (Note, We could use -force here, but
we need to see conflicts when they show up and fix them...)
if {[catch { namespace import "::tcldrop::${module}::*" } err]}
{ puterrlog $err }
- # Note, the reason for importing the commands to both the
tcldrop
- # and the global namespace is so that in case we're not running
- # in our own interp we won't disturb what's already there.
-
# Load the corresponding .lang file:
if {[addlang $::lang $module]} {
putlog "[format $::tcldrop::lang(0x20f) $module]"
@@ -588,7 +604,7 @@
foreach {type flags mask count proc} $b {}
if {[string match -nocase $mask $module]} {
if {[catch { $proc $module } err]} {
- putlog "Error in $proc: $err"
+ putlog "Error in $proc $module: $err"
puterrlog "$::errorInfo"
}
::tcldrop::countbind $type $mask $proc
@@ -604,10 +620,11 @@
foreach b [binds evnt] {
foreach {type flags mask count proc} $b {}
if {[string equal -nocase $event $mask]} {
- ::tcldrop::countbind $type $mask $proc
if {[catch { $proc $event } err]} {
- putlog "error running $proc
$event:\n$::errorInfo"
+ putlog "Error in $proc $event: $err"
+ puterrlog "$::errorInfo"
}
+ ::tcldrop::countbind $type $mask $proc
}
}
}
@@ -726,5 +743,4 @@
close stdin
}
}
-}
-
+}
\ No newline at end of file
Index: tcldrop/modules/dcc.tcl
diff -u tcldrop/modules/dcc.tcl:1.33 tcldrop/modules/dcc.tcl:1.34
--- tcldrop/modules/dcc.tcl:1.33 Tue Dec 2 04:27:14 2003
+++ tcldrop/modules/dcc.tcl Sat Dec 6 02:45:19 2003
@@ -1,6 +1,6 @@
# dcc.tcl --
#
-# $Id: dcc.tcl,v 1.33 2003/12/02 09:27:14 fireegl Exp $
+# $Id: dcc.tcl,v 1.34 2003/12/06 07:45:19 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -32,7 +32,7 @@
# Provide the users module:
variable version {0.4}
package provide tcldrop::dcc $version
- variable rcsid {$Id: dcc.tcl,v 1.33 2003/12/02 09:27:14 fireegl Exp $}
+ variable rcsid {$Id: dcc.tcl,v 1.34 2003/12/06 07:45:19 fireegl Exp $}
#checkmodule console
# Export all the commands that should be available to 3rd-party
scripters:
namespace export dcclist listen putdcc getchan setchan console echo
strip idx2hand hand2idx link bots islinked putbot putallbots sock2idx idx2sock
@@ -252,6 +252,7 @@
}
proc ::tcldrop::dcc::Read {idx line} {
+ set starttime [clock clicks]
foreach {a d} [::tcldrop::idx::Info $idx] { array set chatinfo $d }
switch -- $chatinfo(type) {
{TELNET_ID} {
@@ -395,6 +396,7 @@
}
{default} { }
}
+ putloglev d * "dcc: process time: [expr {[clock clicks] - $starttime}]"
}
proc ::tcldrop::dcc::BOTWrite {idx} {
Index: tcldrop/modules/server/server.tcl
diff -u tcldrop/modules/server/server.tcl:1.17
tcldrop/modules/server/server.tcl:1.18
--- tcldrop/modules/server/server.tcl:1.17 Tue Dec 2 23:08:36 2003
+++ tcldrop/modules/server/server.tcl Sat Dec 6 02:45:19 2003
@@ -1,6 +1,6 @@
# server.tcl --
#
-# $Id: server.tcl,v 1.17 2003/12/03 04:08:36 fireegl Exp $
+# $Id: server.tcl,v 1.18 2003/12/06 07:45:19 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -27,7 +27,7 @@
namespace eval ::tcldrop::server {
variable version {0.8}
- variable rcsid {$Id: server.tcl,v 1.17 2003/12/03 04:08:36 fireegl Exp
$}
+ variable rcsid {$Id: server.tcl,v 1.18 2003/12/06 07:45:19 fireegl Exp
$}
# Provide the server module:
package provide tcldrop::server $version
# Initialize variables:
@@ -65,6 +65,7 @@
proc ::tcldrop::server::isbotnick {nick} { string equal -nocase $nick
$::botnick }
proc ::tcldrop::server::Read {idx line} {
+ set starttime [clock clicks]
if {[valididx $idx]} {
putloglev r * "address@hidden $line"
set lline [split $line]
@@ -85,6 +86,7 @@
} else {
Error {EOF} {Got EOF From Server}
}
+ putloglev d * "raw: process time: [expr {[clock clicks] - $starttime}]"
}
# Sends the NICK and USER info to the IRC server as soon as the socket is open:
@@ -110,7 +112,6 @@
callevent predisconnect-server
global server-online server real-server server-idx
putnow "QUIT :$reason"
- killidx ${server-idx}
set server-online 0
set server-idx 0
set server {}
@@ -120,6 +121,8 @@
proc ::tcldrop::server::server {{serv {}} {port 0} {password {}}} {
global server servers default-port server-online my-ip server-timeout
server-idx
+ # FixMe: There should be a global option to decide weather to choose a
random server,
+ # or to go in the same order as the $servers list.
if {$serv == {}} {
if {[set port [lindex [split [set serv [lindex $servers [rand
[llength $servers]]]] :] 1]] != {}} {
set serv [lindex [split $serv :] 0]
@@ -130,38 +133,28 @@
callevent connect-server
variable TimerID
catch { killutimer $TimerID }
- 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 ${server-timeout}
-myaddr ${my-ip} -control ::tcldrop::server::Read -errors
::tcldrop::server::Error -writable ::tcldrop::server::Write } idx]
if {!$fail} {
::tcldrop::idx::ChInfo $idx [list handle (server) remote $serv
hostname $serv port $port type SERVER other serv traffictype irc timestamp [set
timestamp [unixtime]]]
# Eggdrop compatibility stuff:
set server "$serv:$port"
set server-online $timestamp
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]]
} else {
+ # Wait $server-cycle-wait before trying again.
set TimerID [utimer ${server-cycle-wait} [list
::tcldrop::server::server]]
}
return "$serv:$port"
}
-proc ::tcldrop::server::ConnectTimeout {idx} {
- if {![valididx $idx]} { Error {CONNECT_TIMEOUT} "Timeout during
connect" }
-}
-
# This procs job is to close the current server connection,
# and then wait until it's time to connect to another.
-proc ::tcldrop::server::Error {type {reason {Error}}} {
- quit "$type: $reason"
+proc ::tcldrop::server::Error {idx {reason {Error}}} {
+ quit $reason
utimer ${::server-cycle-wait} [list ::tcldrop::server::server]
}
-proc ::tcldrop::server::ConnectErrors {idx reason} {
- Error {CONNECT_ERROR} $reason
-}
-
proc ::tcldrop::server::jump {{server {}} {port 0} {password {}}} {
- if {$port == 0} { set port ${::default-port} }
if {${::server-online}} { quit {Changing Servers...} }
server $server $port $password
}
@@ -220,20 +213,21 @@
variable SentData
# Add the current milliseconds for this line to the list..
lappend SentData(lastclicks) [clock clicks -milliseconds]
- # And make sure there's only at most 5 in the list..
+ # Make sure there's only at most 5 in the list..
if {[llength $SentData(lastclicks)] > 5} { set SentData(lastclicks)
[lrange $SentData(lastclicks) end-4 end] }
set allowance 0
# See how much allowance we've saved up for bursts:
- foreach b $SentData(lastclicks) {
- incr allowance [expr {[clock clicks -milliseconds] - $b}]
- }
- putloglev d * "total allowance: $allowance"
+ foreach b $SentData(lastclicks) { incr allowance [expr {[clock clicks
-milliseconds] - $b}] }
+ # > 50000 means we haven't bursted our 5 lines in 10 seconds allowance..
if {$allowance > 50000} {
- # > 50000 means we haven't bursted our 5 lines in 10 seconds
allowance..
+ # Note, it's possible that this gives a percent over 100..
+ putloglev d * {burst: 1}
# Let's spend our allowance! =D
set penalty 0
} else {
+ putloglev d * {burst: 0}
# We can't burst any more, so apply the penalties...
+ # Note that 1000 (ms) equals 1 second....
switch -- [string toupper [lindex [split $line] 0]] {
{INVITE} { set penalty 3000 }
{JOIN} { set penalty 2000 }
@@ -245,6 +239,8 @@
{ISON} { set penalty 1000 }
{WHOIS} { set penalty 2000 }
{DNS} { set penalty 2000 }
+ {PING} { set penalty 100 }
+ {PONG} { set penalty 100 }
{default} {
# The number of destinations (targets) for the
command:
# Note: it's possible that targets can be 0, if
the command
@@ -322,7 +318,7 @@
# We process the next queue on the next iteration..
}
} elseif {$queue == 0} {
- # What?! We didn't wait long enough!? How is that possible! =P
+ # What?! We didn't wait long enough!? How is that possible! =/
# Anyways, let's wait out the rest of the time, plus a little
bit more and try again..
after [expr {$SentData(penalty) - $waited + 99}] [list
::tcldrop::server::Queue 0]
}
Index: tcldrop/tcldrop
diff -u tcldrop/tcldrop:1.6 tcldrop/tcldrop:1.7
--- tcldrop/tcldrop:1.6 Tue Dec 2 23:08:36 2003
+++ tcldrop/tcldrop Sat Dec 6 02:45:19 2003
@@ -2,7 +2,7 @@
# The next line restarts using tclsh \
exec tclsh8.5 "$0" ${1+"$@"}
-# $Id: tcldrop,v 1.6 2003/12/03 04:08:36 fireegl Exp $
+# $Id: tcldrop,v 1.7 2003/12/06 07:45:19 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -42,7 +42,9 @@
# -m userfile creation mode
# optional config filename (default 'eggdrop.conf')
+
# FixMe: Need proper command-line option handling.
+
source [file join [file dirname [info script]] tcldrop.tcl]
namespace eval tcldrop { global argv
variable configs {}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Tcldrop/CVS] tcldrop ./tcldrop doc/tcl-commands.txt modules/...,
Philip Moore <=