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