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

Diff of /tcldrop/modules/users/users.tcl

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

revision 1.18 by fireegl, Mon Dec 1 01:59:52 2003 UTC revision 1.19 by fireegl, Mon Dec 1 23:25:47 2003 UTC
# Line 62  namespace eval ::tcldrop::users { Line 62  namespace eval ::tcldrop::users {
62    
63  # Returns the number of users in the user database:  # Returns the number of users in the user database:
64  proc ::tcldrop::users::countusers {} {  proc ::tcldrop::users::countusers {} {
65          foreach a [binds countusers] {          foreach a [binds users countusers] {
66                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
67                  if {[catch { $proc } val]} {                  if {[catch { $proc } val]} {
68                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 78  proc ::tcldrop::users::countusers {} { Line 78  proc ::tcldrop::users::countusers {} {
78  # Checks to see if $handle is a valid user in the user database:  # Checks to see if $handle is a valid user in the user database:
79  # Returns 1 if they are, 0 if they're not.  # Returns 1 if they are, 0 if they're not.
80  proc ::tcldrop::users::validuser {handle} {  proc ::tcldrop::users::validuser {handle} {
81          foreach a [binds validuser] {          foreach a [binds users validuser] {
82                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
83                  if {[catch { $proc $handle } val]} {                  if {[catch { $proc $handle } val]} {
84                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 95  proc ::tcldrop::users::validuser {handle Line 95  proc ::tcldrop::users::validuser {handle
95  # Returns the matching handle, or "*" if none found.  # Returns the matching handle, or "*" if none found.
96  proc ::tcldrop::users::finduser {nuhost} {  proc ::tcldrop::users::finduser {nuhost} {
97          if {![string match {*!*} $nuhost]} { set nuhost "*!$nuhost" }          if {![string match {*!*} $nuhost]} { set nuhost "*!$nuhost" }
98          foreach a [binds finduser] {          foreach a [binds users finduser] {
99                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
100                  if {[catch { $proc $nuhost } val]} {                  if {[catch { $proc $nuhost } val]} {
101                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 110  proc ::tcldrop::users::finduser {nuhost} Line 110  proc ::tcldrop::users::finduser {nuhost}
110    
111  # Checks $handle for $flags, $channel is optional.  # Checks $handle for $flags, $channel is optional.
112  proc ::tcldrop::users::matchattr {handle flags {channel {}}} {  proc ::tcldrop::users::matchattr {handle flags {channel {}}} {
113          foreach a [binds matchattr] {          foreach a [binds users matchattr] {
114                  foreach {type bindsflags mask count proc} $a {}                  foreach {type bindsflags mask count proc} $a {}
115                  if {[catch { $proc $handle $flags $channel } val]} {                  if {[catch { $proc $handle $flags $channel } val]} {
116                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 130  proc ::tcldrop::users::matchchanattr {ha Line 130  proc ::tcldrop::users::matchchanattr {ha
130    
131  # Returns all the users matching $flags (flags are optional).  # Returns all the users matching $flags (flags are optional).
132  proc ::tcldrop::users::userlist {{flags {}}} {  proc ::tcldrop::users::userlist {{flags {}}} {
133          foreach a [binds userlist] {          foreach a [binds users userlist] {
134                  foreach {type bindsflags mask count proc} $a {}                  foreach {type bindsflags mask count proc} $a {}
135                  if {[catch { $proc $flags } val]} {                  if {[catch { $proc $flags } val]} {
136                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 144  proc ::tcldrop::users::userlist {{flags Line 144  proc ::tcldrop::users::userlist {{flags
144  }  }
145    
146  proc ::tcldrop::users::passwdok {handle {pass {-}}} {  proc ::tcldrop::users::passwdok {handle {pass {-}}} {
147          foreach a [binds passwdok] {          foreach a [binds users passwdok] {
148                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
149                  if {[catch { $proc $handle $pass } val]} {                  if {[catch { $proc $handle $pass } val]} {
150                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 159  proc ::tcldrop::users::passwdok {handle Line 159  proc ::tcldrop::users::passwdok {handle
159    
160  # Gets user related info:  # Gets user related info:
161  proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} {  proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} {
162          foreach a [binds getuser] {          foreach a [binds users getuser] {
163                  foreach {bindtype flags mask count proc} $a {}                  foreach {bindtype flags mask count proc} $a {}
164                  if {[catch { uplevel \#0 $proc $handle $type $xtra } val]} {                  if {[catch { uplevel \#0 $proc $handle $type $xtra } val]} {
165                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 184  proc ::tcldrop::users::getuser {handle { Line 184  proc ::tcldrop::users::getuser {handle {
184  # handle <newhandle, or blank to delete the user>  # handle <newhandle, or blank to delete the user>
185  # It returns the new setting.  # It returns the new setting.
186  proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} {  proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} {
187          foreach a [binds setuser] {          foreach a [binds users setuser] {
188                  foreach {bindtype flags mask count proc} $a {}                  foreach {bindtype flags mask count proc} $a {}
189                  if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} {                  if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} {
190                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 205  proc ::tcldrop::users::setuser {handle { Line 205  proc ::tcldrop::users::setuser {handle {
205    
206  # This is an eggdrop v1.7.0 command:  # This is an eggdrop v1.7.0 command:
207  proc ::tcldrop::users::setlaston {handle when {where {}}} {  proc ::tcldrop::users::setlaston {handle when {where {}}} {
208          foreach a [binds setlaston] {          foreach a [binds users setlaston] {
209                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
210                  if {[set lev [catch { $proc $handle $when $where } val]]} {                  if {[set lev [catch { $proc $handle $when $where } val]]} {
211                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 226  proc ::tcldrop::users::setlaston {handle Line 226  proc ::tcldrop::users::setlaston {handle
226    
227  # Gets a users channel INFO line:  # Gets a users channel INFO line:
228  proc ::tcldrop::users::getchaninfo {handle channel} {  proc ::tcldrop::users::getchaninfo {handle channel} {
229          foreach a [binds getchaninfo] {          foreach a [binds users getchaninfo] {
230                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
231                  if {[set lev [catch { $proc $handle $channel } val]]} {                  if {[set lev [catch { $proc $handle $channel } val]]} {
232                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 247  proc ::tcldrop::users::getting-users {} Line 247  proc ::tcldrop::users::getting-users {}
247    
248  # Renames a user account.  # Renames a user account.
249  proc ::tcldrop::users::chhandle {oldhandle newhandle} {  proc ::tcldrop::users::chhandle {oldhandle newhandle} {
250          foreach a [binds chhandle] {          foreach a [binds users chhandle] {
251                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
252                  if {[set lev [catch { $proc $oldhandle $newhandle } val]]} {                  if {[set lev [catch { $proc $oldhandle $newhandle } val]]} {
253                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 268  proc ::tcldrop::users::chhandle {oldhand Line 268  proc ::tcldrop::users::chhandle {oldhand
268    
269  # Adds/removes a users global/channel flags.  # Adds/removes a users global/channel flags.
270  proc ::tcldrop::users::chattr {handle {flags {}} {channel {}}} {  proc ::tcldrop::users::chattr {handle {flags {}} {channel {}}} {
271          foreach a [binds chattr] {          foreach a [binds users chattr] {
272                  foreach {type bindsflags mask count proc} $a {}                  foreach {type bindsflags mask count proc} $a {}
273                  if {[set lev [catch { $proc $handle $flags $channel } val]]} {                  if {[set lev [catch { $proc $handle $flags $channel } val]]} {
274                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 289  proc ::tcldrop::users::chattr {handle {f Line 289  proc ::tcldrop::users::chattr {handle {f
289    
290  # Adds/removes a bots global/channel bot-specific flags.  # Adds/removes a bots global/channel bot-specific flags.
291  proc ::tcldrop::users::botattr {bothandle {flags {}} {channel {}}} {  proc ::tcldrop::users::botattr {bothandle {flags {}} {channel {}}} {
292          foreach a [binds botattr] {          foreach a [binds users botattr] {
293                  foreach {type bindsflags mask count proc} $a {}                  foreach {type bindsflags mask count proc} $a {}
294                  if {[set lev [catch { $proc $bothandle $flags $channel } val]]} {                  if {[set lev [catch { $proc $bothandle $flags $channel } val]]} {
295                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 311  proc ::tcldrop::users::botattr {bothandl Line 311  proc ::tcldrop::users::botattr {bothandl
311  # Adds a user to the user database, with the optional hostmask:  # Adds a user to the user database, with the optional hostmask:
312  # Returns 1 for success, 0 for failure.  # Returns 1 for success, 0 for failure.
313  proc ::tcldrop::users::adduser {handle {hostmask {}}} {  proc ::tcldrop::users::adduser {handle {hostmask {}}} {
314          foreach a [binds adduser] {          foreach a [binds users adduser] {
315                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
316                  if {[set lev [catch { $proc $handle $hostmask } val]]} {                  if {[set lev [catch { $proc $handle $hostmask } val]]} {
317                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 333  proc ::tcldrop::users::adduser {handle { Line 333  proc ::tcldrop::users::adduser {handle {
333  # Adds a bot to the user database, with the optional address and hostmask:  # Adds a bot to the user database, with the optional address and hostmask:
334  # Returns 1 for success, 0 for failure.  # Returns 1 for success, 0 for failure.
335  proc ::tcldrop::users::addbot {handle {address {}} {hostmask {}}} {  proc ::tcldrop::users::addbot {handle {address {}} {hostmask {}}} {
336          foreach a [binds addbot] {          foreach a [binds users addbot] {
337                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
338                  if {[set lev [catch { $proc $handle $address $hostmask } val]]} {                  if {[set lev [catch { $proc $handle $address $hostmask } val]]} {
339                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 355  proc ::tcldrop::users::addbot {handle {a Line 355  proc ::tcldrop::users::addbot {handle {a
355  # Deletes a user (or bot) from the user database:  # Deletes a user (or bot) from the user database:
356  # Returns 1 for success, 0 for failure.  # Returns 1 for success, 0 for failure.
357  proc ::tcldrop::users::deluser {handle} {  proc ::tcldrop::users::deluser {handle} {
358          foreach a [binds deluser] {          foreach a [binds users deluser] {
359                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
360                  if {[set lev [catch { $proc $handle } val]]} {                  if {[set lev [catch { $proc $handle } val]]} {
361                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 378  proc ::tcldrop::users::deluser {handle} Line 378  proc ::tcldrop::users::deluser {handle}
378  # FixMe: Untested and unmodified.  # FixMe: Untested and unmodified.
379  # Removes a single hostmask, or all hostmasks if none is specified.  # Removes a single hostmask, or all hostmasks if none is specified.
380  proc ::tcldrop::users::delhost {handle {hostmask {}}} {  proc ::tcldrop::users::delhost {handle {hostmask {}}} {
381          foreach a [binds delhost] {          foreach a [binds users delhost] {
382                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
383                  if {[set lev [catch { $proc $handle $hostmask } val]]} {                  if {[set lev [catch { $proc $handle $hostmask } val]]} {
384                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 399  proc ::tcldrop::users::delhost {handle { Line 399  proc ::tcldrop::users::delhost {handle {
399    
400  # Adds a channel record for a user:  # Adds a channel record for a user:
401  proc ::tcldrop::users::addchanrec {handle channel} {  proc ::tcldrop::users::addchanrec {handle channel} {
402          foreach a [binds addchanrec] {          foreach a [binds users addchanrec] {
403                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
404                  if {[set lev [catch { $proc $handle $channel } val]]} {                  if {[set lev [catch { $proc $handle $channel } val]]} {
405                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 420  proc ::tcldrop::users::addchanrec {handl Line 420  proc ::tcldrop::users::addchanrec {handl
420    
421  # Removes a channel record for a user:  # Removes a channel record for a user:
422  proc ::tcldrop::users::delchanrec {handle channel} {  proc ::tcldrop::users::delchanrec {handle channel} {
423          foreach a [binds delchanrec] {          foreach a [binds users delchanrec] {
424                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
425                  if {[set lev [catch { $proc $handle $channel } val]]} {                  if {[set lev [catch { $proc $handle $channel } val]]} {
426                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 440  proc ::tcldrop::users::delchanrec {handl Line 440  proc ::tcldrop::users::delchanrec {handl
440  }  }
441    
442  proc ::tcldrop::users::haschanrec {handle channel} {  proc ::tcldrop::users::haschanrec {handle channel} {
443          foreach a [binds haschanrec] {          foreach a [binds users haschanrec] {
444                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
445                  if {[set lev [catch { $proc $handle $channel } val]]} {                  if {[set lev [catch { $proc $handle $channel } val]]} {
446                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 457  proc ::tcldrop::users::haschanrec {handl Line 457  proc ::tcldrop::users::haschanrec {handl
457  # If the -flush option is given, then save doesn't return until it's been completly written to disk.  # If the -flush option is given, then save doesn't return until it's been completly written to disk.
458  # Note, I don't even know if there's any noticable speed difference by using nonblocking..  # Note, I don't even know if there's any noticable speed difference by using nonblocking..
459  proc ::tcldrop::users::save {args} {  proc ::tcldrop::users::save {args} {
460          foreach a [binds save] {          foreach a [binds users save] {
461                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
462                  if {[set lev [catch { $proc $args } val]]} {                  if {[set lev [catch { $proc $args } val]]} {
463                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 478  proc ::tcldrop::users::save {args} { Line 478  proc ::tcldrop::users::save {args} {
478    
479  # Proc by Papillon@EFNet. (untested/unmodified)  # Proc by Papillon@EFNet. (untested/unmodified)
480  proc ::tcldrop::users::backup {} {  proc ::tcldrop::users::backup {} {
481          foreach a [binds backup] {          foreach a [binds users backup] {
482                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
483                  if {[set lev [catch { $proc } val]]} {                  if {[set lev [catch { $proc } val]]} {
484                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 499  proc ::tcldrop::users::backup {} { Line 499  proc ::tcldrop::users::backup {} {
499    
500  # Reload the userfile from disk:  # Reload the userfile from disk:
501  proc ::tcldrop::users::reload {} {  proc ::tcldrop::users::reload {} {
502          foreach a [binds reload] {          foreach a [binds users reload] {
503                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
504                  if {[set lev [catch { $proc } val]]} {                  if {[set lev [catch { $proc } val]]} {
505                          putlog "Error in script: $proc: $val"                          putlog "Error in script: $proc: $val"
# Line 522  proc ::tcldrop::users::reload {} { Line 522  proc ::tcldrop::users::reload {} {
522  # The ban, ignore, exempt, and invite related stuff should be in other modules.  # The ban, ignore, exempt, and invite related stuff should be in other modules.
523    
524  # Load all of the database modules..  # Load all of the database modules..
525  set dbpriority 1  set dbpriority 0
526  foreach n $userdbs {  foreach n $userdbs {
527          loadmodule "users::$n"          loadmodule "users::$n"
528          incr dbpriority          incr dbpriority
529          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} {          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} {
530                  if {[info commands "::tcldrop::users::${n}::$c"] != {}} {                  if {[info commands "::tcldrop::users::${n}::$c"] != {}} {
531                          bind $c {+|+} {*} "::tcldrop::users::${n}::$c" -priority $dbpriority                          bind users {+|+} $c "::tcldrop::users::${n}::$c" -priority $dbpriority
532                  }                  }
533          }          }
534  }  }

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

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