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

Diff of /tcldrop/modules/irc/irc.tcl

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

revision 1.25 by fireegl, Sat Nov 29 00:50:07 2003 UTC revision 1.26 by fireegl, Sat Nov 29 05:04:29 2003 UTC
# Line 34  namespace eval ::tcldrop::irc { Line 34  namespace eval ::tcldrop::irc {
34          package provide tcldrop::irc $version          package provide tcldrop::irc $version
35          # Initialize variables:          # Initialize variables:
36          # Nicks stores the non-channel specific info for each nick:          # Nicks stores the non-channel specific info for each nick:
37            # Format: Nicks($lowernick) {array data}
38            # Array data contains the following types:
39            # nick, handle, ident, address, and realname (if available).
40          variable Nicks          variable Nicks
41          array set Nicks {}          array set Nicks {}
42    
43          # ChannelNicks stores the channel specific info for each nick:          # ChannelNicks stores the channel specific info for each nick:
44            # Format: ChannelNicks($lowerchannel,$lowernick) {array data}
45            # Array data contains the following types:
46            # op, voice, halfop, jointime, idletime.
47          variable ChannelNicks          variable ChannelNicks
48          array set ChannelNicks {}          array set ChannelNicks {}
49    
50          # Channels stores the non-nick specific info for each channel:          # Channels stores the non-nick specific info for each channel:
51            # Format: Channels($lowerchannel) {array data}
52            # Array data contains the following types:
53            # channel, chanmodes, topic.
54          variable Channels          variable Channels
55          array set Channels {}          array set Channels {}
56    
57          # Bans stores the currently active channel bans:          # Bans stores the currently active channel bans:
58            # Format: Bans($lowerchannel,$lowerban) {array data}
59            # Array data contains the following types:
60            # ban, creator, created, channel.
61          variable Bans          variable Bans
62          array set Bans {}          array set Bans {}
63    
64          # PushModes stores all the modes that need to be pushed to the server when we next hit the Tcl event loop (or when flushmode is called manually).          # PushModes stores all the modes that need to be pushed to the server when we next hit the Tcl event loop (or when flushmode is called manually).
65          variable PushModes          variable PushModes
66          array set PushModes {}          array set PushModes {}
# Line 250  proc ::tcldrop::irc::311 {from key arg} Line 266  proc ::tcldrop::irc::311 {from key arg}
266          set nick [lindex $larg 1]          set nick [lindex $larg 1]
267          set ident [lindex $larg 2]          set ident [lindex $larg 2]
268          set address [lindex $larg 3]          set address [lindex $larg 3]
         #set unknown [lindex $larg 4]  
         set realname [string range [join [lrange $larg 5 end]] 1 end]  
         set handle [finduser "$nick!$ident@$address"]  
         variable Nicks  
         set element [string tolower $nick]  
         array set nickinfo [array get Nicks $element]  
         array set nickinfo [list nick $nick ident $ident address $address realname $realname hand $handle]  
         set Nicks($element) [array get nickinfo]  
         # FixMe: Not sure if it's sposta be $nick in the next two lines:  
269          if {[string equal $dest $nick]} {          if {[string equal $dest $nick]} {
270                  # We WHOIS'd ourself.. (probably on connect to IRC)                  # We WHOIS'd ourself.. (probably on connect to IRC)
271                  # So we should update our botname variable:                  # So we should update our botname variable:
272                  set ::botname "$nick!$ident@$address"                  set ::botname "$nick!$ident@$address"
273          }          }
274            if {[onchan $nick]} {
275                    #set unknown [lindex $larg 4]
276                    set realname [string range [join [lrange $larg 5 end]] 1 end]
277                    set handle [finduser "$nick!$ident@$address"]
278                    variable Nicks
279                    set element [string tolower $nick]
280                    if {[info exists Nicks($element)]} { array set nickinfo $Nicks($element)] }
281                    array set nickinfo [list nick $nick ident $ident address $address realname $realname handle $handle]
282                    set Nicks($element) [array get nickinfo]
283            }
284  }  }
285    
286  # irc.choopa.net: 317 FireEgl FireEgl 193 1050624422 seconds idle, signon time  # irc.choopa.net: 317 FireEgl FireEgl 193 1050624422 seconds idle, signon time
287  # Process results from a WHOIS:  # Process results from a WHOIS:
288  # Proc by Papillon@EFNet  # Proc by Papillon@EFNet
289  # FixMe: Untested and unmodified.  # FixMe: Untested and unmodified.
290  bind raw - 317 ::tcldrop::irc::317 99  # bind raw - 317 ::tcldrop::irc::317 99
291  proc ::tcldrop::irc::317 {from key arg} {  #proc ::tcldrop::irc::317 {from key arg} {
292          # FixMe: This should set the initial idle (lastspoke) time, and join time.  #       # FixMe: This should set the initial idle (lastspoke) time, and join time.
293          set larg [split $arg]  #       set larg [split $arg]
294          set nick [lindex $larg 1]  #       set nick [lindex $larg 1]
295          set idle [lindex $larg 2]  #       set idle [lindex $larg 2]
296          set jointime [lindex $larg 3]  #       set jointime [lindex $larg 3]
297          variable Nicks  #       variable Nicks
298          set element [string tolower $nick]  #       set element [string tolower $nick]
299          if {![info exists Nicks($element)]} { set Nicks($element) {} }  #       if {[info exists Nicks($element)]} { array set nickinfo $Nicks($element) }
300          array set nickinfo $Nicks($element)  #       array set nickinfo [list idle $idle logon $jointime]
301          array set nickinfo [list idle $idle logon $jointime ]  #       set Nicks($element) [array get nickinfo]
302          set Nicks($element) [array get nickinfo]  #}
 }  
303    
304  bind evnt - init-server ::tcldrop::irc::Init-Server 99  bind evnt - init-server ::tcldrop::irc::Init-Server 99
305  proc ::tcldrop::irc::Init-Server {type} {  proc ::tcldrop::irc::Init-Server {type} {
# Line 296  proc ::tcldrop::irc::Init-Server {type} Line 312  proc ::tcldrop::irc::Init-Server {type}
312  bind raw - JOIN ::tcldrop::irc::JOIN 99  bind raw - JOIN ::tcldrop::irc::JOIN 99
313  proc ::tcldrop::irc::JOIN {from key arg} {  proc ::tcldrop::irc::JOIN {from key arg} {
314          set channel [string range $arg 1 end]          set channel [string range $arg 1 end]
315            # If the bot itself just joined the channel, do a resetchan:
316          if {[string equal $from $::botname]} { resetchan $channel }          if {[string equal $from $::botname]} { resetchan $channel }
317          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
318          set uhost [lindex [split $from !] end]          set ident [lindex [split $from !@] 1]
319          set handle [finduser $uhost]          set address [lindex [split $from @] end]
320            set handle [finduser $from]
321          #Updating the Nicks/ChannelNicks arrays          #Updating the Nicks/ChannelNicks arrays
         variable Nicks  
322          variable ChannelNicks          variable ChannelNicks
323          set element [string tolower $channel,$nick]          array set channickinfo [list nick $nick op 0 voice 0 halfop 0]
324          if {![info exists Nicks([string tolower $nick])]} {          set ChannelNicks([string tolower "$channel,$nick"]) [array get channickinfo]
325                  putserv "WHOIS $nick"          variable Nicks
326                  array set blabla [list nick $nick op 0 voice 0 halfop 0 "join" [set m [clock seconds]] "idle" $m]          if {[info exists Nicks([set element [string tolower $nick]])]} { array set nickinfo $Nicks($element) }
327                  set ChannelNicks($element) [array get blabla]          array set nickinfo [list nick $nick handle $handle ident $ident address $address]
328          }          set Nicks($element) [array get nickinfo]
329          # Call all the join binds:          # Call all the join binds:
330          foreach b [binds join] {          foreach b [binds join] {
331                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
332                  if {[string match -nocase $mask "$channel $from"] && [matchattr $handle $flags $channel]} {                  if {[string match -nocase $mask "$channel $from"] && [matchattr $handle $flags $channel]} {
333                          ::tcldrop::countbind $type $mask $proc                          if {[catch { $proc $nick $ident@$address $handle $channel } err]} {
                         if {[catch { $proc $nick $uhost $handle $channel } err]} {  
334                                  putlog "Error in $proc: $err"                                  putlog "Error in $proc: $err"
335                                  puterrlog "$::errorInfo"                                  puterrlog "$::errorInfo"
336                          }                          }
337                            ::tcldrop::countbind $type $mask $proc
338                  }                  }
339          }          }
340  }  }
341    
342  #irc.blessed.net 367 TiCkLe #tclsh host*!*@jaslkgsdg CB-4!surf@80.199.114.234 1053610707  # irc.blessed.net 367 TiCkLe #tclsh host*!*@jaslkgsdg CB-4!surf@80.199.114.234 1053610707
343  # Process the results of MODE $channel +b:  # Process the results of MODE $channel +b:
344  bind raw - 367 ::tcldrop::irc::367 99  bind raw - 367 ::tcldrop::irc::367 99
345  proc ::tcldrop::irc::367 {from key arg} {  proc ::tcldrop::irc::367 {from key arg} {
# Line 331  proc ::tcldrop::irc::367 {from key arg} Line 348  proc ::tcldrop::irc::367 {from key arg}
348          set ban [lindex $larg 2]          set ban [lindex $larg 2]
349          set creator [lindex $larg 3]          set creator [lindex $larg 3]
350          set created [lindex $larg 4]          set created [lindex $larg 4]
         # FixMe: Complete this.  
         # We need to make a second ban-array to seperate the bans on channel, and the  
         # internal bans set by the bot (active or not)  
351          variable Bans          variable Bans
352          set element [string tolower $channel,$ban]          set Bans([string tolower $channel,$ban]) [list ban $ban creator $creator created $created channel $channel]
         if {![info exists Bans($element]} { set Bans($element {} }  
         array set chanbans $Bans($element)  
         array set chanbans [list ban $ban creator $creator created $created]  
         set Bans($element) [array get chanbans]  
353  }  }
354    
   
355  # irc.choopa.net: 324 FireEgl #channel +tn  # irc.choopa.net: 324 FireEgl #channel +tn
356  # Process the results from MODE $channel:  # Process the results from MODE $channel:
 # Proc by Papillon@EFNet  
357  bind raw - 324 ::tcldrop::irc::324 99  bind raw - 324 ::tcldrop::irc::324 99
358  proc ::tcldrop::irc::324 {from key arg} {  proc ::tcldrop::irc::324 {from key arg} {
359          set larg [split $arg]          set larg [split $arg]
# Line 353  proc ::tcldrop::irc::324 {from key arg} Line 361  proc ::tcldrop::irc::324 {from key arg}
361          set modes [join [lrange $larg 2 end]]          set modes [join [lrange $larg 2 end]]
362          variable Channels          variable Channels
363          set element [string tolower $channel]          set element [string tolower $channel]
364          if {![info exists Channels($element)]} { set Channels($element) {} }          if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }
365          array set chaninfo $Channels($element)          array set chaninfo [list chanmodes $modes channel $channel]
         array set chaninfo [list modes $modes]  
366          set Channels($element) [array get chaninfo]          set Channels($element) [array get chaninfo]
367  }  }
368    
   
369  # irc.choopa.net: 329 FireEgl #channel 1050676546  # irc.choopa.net: 329 FireEgl #channel 1050676546
370  # Process the results from MODE $channel:  # Process the results from MODE $channel:
371  # Proc by Papillon@EFNet  # Proc by Papillon@EFNet
372  bind raw - 329 ::tcldrop::irc::329 99  # bind raw - 329 ::tcldrop::irc::329 99
373  proc ::tcldrop::irc::329 {from key arg} {  #proc ::tcldrop::irc::329 {from key arg} {
374          set larg [split $arg]  #       set larg [split $arg]
375          set channel [lindex $larg 1]  #       set channel [lindex $larg 1]
376          # This is the unixtime of when the channel was created:  #       # This is the unixtime of when the channel was created:
377          set created [lindex $larg end]  #       set created [lindex $larg end]
378          variable Channels  #       variable Channels
379          set element [string tolower $channel]  #       set element [string tolower $channel]
380          if {![info exists Channels($element)]} { set Channels($element) {} }  #       if {![info exists Channels($element)]} { set Channels($element) {} }
381          array set chaninfo $Channels($element)  #       array set chaninfo $Channels($element)
382          array set chaninfo [list created $created]  #       array set chaninfo [list created $created]
383          set Channels($element) [array get chaninfo]  #       set Channels($element) [array get chaninfo]
384  }  #}
   
385    
386  # irc.homelien.no 331 Papillon #channel :No topic is set  # irc.homelien.no 331 Papillon #channel :No topic is set
387  # Process the results from TOPIC $channel: if no topic is set  # Process the results from TOPIC $channel: if no topic is set
388  # Proc by Papillon@EFNet  # Proc by Papillon@EFNet
389  bind raw - 331 ::tcldrop::irc::331 99  bind raw - 331 ::tcldrop::irc::331 99
390  proc ::tcldrop::irc::331 {from key arg} { ::tcldrop::irc::332 $from $key [join [lrange [split $arg] 0 1]] }  proc ::tcldrop::irc::331 {from key arg} { 332 $from $key [join [lrange [split $arg] 0 1]] }
   
391    
392  # irc.homelien.no 332 Papillon #channel :topic  # irc.homelien.no 332 Papillon #channel :topic
393  # Process the results from TOPIC $channel:  # Process the results from TOPIC $channel:
 # Proc by Papillon@EFNet  
394  bind raw - 332 ::tcldrop::irc::332 99  bind raw - 332 ::tcldrop::irc::332 99
395  proc ::tcldrop::irc::332 {from key arg} {  proc ::tcldrop::irc::332 {from key arg} {
396          set larg [split $arg]          set larg [split $arg]
397          set topic [string range [join [lrange $larg 2 end]] 1 end]          set topic [string range [join [lrange $larg 2 end]] 1 end]
398          set channel [lindex $larg 1]          set channel [lindex $larg 1]
   
399          variable Channels          variable Channels
400          set element [string tolower $channel]          set element [string tolower $channel]
401          if {![info exists Channels($element)]} { set Channels($element) {} }          if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }
402          array set chaninfo $Channels($element)          array set chaninfo [list topic $topic channel $channel]
         array set chaninfo [list topic $topic]  
403          set Channels($element) [array get chaninfo]          set Channels($element) [array get chaninfo]
404  }  }
405    
406    # irc.choopa.net: 333 FireEgl #tcl FireEgl!Proteus@adsl-17-148-104.bhm.bellsouth.net 1069721590
407    # Process the results from TOPIC $channel:
408    # This tells us the creator and created time.
409    bind raw - 333 ::tcldrop::irc::333 99
410    proc ::tcldrop::irc::333 {from key arg} {
411            set larg [split $arg]
412            set channel [lindex $larg 1]
413            set creator [lindex $larg 2]
414            set created [lindex $larg 3]
415            variable Channels
416            set element [string tolower $channel]
417            if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }
418            array set chaninfo [list topic-creator $creator topic-created $created]
419            set Channels($element) [array get chaninfo]
420    }
421    
422  # Proc by Papillon@EFNet  # FireEgl!Proteus@adsl-17-148-104.bhm.bellsouth.net TOPIC #test :blah blah
423    # Triggered when somebody changes the topic.
424  bind raw - TOPIC ::tcldrop::irc::TOPIC 99  bind raw - TOPIC ::tcldrop::irc::TOPIC 99
425  proc ::tcldrop::irc::TOPIC {from key arg} {  proc ::tcldrop::irc::TOPIC {from key arg} {
426          set larg [split $arg]          set larg [split $arg]
# Line 411  proc ::tcldrop::irc::TOPIC {from key arg Line 428  proc ::tcldrop::irc::TOPIC {from key arg
428          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
429          set channel [lindex $larg 0]          set channel [lindex $larg 0]
430          set topic [string range [join [lrange $larg 1 end]] 1 end]          set topic [string range [join [lrange $larg 1 end]] 1 end]
431            # FixMe: finduser maybe be too slow, therefore it may be better to extract the handle from the Nicks array.
432          set handle [finduser $uhost]          set handle [finduser $uhost]
   
433          variable Channels          variable Channels
434          set element [string tolower $channel]          set element [string tolower $channel]
435          if {![info exists Channels($element)]} { set Channels($element) {} }          if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }
436          array set chaninfo $Channels($element)          array set chaninfo [list topic $topic topic-creator $from topic-created [clock seconds]]
         if {[string equal -nocase $topic $chaninfo(topic)]} { return }  
         array set chaninfo [list topic $topic]  
437          set Channels($element) [array get chaninfo]          set Channels($element) [array get chaninfo]
   
438          # Call all the topc binds:          # Call all the topc binds:
439          foreach b [binds topc] {          foreach b [binds topc] {
440                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
441                  if {[string match -nocase $mask "$channel $topic"]} {                  if {[string match -nocase $mask "$channel $topic"]} {
                         ::tcldrop::countbind $type $mask $proc  
442                          if {[catch { $proc $nick $uhost $handle $channel $topic } err]} {                          if {[catch { $proc $nick $uhost $handle $channel $topic } err]} {
443                                  putlog "Error in $proc: $err"                                  putlog "Error in $proc: $err"
444                                  puterrlog "$::errorInfo"                                  puterrlog "$::errorInfo"
445                          }                          }
446                            ::tcldrop::countbind $type $mask $proc
447                  }                  }
448          }          }
449  }  }
# Line 438  bind raw - NICK ::tcldrop::irc::NICK 99 Line 452  bind raw - NICK ::tcldrop::irc::NICK 99
452  # Proc by Papillon@EFNet  # Proc by Papillon@EFNet
453  # FixMe: Untested and unmodified.  # FixMe: Untested and unmodified.
454  proc ::tcldrop::irc::NICK {from key arg} {  proc ::tcldrop::irc::NICK {from key arg} {
         global botnick  
455          set oldnick [lindex [split $from !] 0]          set oldnick [lindex [split $from !] 0]
456          if {![string equal $::botnick $::nick] && [string equal -nocase $oldnick $::nick]} {          if {![string equal $::botnick $::nick] && [string equal -nocase $oldnick $::nick]} {
457                  putserv "NICK $::nick"                  putserv "NICK $::nick"
458                  set botnick $::nick                  set ::botnick $::nick
459          }          }
460          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
461          set nick [string range $arg 1 end]          set nick [string range $arg 1 end]
# Line 464  proc ::tcldrop::irc::NICK {from key arg} Line 477  proc ::tcldrop::irc::NICK {from key arg}
477          }          }
478  }  }
479    
480    # FixMe: redo this.
481  bind nick - * ::tcldrop::irc::nick 0  bind nick - * ::tcldrop::irc::nick 0
482  proc ::tcldrop::irc::nick {nick uhost handle channel newnick} {  proc ::tcldrop::irc::nick {nick uhost handle channel newnick} {
483          set lowernick [string tolower $nick]          set lowernick [string tolower $nick]
# Line 491  proc ::tcldrop::irc::SIGN {from key arg} Line 505  proc ::tcldrop::irc::SIGN {from key arg}
505          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
506          set msg [string range $arg 1 end]          set msg [string range $arg 1 end]
507          set handle [finduser $uhost]          set handle [finduser $uhost]
   
508          # Call all the sign binds:          # Call all the sign binds:
509          foreach b [binds sign] {          foreach b [binds sign] {
510                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
511                  foreach channel [channels] {                  foreach channel [channels] {
512                          if {[string match -nocase $mask "$channel $uhost"] && [matchattr $handle $flags $channel]} {                          if {[string match -nocase $mask "$channel $uhost"] && [matchattr $handle $flags $channel]} {
                                 ::tcldrop::countbind $type $mask $proc  
513                                  if {[catch { $proc $nick $uhost $handle $channel $msg } err]} {                                  if {[catch { $proc $nick $uhost $handle $channel $msg } err]} {
514                                          putlog "Error in $proc: $err"                                          putlog "Error in $proc: $err"
515                                          puterrlog "$::errorInfo"                                          puterrlog "$::errorInfo"
516                                  }                                  }
517                                    ::tcldrop::countbind $type $mask $proc
518                          }                          }
519                  }                  }
520          }          }
# Line 519  proc ::tcldrop::irc::KICK {from key arg} Line 532  proc ::tcldrop::irc::KICK {from key arg}
532          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
533          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
534          set channel [lindex $larg 0]          set channel [lindex $larg 0]
535          set victim [lindex $larg 1]          set target [lindex $larg 1]
536          set reason [string range [join [lrange $larg 2 end]] 1 end]          set reason [string range [join [lrange $larg 2 end]] 1 end]
537          set handle [finduser $uhost]          set handle [finduser $uhost]
538            variable Nicks
539          set el [string tolower $channel]          array unset Nicks [set lowernick [string tolower $nick]]
540          variable ChannelNicks          variable ChannelNicks
541          array unset ChannelNicks $element,*          array unset ChannelNicks [string tolower $channel],$lowernick
         if {[array get ChannelNicks [string tolower *,$nick]] == {}} {  
                 variable Nicks  
                 array unset Nicks [string tolower $nick]  
         }  
   
542          # Call all the kick binds:          # Call all the kick binds:
543          foreach b [binds kick] {          foreach b [binds kick] {
544                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
545                  foreach channel [channels] {                  if {[string match -nocase $mask "$channel $target"]} {
546                          if {[string match -nocase $mask "$channel $victim"]} {                          if {[catch { $proc $nick $uhost $handle $channel $target $reason } err]} {
547                                  ::tcldrop::countbind $type $mask $proc                                  putlog "Error in $proc: $err"
548                                  if {[catch { $proc $nick $uhost $handle $channel $victim $reason } err]} {                                  puterrlog "$::errorInfo"
                                         putlog "Error in $proc: $err"  
                                         puterrlog "$::errorInfo"  
                                 }  
549                          }                          }
550                            ::tcldrop::countbind $type $mask $proc
551                  }                  }
552          }          }
553  }  }
554    
   
555  # irc.choopa.net: 433 FireEgl NewNick Nickname is already in use.  # irc.choopa.net: 433 FireEgl NewNick Nickname is already in use.
556  # will choose the alternate nick, if that's taken aswell it will set Lamestbotxx  # will choose the alternate nick, if that's taken aswell it will set Lamestbotxx
557  # where xx is random numbers  # where xx is random numbers
# Line 556  proc ::tcldrop::irc::433 {from key arg} Line 561  proc ::tcldrop::irc::433 {from key arg}
561          if {[string equal $oldnick $::nick]} {          if {[string equal $oldnick $::nick]} {
562                  putserv "NICK $::altnick"                  putserv "NICK $::altnick"
563          } elseif {[string equal $oldnick $::altnick]} {          } elseif {[string equal $oldnick $::altnick]} {
564                  set newnick "$::nick[rand 99]"                  putserv "NICK $::nick[rand 99]"
                 putserv "NICK $newnick"  
565          }          }
566  }  }
567    
   
568  # irc.choopa.net: 352 FireEgl #channel ~FireEgl adsl-17-134-83.bhm.bellsouth.net irc.choopa.net FireEgl H@ 0 Proteus  # irc.choopa.net: 352 FireEgl #channel ~FireEgl adsl-17-134-83.bhm.bellsouth.net irc.choopa.net FireEgl H@ 0 Proteus
569  # Process the results from WHO $channel:  # Process the results from WHO $channel:
570  bind raw - 352 ::tcldrop::irc::352 99  bind raw - 352 ::tcldrop::irc::352 99
# Line 577  proc ::tcldrop::irc::352 {from key arg} Line 580  proc ::tcldrop::irc::352 {from key arg}
580          set flags [string trimleft [lindex $larg 6] {HG*xXd!}]          set flags [string trimleft [lindex $larg 6] {HG*xXd!}]
581          #set hops [string trimleft [lindex $larg 7] :]          #set hops [string trimleft [lindex $larg 7] :]
582          set realname [join [lrange $larg 8 end]]          set realname [join [lrange $larg 8 end]]
583          set handle [finduser [maskhost "$ident@$address"]]          set handle [finduser "$nick!$ident@$address"]
584          # Nicks stores global nick info (not bot-info, we got that already):          variable Nicks
585          if {![string equal $nick $::botnick]} {          set element [string tolower $nick]
586                  variable Nicks          if {[info exists Nicks($element)]} { array set nickinfo $Nicks($element) }
587                  set element [string tolower $nick]          array set nickinfo [list nick $nick ident $ident address $address realname $realname handle $handle]
588                  array set nickinfo [array get Nicks $element]          set Nicks($element) [array get nickinfo]
                 array set nickinfo [list nick $nick ident $ident address $address realname $realname hand $handle]  
                 set Nicks($element) [array get nickinfo]  
         }  
   
         # ChannelNicks stores channel specific info on nicks:  
589          variable ChannelNicks          variable ChannelNicks
590          set element [string tolower "$channel,$nick"]          set element [string tolower "$channel,$nick"]
591          array set channick [array get ChannelNicks $element]          if {[info exists ChannelNicks($element)]} { array set channickinfo $ChannelNicks($element) }
592          if {![info exists ChannelNicks($element)]} { array set channick [list idle [set m [clock seconds]] "join" $m] }          set op [set voice [set halfop 0]]
593          set op 0          foreach f [split $flags {}] {
         set voice 0  
         set halfop 0  
         foreach f $flags {  
594                  switch -- $f {                  switch -- $f {
595                          {@} { set op 1 }                          {@} { set op 1 }
596                          {+} { set voice 1 }                          {+} { set voice 1 }
597                          {%} { set halfop 1 }                          {%} { set halfop 1 }
598                  }                  }
599          }          }
600          array set channick [list nick $nick op $op voice $voice halfop $halfop]          array set channickinfo [list idletime [clock seconds] jointime [clock seconds] nick $nick op $op voice $voice halfop $halfop]
601          set ChannelNicks($element) [array get channick]          set ChannelNicks($element) [array get channickinfo]
602          return 0          return 0
603  }  }
604    
# Line 616  proc ::tcldrop::irc::PART {from key arg} Line 611  proc ::tcldrop::irc::PART {from key arg}
611          set channel [lindex $larg 0]          set channel [lindex $larg 0]
612          set msg [string range [join [lrange $larg 1 end]] 1 end]          set msg [string range [join [lrange $larg 1 end]] 1 end]
613          set handle [finduser $uhost]          set handle [finduser $uhost]
   
         #chanrem [lindex $a 2]  
614          # Call all the part binds:          # Call all the part binds:
615          foreach b [binds part] {          foreach b [binds part] {
616                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
617                  if {[string match -nocase $mask "$channel $uhost"] && [matchattr $handle $flags $channel]} {                  if {[string match -nocase $mask "$channel $uhost"] && [matchattr $handle $flags $channel]} {
                         ::tcldrop::countbind $type $mask $proc  
618                          if {[catch { $proc $nick $uhost $handle $channel $msg } err]} {                          if {[catch { $proc $nick $uhost $handle $channel $msg } err]} {
619                                  putlog "Error in $proc: $err"                                  putlog "Error in $proc: $err"
620                                  puterrlog "$::errorInfo"                                  puterrlog "$::errorInfo"
621                          }                          }
622                            ::tcldrop::countbind $type $mask $proc
623                  }                  }
624          }          }
625          variable ChannelNicks          variable ChannelNicks
626          set element [string tolower "$channel,$nick"]          array unset ChannelNicks [string tolower "$channel,$nick"]
627          array unset ChannelNicks $element          if {![onchan $nick]} {
         if {[array get ChannelNicks [string tolower *,$nick]] == {}} {  
628                  variable Nicks                  variable Nicks
629                  array unset Nicks [string tolower $nick]                  array unset Nicks [string tolower $nick]
630          }          }
# Line 647  proc ::tcldrop::irc::NOTICE {from key ar Line 639  proc ::tcldrop::irc::NOTICE {from key ar
639          set dest [lindex $larg 0]          set dest [lindex $larg 0]
640          set text [string range [join [lrange $larg 1 end]] 1 end]          set text [string range [join [lrange $larg 1 end]] 1 end]
641          set handle [finduser $uhost]          set handle [finduser $uhost]
         if {$nick == {} && $uhost == {} && $handle == {*}} { return }  
642          # Call all the notc binds:          # Call all the notc binds:
643          foreach b [binds notc] {          foreach b [binds notc] {
644                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
645                  # I checked and though it doesn't say so in tcl-commands.txt this bind ignores flags                  if {[string match -nocase $mask $text] && [matchattr $handle $flags]} {
                 if {[string match -nocase $mask "$text"]} {  
                         ::tcldrop::countbind $type $mask $proc  
646                          if {[catch { $proc $nick $uhost $handle $text $dest } err]} {                          if {[catch { $proc $nick $uhost $handle $text $dest } err]} {
647                                  putlog "Error in $proc: $err"                                  putlog "Error in $proc: $err"
648                                  puterrlog "$::errorInfo"                                  puterrlog "$::errorInfo"
649                          }                          }
650                            ::tcldrop::countbind $type $mask $proc
651                  }                  }
652          }          }
653  }  }
654    
655  bind raw - PRIVMSG ::tcldrop::irc::PRIVMSG 99  bind raw - PRIVMSG ::tcldrop::irc::PRIVMSG 99
 proc ::tcldrop::irc::PRIVMSGx {from key arg} {  
         # FixMe: Need a command that finds the users handle.  
         set handle [finduser $from]  
         set nick [lindex [set from [split $from !]] 0]  
         set uhost [lindex $from end]  
         set larg [split $arg]  
         set dest [lindex $larg 0]  
         if {[string index $arg 0] == "\001"} {  
                 set keyword [string toupper [join [lrange [split [string trimleft $arg ":\001"]] 1]]]  
                 set text [string trimright [join [lrange $larg 2 end] "\001"]]  
                 # All CTCP binds are called:  
                 ::tcldrop::irc::callctcp $nick $uhost $handle $dest $keyword $text  
         } else {  
                 set text [string range [join [lrange $larg 1 end]] 1 end]  
                 set ltext [split [string trim $text]]  
                 set command [lindex $ltext 0]  
                 set args [string trimleft [join [lrange $ltext 1 end]]]  
                 if {[isbotnick $dest]} {  
                         # All MSG binds are called:  
                         if {![::tcldrop::irc::callmsg $nick $uhost $handle $command $args]} {  
                                 # If callmsg returned 0, do the MSGM binds:  
                                 ::tcldrop::irc::callmsgm $nick $uhost $handle $text  
                         }  
                 } else {  
                         # All PUB binds are called:  
                         if {![::tcldrop::irc::callpub $nick $uhost $handle $dest $command $args]} {  
                                 # If callpub returned 0, do the PUBM binds:  
                                 ::tcldrop::irc::callpubm $nick $uhost $handle $dest $text  
                         }  
                 }  
         }  
         # Stuff I'll need to know how to reply to PINGs:  
         #if {[string compare $owner [lindex $a 0]] == 0} {  
         #       putlog "#[raw2nick $owner]# [lindex [lrange [split $a :] 2 end] 0]"  
         #       docmd [lindex [lrange [split $a :] 2 end] 0]  
         #}  
         #if {[string compare ":\001PING" [lindex $a 3]]==0} {  
         #       putlog "CTCP PING From: [raw2nick [lindex $a 0]]"  
         #       if {[string compare $owner [lindex $a 0]] == 0} {  
                 #               putserv "NOTICE [raw2nick [lindex $a 0]] :\001PING [expr [clock seconds] - [lindex $a 4]] [lindex $a 5]"  
         #       } else {  
         #               # Ohh damn, we are lagged ;)  
         #               putserv "NOTICE [raw2nick [lindex $a 0]] :\001PING [expr [clock seconds] - [lindex $a 4] + 1[random 9]] [lindex $a 5]"  
         #       }  
         #}  
 }  
   
 # Proc modified by Papillon@EFNet:  
 # FixMe: This proc is untested, once verified that it works it'll be safe to remove the original one (above).  
656  proc ::tcldrop::irc::PRIVMSG {from key arg} {  proc ::tcldrop::irc::PRIVMSG {from key arg} {
657          # FixMe: Need a command that finds the users handle.          set handle [finduser $from]
658          set nick [lindex [set from [split $from !]] 0]          set nick [lindex [set from [split $from !]] 0]
659          set uhost [lindex $from end]          set uhost [lindex $from end]
         set handle [finduser $uhost]  
660          set larg [split $arg]          set larg [split $arg]
661          set dest [lindex $larg 0]          set dest [lindex $larg 0]
         puts "$handle $nick $uhost $larg $dest"  
662          if {[string index $arg 0] == "\001"} {          if {[string index $arg 0] == "\001"} {
663                  set keyword [string toupper [join [lrange [split [string trimleft $arg ":\001"]] 1]]]                  set keyword [string toupper [join [lrange [split [string trimleft $arg ":\001"]] 1]]]
664                  set text [string trimright [join [lrange $larg 2 end] "\001"]]                  set text [string trimright [join [lrange $larg 2 end] "\001"]]
# Line 744  proc ::tcldrop::irc::PRIVMSG {from key a Line 683  proc ::tcldrop::irc::PRIVMSG {from key a
683                  set args [string trimleft [join [lrange $ltext 1 end]]]                  set args [string trimleft [join [lrange $ltext 1 end]]]
684                  if {[isbotnick $dest]} {                  if {[isbotnick $dest]} {
685                          # All MSG binds are called:                          # All MSG binds are called:
                         putlog "callmsg:"  
                         putlog "nick: $nick"  
                         putlog "uhost: $uhost"  
                         putlog "handle: $handle"  
                         putlog "command: $command"  
                         putlog "args: $args"  
686                          if {![::tcldrop::irc::callmsg $nick $uhost $handle $command $args]} {                          if {![::tcldrop::irc::callmsg $nick $uhost $handle $command $args]} {
687                                  # If callmsg returned 0, do the MSGM binds:                                  # If callmsg returned 0, do the MSGM binds:
688                                  ::tcldrop::irc::callmsgm $nick $uhost $handle $text                                  ::tcldrop::irc::callmsgm $nick $uhost $handle $text
689                          }                          }
690                  } else {                  } else {
691                          # All PUB binds are called:                          # All PUB binds are called:
                         variable ChannelNicks  
                         set element [string tolower $dest,$nick]  
                         array set nickinfo $ChannelNicks($element)  
                         array set nickinfo [list idle [clock seconds]]  
                         set ChannelNicks($element) [array get nickinfo]  
692                          if {![::tcldrop::irc::callpub $nick $uhost $handle $dest $command $args]} {                          if {![::tcldrop::irc::callpub $nick $uhost $handle $dest $command $args]} {
693                                  # If callpub returned 0, do the PUBM binds:                                  # If callpub returned 0, do the PUBM binds:
694                                  ::tcldrop::irc::callpubm $nick $uhost $handle $dest $text                                  ::tcldrop::irc::callpubm $nick $uhost $handle $dest $text
# Line 1024  proc ::tcldrop::irc::getchanidle {nick c Line 952  proc ::tcldrop::irc::getchanidle {nick c
952  #  getchanmode <channel>  #  getchanmode <channel>
953  #    Returns: string of the type "+ntik key" for the channel specified  #    Returns: string of the type "+ntik key" for the channel specified
954  proc ::tcldrop::irc::getchanmode {channel} {  proc ::tcldrop::irc::getchanmode {channel} {
955          if {![botonchan $channel]} { return }          if {[botonchan $channel]} {
956          variable Channels                  variable Channels
957          array set chanmode $Channels([string tolower $channel])                  array set chanmode $Channels([string tolower $channel])
958          return $chanmode(modes)                  return $chanmode(modes)
959            }
960  }  }
961    
962  #  pushmode <channel> <mode> [arg]  #  pushmode <channel> <mode> [arg]

Legend:
Removed from v.1.25  
changed lines
  Added in v.1.26

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