/[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.27 by fireegl, Sat Nov 29 06:05:56 2003 UTC revision 1.28 by fireegl, Sat Nov 29 22:24:25 2003 UTC
# Line 71  namespace eval ::tcldrop::irc { Line 71  namespace eval ::tcldrop::irc {
71          namespace export resetchan onchan botonchan nick2hand hand2nick handonchan getchanhost getchanjoin onchansplit chanlist getchanidle getchanmode pushmode flushmode topic botisop botishalfop botisvoice isop ishalfop wasop washalfop isvoice ischanban ischanexempt ischaninvite chanbans chanexempts chaninvites resetbans resetexempts resetinvites          namespace export resetchan onchan botonchan nick2hand hand2nick handonchan getchanhost getchanjoin onchansplit chanlist getchanidle getchanmode pushmode flushmode topic botisop botishalfop botisvoice isop ishalfop wasop washalfop isvoice ischanban ischanexempt ischaninvite chanbans chanexempts chaninvites resetbans resetexempts resetinvites
72  }  }
73    
74    # Note: These are the raw 005's from several networks.  (collected on November 29, 2003)
75    # FixMe: Add support for these to Tcldrop.
76    # calvino.freenode.net: 5 FireEgl MODES=4 MAXCHANNELS=20 NICKLEN=16 USERLEN=10 HOSTLEN=63 TOPICLEN=450 KICKLEN=450 CHANNELLEN=30 KEYLEN=23 CHANTYPES=# PREFIX=@+ CASEMAPPING=ascii CAPAB IRCD=dancer are available on this server
77    # irc.choopa.net: 5 FireEgl STD=i-d STATUSMSG=@+ KNOCK EXCEPTS INVEX MODES=4 MAXCHANNELS=90 MAXBANS=100 MAXTARGETS=6 NICKLEN=9 TOPICLEN=120 KICKLEN=120 are supported by this server
78    # irc.choopa.net: 5 FireEgl CHANTYPES=#& PREFIX=(ov)@+ CHANMODES=eIb,k,l,imnpst NETWORK=EFnet CASEMAPPING=rfc1459 CHARSET=ascii CALLERID ETRACE WALLCHOPS are supported by this server
79    # localhost.localdomain: 5 FireEgl WHOX WALLCHOPS WALLVOICES USERIP CPRIVMSG CNOTICE SILENCE=15 MODES=6 MAXCHANNELS=15 MAXBANS=45 NICKLEN=9 TOPICLEN=160 AWAYLEN=160 KICKLEN=160 are supported by this server
80    # localhost.localdomain: 5 FireEgl CHANTYPES=#& PREFIX=(ov)@+ CHANMODES=b,k,l,imnpstr CASEMAPPING=rfc1459 NETWORK=UnderNet are supported by this server
81    # Elsene.Be.Eu.undernet.org: 5 FireEgl WHOX WALLCHOPS WALLVOICES USERIP CPRIVMSG CNOTICE SILENCE=15 MODES=6 MAXCHANNELS=20 MAXBANS=45 NICKLEN=9 TOPICLEN=160 AWAYLEN=160 KICKLEN=160 are supported by this server
82    # Elsene.Be.Eu.undernet.org: 5 FireEgl CHANTYPES=#& PREFIX=(ov)@+ CHANMODES=b,k,l,imnpstr CASEMAPPING=rfc1459 NETWORK=UnderNet are supported by this server
83    # hotspeed.sg.as.dal.net: 5 FireEgl NOQUIT WATCH=128 SAFELIST MODES=6 MAXCHANNELS=20 MAXBANS=100 NICKLEN=30 TOPICLEN=307 KICKLEN=307 CHANTYPES=# PREFIX=(ov)@+ NETWORK=DALnet SILENCE=10 CASEMAPPING=ascii CHANMODES=b,k,l,ciLmMnOprRst are available on this server
84    #
85    # Note: Here's my idea for adding support for these...
86    #       When the bot connects to a server (raw 001), it takes all the globals
87    #       such as modes-per-line, for example, and other per-server specific
88    #       settings and puts them into the servers idxinfo..
89    #       When it reaches raw 005 it'll replace those defaults in the servers
90    #       idxinfo with the ones the server supports, like MODES=4, for example.
91    #       The bot should then always look at the servers idxinfo instead of the
92    #       global var for deciding how many modes-per-line to use (for example).
93    #
94    
95  proc ::tcldrop::irc::resetchan {channel} {  proc ::tcldrop::irc::resetchan {channel} {
96          putquick "MODE $channel +b"          putquick "MODE $channel +b"
97          putquick "MODE $channel"          putquick "MODE $channel"
# Line 425  bind raw - TOPIC ::tcldrop::irc::TOPIC 9 Line 446  bind raw - TOPIC ::tcldrop::irc::TOPIC 9
446  proc ::tcldrop::irc::TOPIC {from key arg} {  proc ::tcldrop::irc::TOPIC {from key arg} {
447          set larg [split $arg]          set larg [split $arg]
448          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
449            set handle [nick2hand $nick]
450          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
451          set channel [lindex $larg 0]          set channel [lindex $larg 0]
452          set topic [string range [join [lrange $larg 1 end]] 1 end]          set topic [string range [join [lrange $larg 1 end]] 1 end]
         # FixMe: finduser maybe be too slow, therefore it may be better to extract the handle from the Nicks array.  
         set handle [finduser $uhost]  
453          variable Channels          variable Channels
454          set element [string tolower $channel]          set element [string tolower $channel]
455          if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }          if {[info exists Channels($element)]} { array set chaninfo $Channels($element) }
# Line 459  proc ::tcldrop::irc::NICK {from key arg} Line 479  proc ::tcldrop::irc::NICK {from key arg}
479          }          }
480          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
481          set nick [string range $arg 1 end]          set nick [string range $arg 1 end]
482          set handle [finduser $uhost]          set handle [finduser $nick!$uhost]
483    
484          # Call all the nick binds:          # Call all the nick binds:
485          putlog "Nick change: $oldnick -> $nick"          putlog "Nick change: $oldnick -> $nick"
# Line 502  proc ::tcldrop::irc::nick {nick uhost ha Line 522  proc ::tcldrop::irc::nick {nick uhost ha
522  bind raw - QUIT ::tcldrop::irc::SIGN 99  bind raw - QUIT ::tcldrop::irc::SIGN 99
523  proc ::tcldrop::irc::SIGN {from key arg} {  proc ::tcldrop::irc::SIGN {from key arg} {
524          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
525            set handle [nick2hand $nick]
526          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
527          set msg [string range $arg 1 end]          set msg [string range $arg 1 end]
         set handle [finduser $uhost]  
528          # Call all the sign binds:          # Call all the sign binds:
529          foreach b [binds sign] {          foreach b [binds sign] {
530                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
# Line 530  bind raw - KICK ::tcldrop::irc::KICK 99 Line 550  bind raw - KICK ::tcldrop::irc::KICK 99
550  proc ::tcldrop::irc::KICK {from key arg} {  proc ::tcldrop::irc::KICK {from key arg} {
551          set larg [split $arg]          set larg [split $arg]
552          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
553            set handle [nick2hand $nick]
554          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
555          set channel [lindex $larg 0]          set channel [lindex $larg 0]
556          set target [lindex $larg 1]          set target [lindex $larg 1]
557          set reason [string range [join [lrange $larg 2 end]] 1 end]          set reason [string range [join [lrange $larg 2 end]] 1 end]
         set handle [finduser $uhost]  
558          variable Nicks          variable Nicks
559          array unset Nicks [set lowernick [string tolower $nick]]          array unset Nicks [set lowernick [string tolower $nick]]
560          variable ChannelNicks          variable ChannelNicks
# Line 607  bind raw - PART ::tcldrop::irc::PART 99 Line 627  bind raw - PART ::tcldrop::irc::PART 99
627  proc ::tcldrop::irc::PART {from key arg} {  proc ::tcldrop::irc::PART {from key arg} {
628          set larg [split $arg]          set larg [split $arg]
629          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
630            set handle [nick2hand $nick]
631          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
632          set channel [lindex $larg 0]          set channel [lindex $larg 0]
633          set msg [string range [join [lrange $larg 1 end]] 1 end]          set msg [string range [join [lrange $larg 1 end]] 1 end]
         set handle [finduser $uhost]  
634          # Call all the part binds:          # Call all the part binds:
635          foreach b [binds part] {          foreach b [binds part] {
636                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
# Line 635  bind raw - NOTICE ::tcldrop::irc::NOTICE Line 655  bind raw - NOTICE ::tcldrop::irc::NOTICE
655  proc ::tcldrop::irc::NOTICE {from key arg} {  proc ::tcldrop::irc::NOTICE {from key arg} {
656          set larg [split $arg]          set larg [split $arg]
657          set nick [lindex [split $from !] 0]          set nick [lindex [split $from !] 0]
658            set handle [nick2hand $nick]
659          set uhost [lindex [split $from !] 1]          set uhost [lindex [split $from !] 1]
660          set dest [lindex $larg 0]          set dest [lindex $larg 0]
661          set text [string range [join [lrange $larg 1 end]] 1 end]          set text [string range [join [lrange $larg 1 end]] 1 end]
         set handle [finduser $uhost]  
662          # Call all the notc binds:          # Call all the notc binds:
663          foreach b [binds notc] {          foreach b [binds notc] {
664                  foreach {type flags mask count proc} $b {}                  foreach {type flags mask count proc} $b {}
# Line 654  proc ::tcldrop::irc::NOTICE {from key ar Line 674  proc ::tcldrop::irc::NOTICE {from key ar
674    
675  bind raw - PRIVMSG ::tcldrop::irc::PRIVMSG 99  bind raw - PRIVMSG ::tcldrop::irc::PRIVMSG 99
676  proc ::tcldrop::irc::PRIVMSG {from key arg} {  proc ::tcldrop::irc::PRIVMSG {from key arg} {
         set handle [finduser $from]  
677          set nick [lindex [set from [split $from !]] 0]          set nick [lindex [set from [split $from !]] 0]
678            set handle [nick2hand $nick]
679          set uhost [lindex $from end]          set uhost [lindex $from end]
680          set larg [split $arg]          set larg [split $arg]
681          set dest [lindex $larg 0]          set dest [lindex $larg 0]
# Line 697  proc ::tcldrop::irc::PRIVMSG {from key a Line 717  proc ::tcldrop::irc::PRIVMSG {from key a
717          }          }
718  }  }
719    
720    # All this does is clear out all the variables when we disconnect from the server:
721    bind evnt - disconnect-server ::tcldrop::irc::disconnect-server
722    proc ::tcldrop::irc::disconnect-server {event} {
723            variable Nicks
724            array unset Nicks
725            variable ChannelNicks
726            array unset ChannelNicks
727            variable Channel
728            array unset Channel
729            variable Bans
730            array unset Bans
731            variable Exempts
732            array unset Exempts
733            variable Invites
734            array unset Invites
735            # FixMe: It should probably clear the $::botnick and $::botname variables too..
736            #        Or should that be done in the server module?
737    }
738    
739  #  ischanban <ban> <channel>  #  ischanban <ban> <channel>
740  #    Returns: 1 if the specified ban is on the given channel's ban list  #    Returns: 1 if the specified ban is on the given channel's ban list
741  #      (not the bot's banlist for the channel)  #      (not the bot's banlist for the channel)
# Line 729  proc ::tcldrop::irc::ischaninvite {invit Line 768  proc ::tcldrop::irc::ischaninvite {invit
768  #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the  #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the
769  #      bot's POV.  #      bot's POV.
770  #    Module: irc  #    Module: irc
 # FixMe: Add support for the age.  
771  proc ::tcldrop::irc::chanbans {channel} {  proc ::tcldrop::irc::chanbans {channel} {
772          set banlist [list]          set banlist [list]
773          variable Bans          variable Bans
774          foreach b [array names Bans [string tolower $channel],*] {          foreach b [array names Bans [string tolower $channel],*] {
775                  array set baninfo $Bans($b)                  array set baninfo $Bans($b)
776                  lappend banlist [list $baninfo(ban) $baninfo(creator) 1]                  lappend banlist [list $baninfo(ban) $baninfo(creator) $baninfo(created)]
777          }          }
778          return $banlist          return $banlist
779  }  }
# Line 751  proc ::tcldrop::irc::chanexempts {channe Line 789  proc ::tcldrop::irc::chanexempts {channe
789          variable Exempts          variable Exempts
790          foreach b [array names Exempts [string tolower $channel],*] {          foreach b [array names Exempts [string tolower $channel],*] {
791                  array set exemptinfo $Exempts($b)                  array set exemptinfo $Exempts($b)
792                  lappend exemptlist [list $exemptinfo(exempt) $exemptinfo(creator) 1]                  lappend exemptlist [list $exemptinfo(exempt) $exemptinfo(creator) $exemptinfo(created)]
793          }          }
794          return $exemptlist          return $exemptlist
795  }  }
# Line 766  proc ::tcldrop::irc::chaninvites {channe Line 804  proc ::tcldrop::irc::chaninvites {channe
804          variable Invites          variable Invites
805          foreach b [array names Invites [string tolower $channel],*] {          foreach b [array names Invites [string tolower $channel],*] {
806                  array set inviteinfo $Invites($b)                  array set inviteinfo $Invites($b)
807                  lappend invitelist [list $inviteinfo(ban) $inviteinfo(creator) 1]                  lappend invitelist [list $inviteinfo(ban) $inviteinfo(creator) $inviteinfo(created)]
808          }          }
809          return $invitelist          return $invitelist
810  }  }

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

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