[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Tcldrop/CVS] tcldrop/modules conn.tcl channels/channels.tcl ...
From: |
Philip Moore |
Subject: |
[Tcldrop/CVS] tcldrop/modules conn.tcl channels/channels.tcl ... |
Date: |
Tue, 02 Dec 2003 04:01:48 -0500 |
CVSROOT: /cvsroot/tcldrop
Module name: tcldrop
Branch:
Changes by: Philip Moore <address@hidden> 03/12/02 04:01:47
Modified files:
modules : conn.tcl
modules/channels: channels.tcl channels_arraydb.tcl
modules/server : server.tcl
modules/users : users.tcl
Log message:
Bugfixes all over the place.. =)
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/conn.tcl.diff?tr1=1.8&tr2=1.9&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels.tcl.diff?tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/channels/channels_arraydb.tcl.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/server/server.tcl.diff?tr1=1.15&tr2=1.16&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/users/users.tcl.diff?tr1=1.20&tr2=1.21&r1=text&r2=text
Patches:
Index: tcldrop/modules/channels/channels.tcl
diff -u tcldrop/modules/channels/channels.tcl:1.13
tcldrop/modules/channels/channels.tcl:1.14
--- tcldrop/modules/channels/channels.tcl:1.13 Mon Dec 1 23:22:44 2003
+++ tcldrop/modules/channels/channels.tcl Tue Dec 2 04:01:46 2003
@@ -1,6 +1,6 @@
# channels.tcl --
#
-# $Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl Exp $
+# $Id: channels.tcl,v 1.14 2003/12/02 09:01:46 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -28,11 +28,8 @@
namespace eval ::tcldrop::channels {
# Provide the channels module:
variable version {0.8}
- variable rcsid {$Id: channels.tcl,v 1.13 2003/12/02 04:22:44 fireegl
Exp $}
+ variable rcsid {$Id: channels.tcl,v 1.14 2003/12/02 09:01:46 fireegl
Exp $}
package provide tcldrop::channels $version
- # Initialize variables:
- variable Udefs
- array set Udefs {}
# Export all the commands that should be available to 3rd-party
scripters:
namespace export channel channels loadchannels savechannels validchan
setudef renudef deludef countchannels
# Set the default channel database module:
@@ -59,17 +56,6 @@
::tcldrop::SetDefault global-exempt-time 29
::tcldrop::SetDefault global-chanset [list -autoop -autovoice -bitch -cycle
+dontkickops +dynamicbans +dynamicexempts +dynamicinvites -enforcebans -greet
-inactive -nodesynch -protectfriends -protectops -revenge -revengebot -secret
-seen +shared -statuslog +userbans +userexempts +userinvites -protecthalfops
-autohalfop]
-# Gives the type of the udef given in $name:
-# It returns one of the following: int, flag, str, list, or unknown.
-proc ::tcldrop::channels::UdefType {name} {
- variable Udefs
- if {[info exists Udefs($name)]} {
- return $Udefs($name)
- } else {
- return {unknown}
- }
-}
-
proc ::tcldrop::channels::channel {command channel args} {
foreach a [binds channels channel] {
foreach {type flags mask count proc} $a {}
@@ -154,22 +140,6 @@
}
}
-proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {
- variable Channels
- variable UdefDefaults
- foreach c [array names Channels] {
- array set chaninfo $Channels($c)
- foreach n [array names UdefDefaults $name] {
- if {![info exists chaninfo($n)]} {
- # It's not already set, so we set it to the
default:
- set chaninfo($n) $UdefDefaults($n)
- set Channels($c) [array get chaninfo]
- }
- }
- array unset chaninfo
- }
-}
-
# Loads the channel info from $chanfile:
proc ::tcldrop::channels::loadchannels {} {
foreach a [binds channels loadchannels] {
@@ -189,7 +159,6 @@
} else {
return -code error {No channel database module has been loaded.}
}
- SetUdefDefaults
}
# Returns 1 if a channel exists in the channel database, or 0 if it doesn't:
@@ -218,32 +187,23 @@
# Defines a new udef:
proc ::tcldrop::channels::setudef {type name {default {}}} {
- # Store the default for this udef:
- variable UdefDefaults
- switch -- $type {
- {flag} {
- switch -- $default {
- {1} - {+} { set UdefDefaults($name) 1 }
- {0} - {-} - {default} { set UdefDefaults($name)
0 }
- }
- }
- {int} {
- if {$default != {}} {
- set UdefDefaults($name) $default
- } else {
- set UdefDefaults($name) 0
- }
+ foreach a [binds channels setudef] {
+ foreach {bindtype flags mask count proc} $a {}
+ if {[set lev [catch { $proc $type $name } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
}
- {str} - {list} { set UdefDefaults($name) $default }
- {default} {
- # FixMe: Give an invalid type error.
+ ::tcldrop::countbind $bindtype $mask $proc
+ if {![info exists retval]} {
+ set retlev $lev
+ set retval $val
}
}
- # Store the udef itself:
- variable Udefs
- set Udefs($name) [string tolower $type]
- # Apply the default to all channels that don't already have it set:
- SetUdefDefaults $name
+ if {[info exists retval]} {
+ return -code $retlev $retval
+ } else {
+ return -code error {No channel database module has been loaded.}
+ }
}
# renudef <flag/int> <oldname> <newname>
@@ -253,33 +213,25 @@
# Proc written by address@hidden
# FixMe: This proc is untested and unmodified from what he sent me.
proc ::tcldrop::channels::renudef {type oldname newname} {
- variable Channels
- variable Udefs
- variable UdefDefaults
- if {[info exists Udefs($oldname)] && [string compare -nocase
$Udefs($oldname) $type]} {
- #just delete this loop if you don't want it to rename the udef
in all channels
- foreach c [array names Channels] {
- array set chaninfo $Channels($c)
- foreach n [array names UdefDefaults $oldname] {
- if {[info exists chaninfo($n)]} {
- set chaninfo($newname) $UdefDefaults($n)
- set Channels($c) [array get chaninfo]
- array unset Channels $n
- }
- }
- array unset chaninfo
+ foreach a [binds channels renudef] {
+ foreach {bindtype flags mask count proc} $a {}
+ if {[set lev [catch { $proc $type $oldname $newname } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
+ }
+ ::tcldrop::countbind $bindtype $mask $proc
+ if {![info exists retval]} {
+ set retlev $lev
+ set retval $val
}
-
- set tempUdefs($newname) $Udefs($oldname)
- set tempDefaults($newname) $Udefs($oldname)
- array unset Udefs $oldname
- array unset UdefDefaults $oldname
- array set Udefs [array get tempUdefs]
- array set UdefDefaults [array get tempDefaults]
+ }
+ if {[info exists retval]} {
+ return -code $retlev $retval
+ } else {
+ return -code error {No channel database module has been loaded.}
}
}
-
# deludef <flag/int> <name>
# Description: deletes a user defined channel flag or integer setting.
# Returns: nothing
@@ -287,23 +239,22 @@
# Proc written by address@hidden
# FixMe: This proc is untested and unmodified from what he sent me.
proc ::tcldrop::channels::deludef {type name} {
- variable Channels
- variable Udefs
- variable UdefDefaults
- if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name)
$type]} {
- #just delete this loop if you don't want it to remove the udef
from all channels
- foreach c [array names Channels] {
- array set chaninfo $Channels($c)
- foreach n [array names UdefDefaults $name] {
- if {[info exists chaninfo($n)]} {
- array unset Channels $n
- }
- }
- array unset chaninfo
+ foreach a [binds channels deludef] {
+ foreach {bindtype flags mask count proc} $a {}
+ if {[set lev [catch { $proc $type $name } val]]} {
+ putlog "Error in script: $proc: $val"
+ puterrlog "$::errorInfo"
}
-
- array unset Udefs $name
- array unset UdefDefaults $name
+ ::tcldrop::countbind $bindtype $mask $proc
+ if {![info exists retval]} {
+ set retlev $lev
+ set retval $val
+ }
+ }
+ if {[info exists retval]} {
+ return -code $retlev $retval
+ } else {
+ return -code error {No channel database module has been loaded.}
}
}
@@ -322,6 +273,17 @@
# Note, these settings are defined here, but their actual functions are in the
irc module (or possibly other modules).
namespace eval ::tcldrop::channels {
+ set dbpriority 1
+ # Load all of the database modules..
+ foreach n $channeldbs {
+ loadmodule "channels::$n"
+ foreach c [namespace export] {
+ if {[info commands "::tcldrop::channels::${n}::$c"] !=
{}} {
+ bind channels {+|+} $c
"::tcldrop::channels::${n}::$c" -priority $dbpriority
+ }
+ }
+ incr dbpriority
+ }
setudef str chanmode ${global-chanmode}
setudef int idle-kick ${global-idle-kick}
setudef int stopnethack-mode ${global-stopnethack-mode}
@@ -348,17 +310,6 @@
if {$n != {}} {
setudef flag [string range $n 1 end] [string index $n 0]
}
- }
- set dbpriority 1
- # Load all of the database modules..
- foreach n $channeldbs {
- loadmodule "channels::$n"
- foreach c [namespace export] {
- if {[info commands "::tcldrop::channels::${n}::$c"] !=
{}} {
- bind channels {+|+} $c
"::tcldrop::channels::${n}::$c" -priority $dbpriority
- }
- }
- incr dbpriority
}
unset dbpriority n c
}
Index: tcldrop/modules/channels/channels_arraydb.tcl
diff -u tcldrop/modules/channels/channels_arraydb.tcl:1.1
tcldrop/modules/channels/channels_arraydb.tcl:1.2
--- tcldrop/modules/channels/channels_arraydb.tcl:1.1 Mon Dec 1 23:22:44 2003
+++ tcldrop/modules/channels/channels_arraydb.tcl Tue Dec 2 04:01:46 2003
@@ -1,6 +1,6 @@
# channels_arraydb.tcl --
#
-# $Id: channels_arraydb.tcl,v 1.1 2003/12/02 04:22:44 fireegl Exp $
+# $Id: channels_arraydb.tcl,v 1.2 2003/12/02 09:01:46 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -28,37 +28,37 @@
namespace eval ::tcldrop::channels::arraydb {
# Provide the channels::arraydb module:
- variable version {0.1}
- variable rcsid {$Id: channels_arraydb.tcl,v 1.1 2003/12/02 04:22:44
fireegl Exp $}
+ variable version {0.8}
+ variable rcsid {$Id: channels_arraydb.tcl,v 1.2 2003/12/02 09:01:46
fireegl Exp $}
package provide tcldrop::channels::arraydb $version
# Initialize variables:
+ variable Udefs
+ array set Udefs {}
variable Channels
array set Channels {}
+ # Set the internal defaults:
+ ::tcldrop::SetDefault chanfile {tcldrop.chan}
}
-# Set the internal defaults:
-::tcldrop::SetDefault chanfile {tcldrop.chan}
-
proc ::tcldrop::channels::arraydb::channel {command channel opts} {
- # FixMe: Change the args variable name in the rest of this proc...
- set args $opts
variable Channels
set lowerchannel [string tolower $channel]
switch -- $command {
{add} {
- if {[llength $args] > 1} {
- set options $args
+ if {[llength $opts] > 1} {
+ set options $opts
} else {
- set options [lindex $args 0]
+ set options [lindex $opts 0]
}
# Add the channel:
set Channels($lowerchannel) [list name $channel]
# Call ourself again to set the options:
channel set $channel $options
+ SetUdefDefaults
}
{set} {
- # In the case of "set", $args is already in the form we
can use.
- set options $args
+ # In the case of "set", $opts is already in the form we
can use.
+ set options $opts
array set chaninfo $Channels($lowerchannel)
set setnext 0
foreach o $options {
@@ -89,7 +89,7 @@
}
}
} else {
- switch -- [set type
[::tcldrop::channels::UdefType [set name [string trimleft $o {+-}]]]] {
+ switch -- [set type [UdefType [set name
[string trimleft $o {+-}]]]] {
{flag} {
switch -- [string index
$o 0] {
{+} { set
chaninfo($name) 1 }
@@ -121,10 +121,10 @@
{get} {
if {[info exists Channels($lowerchannel)]} {
array set chaninfo $Channels($lowerchannel)
- if {[info exists chaninfo($args)]} {
- return $chaninfo($args)
+ if {[info exists chaninfo($opts)]} {
+ return $chaninfo($opts)
} else {
- return -code error "Unknown channel
setting: $args"
+ return -code error "Unknown channel
setting: $opts"
}
} else {
return -code error "no such channel record:
$channel"
@@ -159,10 +159,9 @@
}
# Saves the channel info to $chanfile:
-proc ::tcldrop::channels::arraydb::savechannels {opts} {
- set args $opts
+proc ::tcldrop::channels::arraydb::savechannels {{opts {}}} {
set fid [open $::chanfile w]
- if {[lsearch $args -flush] != -1} { set flush 1 } else { set flush 0
+ if {[lsearch $opts -flush] != -1} { set flush 1 } else { set flush 0
fconfigure $fid -blocking 0 -buffering full
}
variable Channels
@@ -185,7 +184,7 @@
} else {
putlog "no chanfile exists..yet."
}
- ::tcldrop::channels::SetUdefDefaults
+ SetUdefDefaults
}
# Returns 1 if a channel exists in the channel database, or 0 if it doesn't:
@@ -201,4 +200,124 @@
# Module: channels
#
# channame2dname <channel-name>
-# chandname2name <channel-dname>
\ No newline at end of file
+# chandname2name <channel-dname>
+
+# Gives the type of the udef given in $name:
+# It returns one of the following: int, flag, str, list, or unknown.
+proc ::tcldrop::channels::arraydb::UdefType {name} {
+ variable Udefs
+ if {[info exists Udefs($name)]} {
+ return $Udefs($name)
+ } else {
+ return {unknown}
+ }
+}
+
+proc ::tcldrop::channels::arraydb::SetUdefDefaults {{name {*}}} {
+ variable Channels
+ variable UdefDefaults
+ foreach c [array names Channels] {
+ array set chaninfo $Channels($c)
+ foreach n [array names UdefDefaults $name] {
+ if {![info exists chaninfo($n)]} {
+ # It's not already set, so we set it to the
default:
+ set chaninfo($n) $UdefDefaults($n)
+ set Channels($c) [array get chaninfo]
+ }
+ }
+ array unset chaninfo
+ }
+}
+
+# Note, types for udef's should be: flag, int, str, and list.
+# In the case of lists, the channel command should provide lappend, lreplace,
and lremove commands.
+
+# Defines a new udef:
+proc ::tcldrop::channels::arraydb::setudef {type name {default {}}} {
+ # Store the default for this udef:
+ variable UdefDefaults
+ switch -- $type {
+ {flag} {
+ switch -- $default {
+ {1} - {+} { set UdefDefaults($name) 1 }
+ {0} - {-} - {default} { set UdefDefaults($name)
0 }
+ }
+ }
+ {int} {
+ if {$default != {}} {
+ set UdefDefaults($name) $default
+ } else {
+ set UdefDefaults($name) 0
+ }
+ }
+ {str} - {list} { set UdefDefaults($name) $default }
+ {default} {
+ # FixMe: Give an invalid type error.
+ }
+ }
+ # Store the udef itself:
+ variable Udefs
+ set Udefs($name) [string tolower $type]
+ # Apply the default to all channels that don't already have it set:
+ SetUdefDefaults $name
+}
+
+# renudef <flag/int> <oldname> <newname>
+# Description: renames a user defined channel flag or integer setting.
+# Returns: nothing
+# Module: channels
+# Proc written by address@hidden
+# FixMe: This proc is untested and unmodified from what he sent me.
+proc ::tcldrop::channels::arraydb::renudef {type oldname newname} {
+ variable Channels
+ variable Udefs
+ variable UdefDefaults
+ if {[info exists Udefs($oldname)] && [string compare -nocase
$Udefs($oldname) $type]} {
+ #just delete this loop if you don't want it to rename the udef
in all channels
+ foreach c [array names Channels] {
+ array set chaninfo $Channels($c)
+ foreach n [array names UdefDefaults $oldname] {
+ if {[info exists chaninfo($n)]} {
+ set chaninfo($newname) $UdefDefaults($n)
+ set Channels($c) [array get chaninfo]
+ array unset Channels $n
+ }
+ }
+ array unset chaninfo
+ }
+
+ set tempUdefs($newname) $Udefs($oldname)
+ set tempDefaults($newname) $Udefs($oldname)
+ array unset Udefs $oldname
+ array unset UdefDefaults $oldname
+ array set Udefs [array get tempUdefs]
+ array set UdefDefaults [array get tempDefaults]
+ }
+}
+
+
+# deludef <flag/int> <name>
+# Description: deletes a user defined channel flag or integer setting.
+# Returns: nothing
+# Module: channels
+# Proc written by address@hidden
+# FixMe: This proc is untested and unmodified from what he sent me.
+proc ::tcldrop::channels::arraydb::deludef {type name} {
+ variable Channels
+ variable Udefs
+ variable UdefDefaults
+ if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name)
$type]} {
+ #just delete this loop if you don't want it to remove the udef
from all channels
+ foreach c [array names Channels] {
+ array set chaninfo $Channels($c)
+ foreach n [array names UdefDefaults $name] {
+ if {[info exists chaninfo($n)]} {
+ array unset Channels $n
+ }
+ }
+ array unset chaninfo
+ }
+ array unset Udefs $name
+ array unset UdefDefaults $name
+ }
+}
\ No newline at end of file
Index: tcldrop/modules/conn.tcl
diff -u tcldrop/modules/conn.tcl:1.8 tcldrop/modules/conn.tcl:1.9
--- tcldrop/modules/conn.tcl:1.8 Sun Nov 30 20:59:51 2003
+++ tcldrop/modules/conn.tcl Tue Dec 2 04:01:46 2003
@@ -3,7 +3,7 @@
# * The connect and control commands, used for all outgoing
connections.
# Depends: idx.
#
-# $Id: conn.tcl,v 1.8 2003/12/01 01:59:51 fireegl Exp $
+# $Id: conn.tcl,v 1.9 2003/12/02 09:01:46 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -134,6 +134,10 @@
if {![catch { read -nonewline $idxinfo(sock) } lines]} {
foreach line [split $lines \n] {
$idxinfo(control) $idx $line
+ # The update is here so that one connection can't be
flooded and drown
+ # out the other connections and therefore making them
less responsive.
+ # At least that's what I hope it's good for. =)
+ update
}
} else {
putloglev d * "net: eof!(read) idx $idx"
Index: tcldrop/modules/server/server.tcl
diff -u tcldrop/modules/server/server.tcl:1.15
tcldrop/modules/server/server.tcl:1.16
--- tcldrop/modules/server/server.tcl:1.15 Mon Dec 1 16:38:35 2003
+++ tcldrop/modules/server/server.tcl Tue Dec 2 04:01:46 2003
@@ -1,6 +1,6 @@
# server.tcl --
#
-# $Id: server.tcl,v 1.15 2003/12/01 21:38:35 fireegl Exp $
+# $Id: server.tcl,v 1.16 2003/12/02 09:01:46 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.15 2003/12/01 21:38:35 fireegl Exp
$}
+ variable rcsid {$Id: server.tcl,v 1.16 2003/12/02 09:01:46 fireegl Exp
$}
# Provide the server module:
package provide tcldrop::server $version
# Initialize variables:
@@ -57,7 +57,8 @@
::tcldrop::SetDefault server-cycle-wait {93}
::tcldrop::SetDefault servererror-quit {1}
::tcldrop::SetDefault botname {}
- loadmodule conn
+ ::tcldrop::SetDefault botnick {}
+ checkmodule conn
}
proc ::tcldrop::server::isbotnick {nick} { string equal -nocase $nick
$::botnick }
Index: tcldrop/modules/users/users.tcl
diff -u tcldrop/modules/users/users.tcl:1.20
tcldrop/modules/users/users.tcl:1.21
--- tcldrop/modules/users/users.tcl:1.20 Mon Dec 1 19:57:51 2003
+++ tcldrop/modules/users/users.tcl Tue Dec 2 04:01:47 2003
@@ -1,6 +1,6 @@
# users.tcl --
#
-# $Id: users.tcl,v 1.20 2003/12/02 00:57:51 fireegl Exp $
+# $Id: users.tcl,v 1.21 2003/12/02 09:01:47 fireegl Exp $
#
# Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
#
@@ -51,7 +51,7 @@
namespace eval ::tcldrop::users {
variable version {0.7}
- variable rcsid {$Id: users.tcl,v 1.20 2003/12/02 00:57:51 fireegl Exp $}
+ variable rcsid {$Id: users.tcl,v 1.21 2003/12/02 09:01:47 fireegl Exp $}
# Provide the users module:
package provide tcldrop::users $version
# Export all the commands that should be available to 3rd-party
scripters:
@@ -453,9 +453,6 @@
}
# Saves the user database to the hard disk:
-# The default is to write it in the background (nonblocking).
-# If the -flush option is given, then save doesn't return until it's been
completly written to disk.
-# Note, I don't even know if there's any noticable speed difference by using
nonblocking..
proc ::tcldrop::users::save {args} {
foreach a [binds users save] {
foreach {type flags mask count proc} $a {}
@@ -522,17 +519,19 @@
# The ban, ignore, exempt, and invite related stuff should be in other modules.
# Load all of the database modules..
-set dbpriority 1
-foreach n $userdbs {
- loadmodule "users::$n"
- foreach c {adduser countusers validuser finduser matchattr
matchchanattr userlist passwdok getuser setuser getinfo getchaninfo
getting-users chhandle chattr botattr adduser addbot deluser delhost addchanrec
delchanrec encpass save backup reload chpass setlaston} {
- if {[info commands "::tcldrop::users::${n}::$c"] != {}} {
- bind users {+|+} $c "::tcldrop::users::${n}::$c"
-priority $dbpriority
+namespace eval ::tcldrop::users {
+ set dbpriority 1
+ foreach n $userdbs {
+ loadmodule "users::$n"
+ foreach c [namespace export] {
+ if {[info commands "::tcldrop::users::${n}::$c"] != {}}
{
+ bind users {+|+} $c
"::tcldrop::users::${n}::$c" -priority $dbpriority
+ }
}
+ incr dbpriority
}
- incr dbpriority
+ unset dbpriority n c
}
-unset dbpriority n
# After Tcldrop loads, we (re)load the userfile:
bind evnt - loaded ::tcldrop::users::Loaded -priority 0
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Tcldrop/CVS] tcldrop/modules conn.tcl channels/channels.tcl ...,
Philip Moore <=