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