src/IRC/IrcHooks.pl

   1 #
   2 # IrcHooks.pl: IRC Hooks stuff.
   3 #      Author: dms
   4 #     Version: 20000126
   5 #        NOTE: Based on code by Kevin Lenzo & Patrick Cole  (c) 1997
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 my $nickserv    = 0;
  11
  12 # GENERIC. TO COPY.
  13 sub on_generic {
  14     my ($self, $event) = @_;
  15     my $nick = $event->nick();
  16     my $chan = ($event->to)[0];
  17
  18     &DEBUG("on_generic: nick => '$nick'.");
  19     &DEBUG("on_generic: chan => '$chan'.");
  20
  21     foreach ($event->args) {
  22         &DEBUG("on_generic: args => '$_'.");
  23     }
  24 }
  25
  26 sub on_action {
  27     my ($self, $event) = @_;
  28     my ($nick, @args) = ($event->nick, $event->args);
  29     my $chan = ($event->to)[0];
  30
  31     shift @args;
  32
  33     if ($chan eq $ident) {
  34         &status("* [$nick] @args");
  35     } else {
  36         &status("* $nick/$chan @args");
  37     }
  38 }
  39
  40 sub on_chat {
  41     my ($self, $event) = @_;
  42     my $msg  = ($event->args)[0];
  43     my $sock = ($event->to)[0];
  44     my $nick = $event->nick();
  45
  46     if (!exists $nuh{lc $nick}) {
  47         &DEBUG("chat: nuh{$nick} doesn't exist; hrm should retry.");
  48         &msg($nick, "could not get whois info?");
  49         return;
  50     } else {
  51         $message        = $msg;
  52         $who            = lc $nick;
  53         $orig{who}      = $nick;
  54         $orig{message}  = $msg;
  55         $nuh            = $nuh{$who};
  56         $uh             = (split /\!/, $nuh)[1];
  57         $addressed      = 1;
  58         $msgType        = 'chat';
  59     }
  60
  61     if (!exists $dcc{'CHATvrfy'}{$nick}) {
  62         $userHandle     = &verifyUser($who, $nuh);
  63         my $crypto      = $users{$userHandle}{PASS};
  64         my $success     = 0;
  65
  66         if (!defined $crypto) {
  67             &DEBUG("chat: no pass required.");
  68             $success++;
  69
  70         } elsif (&ckpasswd($msg, $crypto)) {
  71             # stolen from eggdrop.
  72             $self->privmsg($sock, "Connected to $ident");
  73             $self->privmsg($sock, "Commands start with '.' (like '.quit' or '.help')");
  74             $self->privmsg($sock, "Everything else goes out to the party line.");
  75
  76             &dccStatus(2) if (scalar keys %{ $dcc{'CHAT'} } == 1);
  77
  78             $success++;
  79
  80         } else {
  81             &status("DCC CHAT: incorrect pass; closing connection.");
  82             &DEBUG("chat: sock => '$sock'.");
  83 ###         $sock->close();
  84             delete $dcc{'CHAT'}{$nick};
  85             &DEBUG("chat: after closing sock. FIXME");
  86             ### BUG: close seizes bot. why?
  87         }
  88
  89         if ($success) {
  90             &status("DCC CHAT: user $nick is here!");
  91 #           &DCCBroadcast("$nick ($uh) has joined the chat arena.");
  92             &DCCBroadcast("*** $nick ($uh) joined the party line.");
  93
  94             $dcc{'CHATvrfy'}{$nick} = 1;
  95             if ($userHandle ne "_default") {
  96                 &dccsay($nick,"Flags: $users{$userHandle}{FLAGS}");
  97             }
  98         }
  99
 100         return;
 101     }
 102
 103     $userHandle = &verifyUser($who, $nuh);
 104     &status("$b_red=$b_cyan$who$b_red=$ob $message");
 105
 106     if ($message =~ s/^\.//) {  # dcc chat commands.
 107         ### TODO: make use of &Forker(); here?
 108         &loadMyModule($myModules{'ircdcc'});
 109
 110         &DCCBroadcast("#$who# $message","m");
 111
 112         my $retval      = &userDCC();
 113         return unless (defined $retval);
 114         return if ($retval eq $noreply);
 115
 116         $conn->privmsg($dcc{'CHAT'}{$who}, "Invalid command.");
 117
 118     } else {                    # dcc chat arena.
 119
 120         foreach (keys %{$dcc{'CHAT'}}) {
 121             $conn->privmsg($dcc{'CHAT'}{$_}, "<$who> $orig{message}");
 122         }
 123     }
 124
 125     return 'DCC CHAT MESSAGE';
 126 }
 127
 128 sub on_endofmotd {
 129     my ($self) = @_;
 130
 131     # what's the following for?
 132     $ident                      = $param{'ircNick'};
 133     # update IRCStats.
 134     $ircstats{'ConnectTime'}    = time();
 135     $ircstats{'ConnectCount'}++;
 136
 137     if (&IsParam("wingate")) {
 138         my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 139         open(IN, $file);
 140         while (<IN>) {
 141             chop;
 142             next unless (/^(\S+)\*$/);
 143             push(@wingateBad, $_);
 144         }
 145         close IN;
 146     }
 147
 148     if ($firsttime) {
 149         $conn->schedule(60, \&setupSchedulers, "");
 150         $firsttime = 0;
 151     }
 152
 153     if (&IsParam("ircUMode")) {
 154         &status("Attempting change of user modes to $param{'ircUMode'}.");
 155         &rawout("MODE $ident $param{'ircUMode'}");
 156     }
 157
 158     &status("End of motd. Now lets join some channels...");
 159     if (!scalar @joinchan) {
 160         &WARN("joinchan array is empty!!!");
 161         @joinchan = &getJoinChans();
 162     }
 163
 164     &joinNextChan();
 165 }
 166
 167 sub on_dcc {
 168     my ($self, $event) = @_;
 169     my $type = uc( ($event->args)[1] );
 170     my $nick = $event->nick();
 171
 172     # pity Net::IRC doesn't store nuh. Here's a hack :)
 173     $self->whois($nick);
 174     $type ||= "???";
 175
 176     if ($type eq 'SEND') {      # GET for us.
 177         # incoming DCC SEND. we're receiving a file.
 178         my $get = ($event->args)[2];
 179         open(DCCGET,">$get");
 180
 181         $self->new_get($nick,
 182                 ($event->args)[2],
 183                 ($event->args)[3],
 184                 ($event->args)[4],
 185                 ($event->args)[5],
 186                 \*DCCGET
 187         );
 188     } elsif ($type eq 'GET') {  # SEND for us?
 189         &DEBUG("starting get.");
 190         $self->new_send($event->args);
 191     } elsif ($type eq 'CHAT') {
 192         &DEBUG("starting chat.");
 193         $self->new_chat($event);
 194     } else {
 195         &WARN("${b_green}DCC $type$ob (1)");
 196     }
 197 }
 198
 199 sub on_dcc_close {
 200     my ($self, $event) = @_;
 201     my $nick = $event->nick();
 202     my $sock = ($event->to)[0];
 203
 204     # DCC CHAT close on fork exit workaround.
 205     if ($bot_pid != $$) {
 206         &WARN("run-away fork; exiting.");
 207         &delForked($forker);
 208     }
 209
 210     &DEBUG("dcc_close: nick => '$nick'.");
 211
 212     if (exists $dcc{'SEND'}{$nick} and -f "$param{tempDir}/$nick.txt") {
 213         &status("${b_green}DCC SEND$ob close from $b_cyan$nick$ob");
 214
 215         &status("dcc_close: purging $nick.txt from Debian.pl");
 216         unlink "$param{tempDir}/$nick.txt";
 217
 218         delete $dcc{'SEND'}{$nick};
 219     } elsif (exists $dcc{'CHAT'}{$nick} and $dcc{'CHAT'}{$nick} eq $sock) {
 220         &status("${b_green}DCC CHAT$ob close from $b_cyan$nick$ob");
 221         delete $dcc{'CHAT'}{$nick};
 222     } else {
 223         &status("${b_green}DCC$ob UNKNOWN close from $b_cyan$nick$ob (2)");
 224     }
 225 }
 226
 227 sub on_dcc_open {
 228     my ($self, $event) = @_;
 229     my $type = uc( ($event->args)[0] );
 230     my $nick = $event->nick();
 231     my $sock = ($event->to)[0];
 232     $msgType = 'chat';
 233
 234     $type ||= "???";
 235
 236     if ($type eq 'SEND') {
 237         &status("${b_green}DCC lGET$ob established with $b_cyan$nick$ob");
 238     } elsif ($type eq 'CHAT') {
 239         &status("${b_green}DCC CHAT$ob established with $b_cyan$nick$ob $b_yellow($ob$nuh{$nick}$b_yellow)$ob");
 240         $userHandle     = &verifyUser($nick, $nuh{lc $nick});
 241         my $crypto      = $users{$userHandle}{PASS};
 242         $dcc{'CHAT'}{$nick} = $sock;
 243
 244         foreach (keys %{ $users{$userHandle} }) {
 245             &VERB("   $_ => $users{$userHandle}{$_}",2);
 246         }
 247
 248         if (defined $crypto) {
 249 ###         &dccsay($nick,"Enter your password, $userHandle.");
 250             &dccsay($nick,"Enter your password.");
 251         } else {
 252             &dccsay($nick,"Welcome to blootbot DCC CHAT interface, $userHandle.");
 253         }
 254     } elsif ($type eq 'SEND') {
 255         &DEBUG("Starting DCC receive.");
 256         foreach ($event->args) {
 257             &DEBUG("  => '$_'.");
 258         }
 259     } else {
 260         &WARN("${b_green}DCC $type$ob (3)");
 261     }
 262 }
 263
 264 sub on_disconnect {
 265     my ($self, $event) = @_;
 266     my $from = $event->from();
 267     my $what = ($event->args)[0];
 268
 269     &status("disconnect from $from ($what).");
 270     $ircstats{'DisconnectTime'}         = time();
 271     $ircstats{'DisconnectReason'}       = $what;
 272     $ircstats{'DisconnectCount'}++;
 273
 274     # clear any variables on reconnection.
 275     $nickserv = 0;
 276
 277     &clearIRCVars();
 278     if (!$self->connect()) {
 279         &WARN("not connected? help me. gonna call ircCheck() in 1800s");
 280         $conn->schedule(1800, \&ircCheck(), "");
 281     }
 282 }
 283
 284 sub on_endofnames {
 285     my ($self, $event) = @_;
 286     my $chan = ($event->args)[1];
 287
 288     if (exists $jointime{$chan}) {
 289         my $delta_time = sprintf("%.03f", &gettimeofday() - $jointime{$chan});
 290         $delta_time    = 0      if ($delta_time < 0);
 291
 292         &status("$b_blue$chan$ob: sync in ${delta_time}s.");
 293     }
 294
 295     rawout("MODE $chan");
 296
 297     my $txt;
 298     my @array;
 299     foreach ("o","v","") {
 300         my $count = scalar(keys %{$channels{$chan}{$_}});
 301         next unless ($count);
 302
 303         $txt = "total" if ($_ eq "");
 304         $txt = "voice" if ($_ eq "v");
 305         $txt = "ops"   if ($_ eq "o");
 306
 307         push(@array, "$count $txt");
 308     }
 309     my $chanstats = join(' || ', @array);
 310     &status("$b_blue$chan$ob: [$chanstats]");
 311
 312     if (scalar @joinchan) {     # remaining channels to join.
 313         &joinNextChan();
 314     } else {
 315         ### chanserv support.
 316         ### TODO: what if we rejoin a channel.. need to set a var that
 317         ###       we've done the request-for-ops-on-join.
 318         return unless (&IsParam("chanServ_ops"));
 319         return unless ($nickserv);
 320
 321         my @chans = split(/[\s\t]+/, $param{'chanServ_ops'});
 322
 323         ### TODO: since this function has a chan arg, why don't we use
 324         ###       that instead of doing the following?
 325         foreach $chan (keys %channels) {
 326             next unless (grep /^$chan$/i, @chans);
 327
 328             if (!exists $channels{$chan}{'o'}{$ident}) {
 329                 &status("ChanServ ==> Requesting ops for $chan.");
 330                 &rawout("PRIVMSG ChanServ :OP $chan $ident");
 331             }
 332         }
 333     }
 334
 335 }
 336
 337 sub on_init {
 338     my ($self, $event) = @_;
 339     my (@args) = ($event->args);
 340     shift @args;
 341
 342     &status("@args");
 343 }
 344
 345 sub on_invite {
 346     my ($self, $event) = @_;
 347     my $chan = ($event->args)[0];
 348     my $nick = $event->nick;
 349
 350     &DEBUG("on_invite: chan => '$chan', nick => '$nick'.");
 351
 352     # chan + possible_key.
 353     ### do we need to know the key if we're invited???
 354     ### grep the channel list?
 355     foreach (split /[\s\t]+/, $param{'join_channels'}) {
 356         next unless /^\Q$chan\E(,\S+)?$/i;
 357         s/,/ /;
 358
 359         next if ($nick =~ /^\Q$ident\E$/);
 360         if (&validChan($chan)) {
 361             &msg($who, "i'm already in \002$chan\002.");
 362             next;
 363         }
 364
 365         &status("invited to $b_blue$_$ob by $b_cyan$who$ob");
 366         &joinchan($self, $_);
 367     }
 368 }
 369
 370 sub on_join {
 371     my ($self, $event) = @_;
 372     my ($user,$host) = split(/\@/, $event->userhost);
 373     $chan       = lc( ($event->to)[0] );        # CASING!!!!
 374     $who        = $event->nick();
 375
 376     $chanstats{$chan}{'Join'}++;
 377     $userstats{lc $who}{'Join'} = time() if (&IsParam("seenStats"));
 378
 379     &joinfloodCheck($who, $chan, $event->userhost);
 380
 381     # netjoin detection.
 382     my $netsplit = 0;
 383     if (exists $netsplit{lc $who}) {
 384         delete $netsplit{lc $who};
 385         $netsplit = 1;
 386     }
 387
 388     if ($netsplit and !$netsplittime) {
 389         &status("ok.... re-running chanlimitCheck in 60.");
 390         $conn->schedule(60, sub {
 391                 &chanlimitCheck();
 392                 $netsplittime = undef;
 393         } );
 394
 395         $netsplittime = time();
 396     }
 397
 398     # how to tell if there's a netjoin???
 399
 400     my $netsplitstr = "";
 401     $netsplitstr = " $b_yellow\[${ob}NETSPLIT VICTIM$b_yellow]$ob" if ($netsplit);
 402     &status(">>> join/$b_blue$chan$ob $b_cyan$who$ob $b_yellow($ob$user\@$host$b_yellow)$ob$netsplitstr");
 403
 404     $channels{$chan}{''}{$who}++;
 405     $nuh{lc $who} = $who."!".$user."\@".$host unless (exists $nuh{lc $who});
 406
 407     ### ROOTWARN:
 408     &rootWarn($who,$user,$host,$chan)
 409                 if (&IsParam("rootWarn") &&
 410                     $user =~ /^r(oo|ew|00)t$/i &&
 411                     $channels{$chan}{'o'}{$ident});
 412
 413     # used to determine sync time.
 414     if ($who =~ /^$ident$/i) {
 415         if (defined( my $whojoin = $joinverb{$chan} )) {
 416             &msg($chan, "Okay, I'm here. (courtesy of $whojoin)");
 417             delete $joinverb{$chan};
 418         }
 419
 420         ### TODO: move this to &joinchan()?
 421         $jointime{$chan} = &gettimeofday();
 422         rawout("WHO $chan");
 423     } else {
 424         ### TODO: this may go wild on a netjoin :)
 425         ### WINGATE:
 426         &wingateCheck();
 427     }
 428 }
 429
 430 sub on_kick {
 431     my ($self, $event) = @_;
 432     my ($chan,$reason) = $event->args;
 433     my $kicker  = $event->nick;
 434     my $kickee  = ($event->to)[0];
 435     my $uh      = $event->userhost();
 436
 437     &status(">>> kick/$b_blue$chan$ob [$b$kickee!$uh$ob] by $b_cyan$kicker$ob $b_yellow($ob$reason$b_yellow)$ob");
 438
 439     $chan = lc $chan;   # forgot about this, found by xsdg, 20001229.
 440     $chanstats{$chan}{'Kick'}++;
 441
 442     if ($kickee eq $ident) {
 443         &clearChanVars($chan);
 444
 445         &status("SELF attempting to rejoin lost channel $chan");
 446         &joinchan($chan);
 447     } else {
 448         &DeleteUserInfo($kickee,$chan);
 449     }
 450 }
 451
 452 sub on_mode {
 453     my ($self, $event)  = @_;
 454     my ($user, $host)   = split(/\@/, $event->userhost);
 455     my @args = $event->args();
 456     my $nick = $event->nick();
 457     my $chan = ($event->to)[0];
 458
 459     $args[0] =~ s/\s$//;
 460
 461     if ($nick eq $chan) {       # UMODE
 462         &status(">>> mode $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob");
 463     } else {                    # MODE
 464         &status(">>> mode/$b_blue$chan$ob $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob");
 465         &hookMode($chan, @args);
 466     }
 467 }
 468
 469 sub on_modeis {
 470     my ($self, $event) = @_;
 471     my $nick = $event->nick();
 472     my ($myself,$chan,@args) = $event->args();
 473
 474     &hookMode(lc $chan, @args);         # CASING.
 475 }
 476
 477 sub on_msg {
 478     my ($self, $event) = @_;
 479     my $nick = $event->nick;
 480     my $chan = lc ( ($event->to)[0] );  # CASING.
 481     my $msg = ($event->args)[0];
 482
 483     ($user,$host) = split(/\@/, $event->userhost);
 484     $uh         = $event->userhost();
 485     $nuh        = $nick."!".$uh;
 486
 487     &hookMsg('private', $chan, $nick, $msg);
 488 }
 489
 490 sub on_names {
 491     my ($self, $event) = @_;
 492     my @args = $event->args;
 493     my $chan = lc $args[2];             # CASING, the last of them!
 494
 495     foreach (split / /, @args[3..$#args]) {
 496         $channels{$chan}{'o'}{$_}++     if s/\@//;
 497         $channels{$chan}{'v'}{$_}++     if s/\+//;
 498         $channels{$chan}{''}{$_}++;
 499     }
 500 }
 501
 502 sub on_nick {
 503     my ($self, $event) = @_;
 504     my $nick = $event->nick();
 505     my $newnick = ($event->args)[0];
 506
 507     if (exists $netsplit{lc $newnick}) {
 508         &status("Netsplit: $newnick/$nick came back from netsplit and changed to original nick! removing from hash.");
 509         delete $netsplit{lc $newnick};
 510     }
 511
 512     my ($chan,$mode);
 513     foreach $chan (keys %channels) {
 514         foreach $mode (keys %{$channels{$chan}}) {
 515             next unless (exists $channels{$chan}{$mode}{$nick});
 516
 517             $channels{$chan}{$mode}{$newnick} = $channels{$chan}{$mode}{$nick};
 518         }
 519     }
 520     &DeleteUserInfo($nick,keys %channels);
 521     $nuh{lc $newnick} = $nuh{lc $nick};
 522     delete $nuh{lc $nick};
 523
 524     # successful self-nick change.
 525     if ($nick eq $ident) {
 526         &status(">>> I materialized into $b_green$newnick$ob from $nick");
 527         $ident = $newnick;
 528     } else {
 529         &status(">>> $b_cyan$nick$ob materializes into $b_green$newnick$ob");
 530     }
 531 }
 532
 533 sub on_nick_taken {
 534     my ($self) = @_;
 535     my $nick = $self->nick;
 536     my $newnick = substr($nick,0,7)."-";
 537
 538     &status("nick taken; changing to temporary nick.");
 539     &nick($newnick);
 540     &getNickInUse(1);
 541 }
 542
 543 sub on_notice {
 544     my ($self, $event) = @_;
 545     my $nick = $event->nick();
 546     my $chan = ($event->to)[0];
 547     my $args = ($event->args)[0];
 548
 549     if ($nick =~ /^NickServ$/i) {               # nickserv.
 550         &status("NickServ: <== '$args'");
 551
 552         if ($args =~ /^This nickname is registered/i) {
 553             &status("nickserv told us to register; doing it.");
 554             if (&IsParam("nickServ_pass")) {
 555                 &status("NickServ: ==> Identifying.");
 556                 &rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}");
 557                 return;
 558             } else {
 559                 &status("We can't tell nickserv a passwd ;(");
 560             }
 561         }
 562
 563         # password accepted.
 564         if ($args =~ /^Password a/i) {
 565             $nickserv++;
 566         }
 567     } elsif ($nick =~ /^ChanServ$/i) {          # chanserv.
 568         &status("ChanServ: <== '$args'.");
 569     } else {
 570         if ($chan =~ /^$mask{chan}$/) { # channel notice.
 571             &status("-$nick/$chan- $args");
 572         } else {
 573             $server = $nick unless (defined $server);
 574             &status("-$nick- $args");   # private or server notice.
 575         }
 576     }
 577 }
 578
 579 sub on_other {
 580     my ($self, $event) = @_;
 581     my $chan = ($event->to)[0];
 582     my $nick = $event->nick;
 583
 584     &status("!!! other called.");
 585     &status("!!! $event->args");
 586 }
 587
 588 sub on_part {
 589     my ($self, $event) = @_;
 590     my $chan = lc( ($event->to)[0] );   # CASING!!!
 591     my $nick = $event->nick;
 592     my $userhost = $event->userhost;
 593
 594     if (!exists $floodjoin{$chan}{$nick}{Time}) {
 595         &WARN("on_part: $nick/$chan not in floodjoin hash?");
 596     } else {
 597         delete $floodjoin{$chan}{$nick};
 598     }
 599
 600     $chanstats{$chan}{'Part'}++;
 601     &DeleteUserInfo($nick,$chan);
 602     &clearChanVars($chan) if ($nick eq $ident);
 603     if (!&IsNickInAnyChan($nick) and &IsParam("seenStats")) {
 604         delete $userstats{lc $nick};
 605     }
 606
 607     &status(">>> part/$b_blue$chan$ob $b_cyan$nick$ob $b_yellow($ob$userhost$b_yellow)$ob");
 608 }
 609
 610 sub on_ping {
 611     my ($self, $event) = @_;
 612     my $nick = $event->nick;
 613
 614     $self->ctcp_reply($nick, join(' ', ($event->args)));
 615     &status(">>> ${b_green}CTCP PING$ob request from $b_cyan$nick$ob received.");
 616 }
 617
 618 sub on_ping_reply {
 619     my ($self, $event) = @_;
 620     my $nick = $event->nick;
 621     my $lag = time() - ($event->args)[1];
 622
 623     &status(">>> ${b_green}CTCP PING$ob reply from $b_cyan$nick$ob: $lag sec.");
 624 }
 625
 626 sub on_public {
 627     my ($self, $event) = @_;
 628     my $msg  = ($event->args)[0];
 629     my $chan = lc( ($event->to)[0] );   # CASING.
 630     my $nick = $event->nick;
 631     $uh      = $event->userhost();
 632     $nuh     = $nick."!".$uh;
 633     ($user,$host) = split(/\@/, $uh);
 634
 635     if ($bot_pid != $$) {
 636         &ERROR("run-away fork; exiting.");
 637         &delForked($forker);
 638     }
 639
 640     ### DEBUGGING.
 641     if ($statcount < 200) {
 642         foreach $chan (grep /[A-Z]/, keys %channels) {
 643             &DEBUG("leak: chan => '$chan'.");
 644             my ($i,$j);
 645             foreach $i (keys %{$channels{$chan}}) {
 646                 foreach (keys %{$channels{$chan}{$i}}) {
 647                     &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 648                 }
 649             }
 650         }
 651     }
 652
 653
 654     $msgtime = time();
 655     $lastWho{$chan} = $nick;
 656     ### TODO: use $nick or lc $nick?
 657     if (&IsParam("seenStats")) {
 658         $userstats{lc $nick}{'Count'}++;
 659         $userstats{lc $nick}{'Time'} = time();
 660     }
 661
 662 #    if (&IsParam("hehCounter")) {
 663 #       #...
 664 #    }
 665
 666     &hookMsg('public', $chan, $nick, $msg);
 667     $chanstats{$chan}{'PublicMsg'}++;
 668 }
 669
 670 sub on_quit {
 671     my ($self, $event) = @_;
 672     my $nick = $event->nick();
 673     my $reason = ($event->args)[0];
 674
 675     foreach (keys %channels) {
 676         # fixes inconsistent chanstats bug #1.
 677         next unless (&IsNickInChan($nick,$_));
 678         $chanstats{$_}{'SignOff'}++;
 679     }
 680     &DeleteUserInfo($nick, keys %channels);
 681     if (exists $nuh{lc $nick}) {
 682         delete $nuh{lc $nick};
 683     } else {
 684         &DEBUG("on_quit: nuh{lc $nick} does not exist! FIXME");
 685     }
 686     delete $userstats{lc $nick} if (&IsParam("seenStats"));
 687
 688     # should fix chanstats inconsistencies bug #2.
 689     if ($reason=~/^($mask{host})\s($mask{host})$/) {    # netsplit.
 690         $reason = "NETSPLIT: $1 <=> $2";
 691
 692         $netsplit{lc $nick} = time();
 693         if (!exists $netsplitservers{$1}{$2}) {
 694             &status("netsplit detected between $1 and $2.");
 695             $netsplitservers{$1}{$2} = time();
 696         }
 697     }
 698
 699     &status(">>> $b_cyan$nick$ob has signed off IRC $b_red($ob$reason$b_red)$ob");
 700     if ($nick =~ /^\Q$ident\E$/) {
 701         &DEBUG("!!! THIS SHOULD NEVER HAPPEN. FIXME HOPEFULLY");
 702     }
 703     if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) {
 704         &status("own nickname became free; changing.");
 705         &nick($param{'ircNick'});
 706     }
 707 }
 708
 709 sub on_targettoofast {
 710     my ($self, $event) = @_;
 711     my $nick = $event->nick();
 712     my $chan = ($event->to)[0];
 713
 714     &DEBUG("on_targettoofast: nick => '$nick'.");
 715     &DEBUG("on_targettoofast: chan => '$chan'.");
 716
 717     foreach ($event->args) {
 718         &DEBUG("on_targettoofast: args => '$_'.");
 719     }
 720
 721 ###    .* wait (\d+) second/) {
 722         &status("X1 $msg");
 723         my $sleep = $3 + 10;
 724
 725         &status("going to sleep for $sleep...");
 726         sleep $sleep;
 727         &joinNextChan();
 728 ### }
 729 }
 730
 731 sub on_topic {
 732     my ($self, $event) = @_;
 733
 734     if (scalar($event->args) == 1) {    # change.
 735         my $topic = ($event->args)[0];
 736         my $chan  = ($event->to)[0];
 737         my $nick  = $event->nick();
 738
 739         ###
 740         # WARNING:
 741         #       race condition here. To fix, change '1' to '0'.
 742         #       This will keep track of topics set by bot only.
 743         ###
 744         # UPDATE:
 745         #       this may be fixed at a later date with topic queueing.
 746         ###
 747
 748         $topic{$chan}{'Current'} = $topic if (1 and &IsParam("topic") == 1);
 749         $chanstats{$chan}{'Topic'}++;
 750
 751         &status(">>> topic/$b_blue$chan$ob by $b_cyan$nick$ob -> $topic");
 752     } else {                                            # join.
 753         my ($nick, $chan, $topic) = $event->args;
 754         if (&IsParam("topic")) {
 755             $topic{$chan}{'Current'}    = $topic;
 756             &topicAddHistory($chan,$topic);
 757         }
 758
 759         $topic = &fixString($topic, 1);
 760         &status(">>> topic/$b_blue$chan$ob is $topic");
 761     }
 762 }
 763
 764 sub on_topicinfo {
 765     my ($self, $event) = @_;
 766     my ($myself,$chan,$setby,$time) = $event->args();
 767
 768     my $timestr;
 769     if (time() - $time > 60*60*24) {
 770         $timestr        = "at ". localtime $time;
 771     } else {
 772         $timestr        = &Time2String(time() - $time) ." ago";
 773     }
 774
 775     &status(">>> set by $b_cyan$setby$ob $timestr");
 776 }
 777
 778 sub on_crversion {
 779     my ($self, $event) = @_;
 780     my $nick    = $event->nick();
 781     my $ver;
 782
 783     if (scalar $event->args() != 1) {   # old.
 784         $ver    = join ' ', $event->args();
 785         $ver    =~ s/^VERSION //;
 786     } else {                            # new.
 787         $ver    = ($event->args())[0];
 788     }
 789
 790     if (grep /^\Q$nick\E$/i, @vernick) {
 791         &WARN("nick $nick found in vernick; skipping.");
 792         return;
 793     }
 794     push(@vernick, $nick);
 795
 796     if ($ver =~ /bitchx/i) {
 797         $ver{bitchx}{$nick}     = $ver;
 798     } elsif ($ver =~ /xc\!|xchat/i) {
 799         $ver{xchat}{$nick}      = $ver;
 800     } elsif ($ver =~ /irssi/i) {
 801         $ver{irssi}{$nick}      = $ver;
 802     } elsif ($ver =~ /epic/i) {
 803         $ver{epic}{$nick}       = $ver;
 804     } elsif ($ver =~ /mirc/i) {
 805         $ver{mirc}{$nick}       = $ver;
 806     } elsif ($ver =~ /ircle/i) {
 807         $ver{ircle}{$nick}      = $ver;
 808     } elsif ($ver =~ /ircII/i) {
 809         $ver{ircII}{$nick}      = $ver;
 810     } elsif ($ver =~ /sirc /i) {
 811         $ver{sirc}{$nick}       = $ver;
 812     } elsif ($ver =~ /kvirc/i) {
 813         $ver{kvirc}{$nick}      = $ver;
 814     } elsif ($ver =~ /eggdrop/i) {
 815         $ver{eggdrop}{$nick}    = $ver;
 816     } elsif ($ver =~ /xircon/i) {
 817         $ver{xircon}{$nick}     = $ver;
 818     } else {
 819         $ver{other}{$nick}      = $ver;
 820     }
 821 }
 822
 823 sub on_version {
 824     my ($self, $event) = @_;
 825     my $nick = $event->nick;
 826
 827     &status(">>> ${b_green}CTCP VERSION$ob request from $b_cyan$nick$ob");
 828     $self->ctcp_reply($nick, "VERSION $bot_version");
 829 }
 830
 831 sub on_who {
 832     my ($self, $event) = @_;
 833     my @args    = $event->args;
 834
 835     $nuh{lc $args[5]} = $args[5]."!".$args[2]."\@".$args[3];
 836 }
 837
 838 sub on_whoisuser {
 839     my ($self, $event) = @_;
 840     my @args    = $event->args;
 841
 842     $nuh{lc $args[1]} = $args[1]."!".$args[2]."\@".$args[3];
 843 }
 844
 845 #######################################################################
 846 ####### IRC HOOK HELPERS   IRC HOOK HELPERS   IRC HOOK HELPERS ########
 847 #######################################################################
 848
 849 #####
 850 # Usage: &hookMode($chan, $modes, @targets);
 851 sub hookMode {
 852     my ($chan, $modes, @targets) = @_;
 853     my $parity  = 0;
 854
 855     $chan = lc $chan;           # !!!.
 856
 857     my $mode;
 858     foreach $mode (split(//, $modes)) {
 859         # sign.
 860         if ($mode =~ /[-+]/) {
 861             $parity = 1         if ($mode eq "+");
 862             $parity = 0         if ($mode eq "-");
 863             next;
 864         }
 865
 866         # mode with target.
 867         if ($mode =~ /[bklov]/) {
 868             my $target = shift @targets;
 869
 870             if ($parity) {
 871                 $chanstats{$chan}{'Op'}++    if ($mode eq "o");
 872                 $chanstats{$chan}{'Ban'}++   if ($mode eq "b");
 873             } else {
 874                 $chanstats{$chan}{'Deop'}++  if ($mode eq "o");
 875                 $chanstats{$chan}{'Unban'}++ if ($mode eq "b");
 876             }
 877
 878             # modes w/ target affecting nick => cache it.
 879             if ($mode =~ /[ov]/) {
 880                 $channels{$chan}{$mode}{$target}++      if  $parity;
 881                 delete $channels{$chan}{$mode}{$target} if !$parity;
 882             }
 883
 884             if ($mode =~ /[l]/) {
 885                 $channels{$chan}{$mode} = $target       if  $parity;
 886                 delete $channels{$chan}{$mode}          if !$parity;
 887             }
 888         }
 889
 890         # important channel modes, targetless.
 891         if ($mode =~ /[mt]/) {
 892             $channels{$chan}{$mode}++                   if  $parity;
 893             delete $channels{$chan}{$mode}              if !$parity;
 894         }
 895     }
 896 }
 897
 898 sub hookMsg {
 899     ($msgType, $chan, $who, $message) = @_;
 900     my $skipmessage     = 0;
 901     $addressed          = 0;
 902     $addressedother     = 0;
 903     $orig{message}      = $message;
 904     $orig{who}          = $who;
 905     $addrchar           = 0;
 906
 907     $message    =~ s/[\cA-\c_]//ig;     # strip control characters
 908     $message    =~ s/^\s+//;            # initial whitespaces.
 909     $who        =~ tr/A-Z/a-z/;         # lowercase.
 910
 911     &showProc();
 912
 913     # addressing.
 914     if ($msgType =~ /private/) {
 915         # private messages.
 916         $addressed = 1;
 917     } else {
 918         # public messages.
 919         # addressing revamped by the xk.
 920         ### below needs to be fixed...
 921         if (&IsParam("addressCharacter")) {
 922             if ($message =~ s/^$param{'addressCharacter'}//) {
 923                 $addrchar  = 1;
 924                 $addressed = 1;
 925             }
 926         }
 927
 928         if ($message =~ /^($mask{nick})([\;\:\>\, ]+) */) {
 929             my $newmessage = $';
 930             if ($1 =~ /^\Q$ident\E$/i) {
 931                 $message   = $newmessage;
 932                 $addressed = 1;
 933             } else {
 934                 # ignore messages addressed to other people or unaddressed.
 935                 $skipmessage++ if ($2 ne "" and $2 !~ /^ /);
 936             }
 937         }
 938     }
 939
 940     # Determine floodwho.
 941     if ($msgType =~ /public/i) {                # public.
 942         $floodwho = lc $chan;
 943     } elsif ($msgType =~ /private/i) {  # private.
 944         $floodwho = lc $who;
 945     } else {                            # dcc?
 946         &DEBUG("FIXME: floodwho = ???");
 947     }
 948
 949     my ($count, $interval) = split(/:/, $param{'floodRepeat'} || "2:10");
 950
 951     # flood repeat protection.
 952     if ($addressed) {
 953         my $time = $flood{$floodwho}{$message};
 954
 955         if (defined $time and (time - $time < $interval)) {
 956             ### public != personal who so the below is kind of pointless.
 957             my @who;
 958             foreach (keys %flood) {
 959                 next if (/^\Q$floodwho\E$/ or /^\Q$chan\E$/);
 960                 push(@who, grep /^\Q$message\E$/i, keys %{$flood{$_}});
 961             }
 962             if (scalar @who) {
 963                 &msg($who, "you already said what ".
 964                                 join(' ', @who)." have said.");
 965             } else {
 966                 &msg($who,"Someone already said that ". (time - $time) ." seconds ago" );
 967             }
 968
 969             ### TODO: delete old floodwarn{} keys.
 970             my $floodwarn = 0;
 971             if (!exists $floodwarn{$floodwho}) {
 972                 $floodwarn++;
 973             } else {
 974                 $floodwarn++ if (time() - $floodwarn{$floodwho} > $interval);
 975             }
 976
 977             if ($floodwarn) {
 978                 &status("FLOOD repetition detected from $floodwho.");
 979                 $floodwarn{$floodwho} = time();
 980             }
 981
 982             return;
 983         }
 984
 985         if ($addrchar) {
 986             &status("$b_cyan$who$ob is short-addressing me");
 987         } else {
 988             &status("$b_cyan$who$ob is addressing me");
 989         }
 990
 991         $flood{$floodwho}{$message} = time();
 992     }
 993
 994     ($count, $interval) = split(/:/, $param{'floodMessages'} || "5:30");
 995     # flood overflow protection.
 996     if ($addressed) {
 997         foreach (keys %{$flood{$floodwho}}) {
 998             next unless (time() - $flood{$floodwho}{$_} > $interval);
 999             delete $flood{$floodwho}{$_};
1000         }
1001
1002         my $i = scalar keys %{$flood{$floodwho}};
1003         if ($i > $count) {
1004             &msg($who,"overflow of messages ($i > $count)");
1005             &status("FLOOD overflow detected from $floodwho; ignoring");
1006
1007             my $expire = $param{'ignoreAutoExpire'} || 5;
1008             &ignoreAdd("*!$uh", $chan, $expire, "flood overflow auto-detected.");
1009             return;
1010         }
1011
1012         $flood{$floodwho}{$message} = time();
1013     }
1014
1015     # public.
1016     if ($msgType =~ /public/i) {
1017         $talkchannel = $chan;
1018         &status("<$orig{who}/$chan> $orig{message}");
1019     }
1020
1021     # private.
1022     if ($msgType =~ /private/i) {
1023         &status("[$orig{who}] $orig{message}");
1024     }
1025
1026     if ((!$skipmessage or &IsParam("seenStoreAll")) and
1027         &IsParam("seen") and
1028         $msgType =~ /public/
1029     ) {
1030         $seencache{$who}{'time'} = time();
1031         $seencache{$who}{'nick'} = $orig{who};
1032         $seencache{$who}{'host'} = $uh;
1033         $seencache{$who}{'chan'} = $talkchannel;
1034         $seencache{$who}{'msg'}  = $orig{message};
1035         $seencache{$who}{'msgcount'}++;
1036     }
1037
1038     return if ($skipmessage);
1039     return unless (&IsParam("minVolunteerLength") or $addressed);
1040
1041     ### TODO: hash list of already-checked users.
1042     ### eg: $ignoreChecked{$mask} = time();
1043     local $ignore       = 0;
1044     my $checked         = 0;
1045
1046     if (my @m = grep /^$nuh$/i, keys %ignoreChecked) {
1047         &DEBUG("found ignore for $nuh.");
1048         foreach (@m) {
1049             &DEBUG("masks => $_  ($ignoreChecked{$_})");
1050         }
1051     }
1052
1053     foreach (keys %ignore) {
1054         my $c = $_;
1055         &DEBUG("c = $_, chan = $chan.");
1056
1057         foreach (keys %{ $ignore{$c} }) {
1058             my $m = $_;
1059             $m =~ s/\*/\\S*/g;
1060
1061             next unless ($nuh =~ /^\Q$m\E$/i);
1062             $ignore++;
1063             $ignoreChecked{$nuh} = $c;
1064             last;
1065         }
1066     }
1067
1068     if (!$ignore and !$checked) {
1069         push(@ignore_off, $nuh);
1070     }
1071
1072     if (defined $nuh) {
1073         $userHandle = &verifyUser($who, $nuh);
1074     } else {
1075         &DEBUG("hookMsg: 'nuh' not defined?");
1076     }
1077
1078 ### For extra debugging purposes...
1079     if ($_ = &process()) {
1080 #       &DEBUG("IrcHooks: process returned '$_'.");
1081     }
1082
1083     return;
1084 }
1085
1086 1;