tcldrop-commits
[Top][All Lists]
Advanced

[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 {}




reply via email to

[Prev in Thread] Current Thread [Next in Thread]