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 {} |
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} { |
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} { |
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] |
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] |
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 |
} |
} |
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] |
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] |
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 |
} |
} |
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 |
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 |
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 |
|
|
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 |
} |
} |
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"]] |
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 |
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] |