blootbot/src/IRC/Irc.pl

   1 #
   2 #    Irc.pl: IRC core 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 # static scalar variables.
  11 $mask{ip}       = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
  12 $mask{host}     = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
  13 $mask{chan}     = '[\#\&]\S*';
  14 my $isnick1     = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
  15 my $isnick2     = '0-9\-';
  16 $mask{nick}     = "[$isnick1]{1}[$isnick1$isnick2]*";
  17 $mask{nuh}      = '\S*!\S*\@\S*';
  18
  19 sub ircloop {
  20     my $error   = 0;
  21     my $lastrun = 0;
  22
  23     while (1) {
  24         # JUST IN CASE. irq was complaining about this.
  25         if ($lastrun == time()) {
  26             &DEBUG("hrm... lastrun == time()");
  27             $error++;
  28             sleep 10;
  29             next;
  30         }
  31
  32         foreach (@ircServers) {
  33             if (!defined $_) {
  34                 &DEBUG("ircloop: ircServers[x] = NULL.");
  35                 $lastrun = time();
  36                 next;
  37             }
  38             next unless (exists $ircPort{$_});
  39
  40             my $retval = &irc($_, $ircPort{$_});
  41             next unless (defined $retval and $retval == 0);
  42             $error++;
  43             if ($error % 3 == 0 and $error != 0) {
  44                 &ERROR("CANNOT connect to this server; next!");
  45                 next;
  46             }
  47
  48             if ($error >= 3*3) {
  49                 &ERROR("CANNOT connect to any irc server; stopping.");
  50                 exit 1;
  51             }
  52         }
  53     }
  54 }
  55
  56 sub irc {
  57     my ($server,$port) = @_;
  58
  59     my $iaddr = inet_aton($server);
  60     my $paddr = sockaddr_in($port, $iaddr);
  61     my $proto = getprotobyname('tcp');
  62
  63     select STDOUT;
  64     &status("Connecting to port $port of server $server ...");
  65
  66     # host->ip.
  67     if ($server =~ /\D$/) {
  68         my $packed = scalar(gethostbyname($server));
  69
  70         if (!defined $packed) {
  71             &status("  cannot resolve $server.");
  72             return 0;
  73         }
  74
  75         my $resolve = inet_ntoa($packed);
  76         &status("  resolved to $resolve.");
  77     }
  78
  79     $irc = new Net::IRC;
  80
  81     $conn = $irc->newconn(
  82                 Nick    => $param{'ircNick'},
  83                 Server  => $server,
  84                 Port    => $port,
  85                 Ircname => $param{'ircName'},
  86                 LocalAddr => $param{'ircHost'},
  87     );
  88
  89     if (!defined $conn) {
  90         &ERROR("irc: conn was not created!defined!!!");
  91         return 1;
  92     }
  93
  94     &clearIRCVars();
  95
  96     # change internal timeout value for scheduler.
  97     $irc->{_timeout}    = 10;   # how about 60?
  98
  99     $ircstats{'Server'} = "$server:$port";
 100
 101     # handler stuff.
 102         $conn->add_handler('caction',   \&on_action);
 103         $conn->add_handler('cdcc',      \&on_dcc);
 104         $conn->add_handler('cping',     \&on_ping);
 105         $conn->add_handler('crping',    \&on_ping_reply);
 106         $conn->add_handler('cversion',  \&on_version);
 107         $conn->add_handler('crversion', \&on_crversion);
 108         $conn->add_handler('dcc_open',  \&on_dcc_open);
 109         $conn->add_handler('dcc_close', \&on_dcc_close);
 110         $conn->add_handler('chat',      \&on_chat);
 111         $conn->add_handler('msg',       \&on_msg);
 112         $conn->add_handler('public',    \&on_public);
 113         $conn->add_handler('join',      \&on_join);
 114         $conn->add_handler('part',      \&on_part);
 115         $conn->add_handler('topic',     \&on_topic);
 116         $conn->add_handler('invite',    \&on_invite);
 117         $conn->add_handler('kick',      \&on_kick);
 118         $conn->add_handler('mode',      \&on_mode);
 119         $conn->add_handler('nick',      \&on_nick);
 120         $conn->add_handler('quit',      \&on_quit);
 121         $conn->add_handler('notice',    \&on_notice);
 122         $conn->add_handler('whoisuser', \&on_whoisuser);
 123         $conn->add_handler('other',     \&on_other);
 124         $conn->add_global_handler('disconnect', \&on_disconnect);
 125         $conn->add_global_handler([251,252,253,254,255], \&on_init);
 126 ###     $conn->add_global_handler([251,252,253,254,255,302], \&on_init);
 127         $conn->add_global_handler(324, \&on_modeis);
 128         $conn->add_global_handler(333, \&on_topicinfo);
 129         $conn->add_global_handler(352, \&on_who);
 130         $conn->add_global_handler(353, \&on_names);
 131         $conn->add_global_handler(366, \&on_endofnames);
 132         $conn->add_global_handler(376, \&on_endofmotd); # on_connect.
 133         $conn->add_global_handler(433, \&on_nick_taken);
 134         $conn->add_global_handler(439, \&on_targettoofast);
 135
 136     # end of handler stuff.
 137
 138     $irc->start;
 139 }
 140
 141 ######################################################################
 142 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
 143 ######################################################################
 144
 145 sub rawout {
 146     my ($buf) = @_;
 147     $buf =~ s/\n//gi;
 148
 149     # slow down a bit if traffic is "high".
 150     # need to take into account time of last message sent.
 151     if ($last{buflen} > 256 and length($buf) > 256) {
 152         sleep 1;
 153     }
 154
 155     $conn->sl($buf) if (&whatInterface() =~ /IRC/);
 156
 157     $last{buflen} = length($buf);
 158 }
 159
 160 sub say {
 161     my ($msg) = @_;
 162     if (!defined $msg) {
 163         $msg ||= "NULL";
 164         &DEBUG("say: msg == $msg.");
 165         return;
 166     }
 167
 168     if ($msg eq $last{say} and length($msg) > 256) {
 169         &status("say: detected repeated message; skipping.");
 170         return;
 171     }
 172     $last{say} = $msg;
 173
 174     &status("</$talkchannel> $msg");
 175     if (&whatInterface() =~ /IRC/) {
 176         $msg = "zero" if ($msg =~ /^0+$/);
 177
 178         $conn->privmsg($talkchannel, $msg);
 179     }
 180 }
 181
 182 sub msg {
 183     my ($nick, $msg) = @_;
 184     if (!defined $nick) {
 185         &ERROR("msg: nick == NULL.");
 186         return;
 187     }
 188
 189     if (!defined $msg) {
 190         $msg ||= "NULL";
 191         &DEBUG("msg: msg == $msg.");
 192         return;
 193     }
 194
 195     if ($msg eq $last{msg} and length($msg) > 256) {
 196         &status("msg: detected repeated message; skipping.");
 197         return;
 198     }
 199     $last{msg} = $msg;
 200
 201     &status(">$nick< $msg");
 202     $conn->privmsg($nick, $msg) if (&whatInterface() =~ /IRC/);
 203 }
 204
 205 # Usage: &action(nick || chan, txt);
 206 sub action {
 207     my ($target, $txt) = @_;
 208     if (!defined $txt) {
 209         &DEBUG("action: txt == NULL.");
 210         return;
 211     }
 212
 213     my $rawout = "PRIVMSG $target :\001ACTION $txt\001";
 214     if (length $rawout > 510) {
 215         &status("action: txt too long; truncating.");
 216
 217         chop($rawout) while (length($rawout) > 510);
 218         $rawout .= "\001";
 219     }
 220
 221     &status("* $ident/$target $txt");
 222     rawout($rawout);
 223 }
 224
 225 # Usage: &action(nick || chan, txt);
 226 sub notice{
 227     my ($target, $txt) = @_;
 228     if (!defined $txt) {
 229         &DEBUG("action: txt == NULL.");
 230         return;
 231     }
 232
 233     &status("-$target- $txt");
 234
 235     $conn->notice($target, $txt);
 236 }
 237
 238
 239 sub DCCBroadcast {
 240     my ($txt,$flag) = @_;
 241
 242     ### FIXME: flag not supported yet.
 243
 244     foreach (keys %{$dcc{'CHAT'}}) {
 245         $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
 246     }
 247 }
 248
 249 ##########
 250 ### perform commands.
 251 ###
 252
 253 # Usage: &performReply($reply);
 254 sub performReply {
 255     my ($reply) = @_;
 256     $reply =~ /([\.\?\s]+)$/;
 257
 258     &checkMsgType($reply);
 259
 260     if ($msgType eq 'public') {
 261         if (rand() < 0.5 or $reply =~ /[\.\?]$/) {
 262             $reply = "$orig{who}: ".$reply;
 263         } else {
 264             $reply = "$reply, ".$orig{who};
 265         }
 266         &say($reply);
 267     } elsif ($msgType eq 'private') {
 268         if (rand() < 0.5) {
 269             $reply = $reply;
 270         } else {
 271             $reply = "$reply, ".$orig{who};
 272         }
 273         &msg($who, $reply);
 274     } elsif ($msgType eq 'chat') {
 275         if (!exists $dcc{'CHAT'}{$who}) {
 276             &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
 277             return;
 278         }
 279         $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
 280     } else {
 281         &ERROR("PR: msgType invalid? ($msgType).");
 282     }
 283 }
 284
 285 # ...
 286 sub performAddressedReply {
 287     return unless ($addressed);
 288     &performReply(@_);
 289 }
 290
 291 sub pSReply {
 292     &performStrictReply(@_);
 293 }
 294
 295 # Usage: &performStrictReply($reply);
 296 sub performStrictReply {
 297     my ($reply) = @_;
 298
 299     &checkMsgType($reply);
 300
 301     if ($msgType eq 'private') {
 302         &msg($who, $reply);
 303     } elsif ($msgType eq 'public') {
 304         &say($reply);
 305     } elsif ($msgType eq 'chat') {
 306         &dccsay($who,$reply);
 307     } else {
 308         &ERROR("pSR: msgType invalid? ($msgType).");
 309     }
 310 }
 311
 312 sub dccsay {
 313     my ($who, $reply) = @_;
 314     if (!exists $dcc{'CHAT'}{$who}) {
 315         &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
 316         return '';
 317     }
 318
 319     $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
 320 }
 321
 322 sub dcc_close {
 323     my($who) = @_;
 324     my $type;
 325
 326     foreach $type (keys %dcc) {
 327         &FIXME("dcc_close: $who");
 328         my @who = grep /^\Q$who\E$/i, keys %{$dcc{$type}};
 329         next unless (scalar @who);
 330         $who = $who[0];
 331     }
 332 }
 333
 334 sub joinchan {
 335     my ($chankey) = @_;
 336     my $chan = lc $chankey;
 337
 338     if ($chankey =~ s/^($mask{chan}),\S+/ /) {
 339         $chan = lc $1;
 340     }
 341
 342     &status("joining $b_blue$chan$ob");
 343
 344     if (&validChan($chan)) {
 345         &status("join: already on $chan");
 346     } else {
 347         $conn->join($chan);
 348     }
 349 }
 350
 351 sub part {
 352     my $chan;
 353
 354     foreach $chan (@_) {
 355         next if ($chan eq "");
 356         $chan =~ tr/A-Z/a-z/;   # lowercase.
 357
 358         &status("parting $chan");
 359         if (!&validChan($chan)) {
 360             &status("part: not on $chan");
 361             next;
 362         }
 363
 364         rawout("PART $chan");
 365         # deletion of $channels{chan} is done in &entryEvt().
 366     }
 367 }
 368
 369 sub mode {
 370     my ($chan, @modes) = @_;
 371     my $modes = join(" ", @modes);
 372
 373     if (&validChan($chan) == 0) {
 374         &ERROR("mode: invalid chan => '$chan'.");
 375         return;
 376     }
 377
 378     &DEBUG("MODE $chan $modes");
 379
 380     rawout("MODE $chan $modes");
 381 }
 382
 383 sub op {
 384     my ($chan, @who) = @_;
 385     my $os      = "o" x scalar(@who);
 386
 387     &mode($chan, "+$os ".@who);
 388 }
 389
 390 sub deop {
 391     my ($chan, @who) = @_;
 392     my $os = "o" x scalar(@who);
 393
 394     &mode($chan, "-$os ".@who);
 395 }
 396
 397 sub kick {
 398     my ($nick,$chan,$msg) = @_;
 399     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
 400
 401     if ($chan ne "" and &validChan($chan) == 0) {
 402         &ERROR("kick: invalid channel $chan.");
 403         return;
 404     }
 405
 406     $nick =~ tr/A-Z/a-z/;
 407
 408     foreach $chan (@chans) {
 409         if (!&IsNickInChan($nick,$chan)) {
 410             &status("Kick: $nick is not on $chan.") if (scalar @chans == 1);
 411             next;
 412         }
 413
 414         if (!exists $channels{$chan}{o}{$ident}) {
 415             &status("Kick: do not have ops on $chan :(");
 416             next;
 417         }
 418
 419         &status("Kicking $nick from $chan.");
 420         if ($msg eq "") {
 421             &rawout("KICK $chan $nick");
 422         } else {
 423             &rawout("KICK $chan $nick :$msg");
 424         }
 425     }
 426 }
 427
 428 sub ban {
 429     my ($mask,$chan) = @_;
 430     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
 431     my $ban     = 0;
 432
 433     if ($chan ne "" and &validChan($chan) == 0) {
 434         &ERROR("ban: invalid channel $chan.");
 435         return;
 436     }
 437
 438     $nick =~ tr/A-Z/a-z/;
 439
 440     foreach $chan (@chans) {
 441         if (!&IsNickInChan($nick,$chan) and scalar @chans == 1) {
 442             &status("Ban: $nick is not on $chan.");
 443             next;
 444         }
 445
 446         if (!exists $channels{$chan}{o}{$ident}) {
 447             &status("Ban: do not have ops on $chan :(");
 448             next;
 449         }
 450
 451         &status("Banning $mask from $chan.");
 452         &rawout("MODE $chan +b $mask");
 453         $ban++;
 454     }
 455
 456     return $ban;
 457 }
 458
 459 sub quit {
 460     my ($quitmsg) = @_;
 461     &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
 462     $conn->quit($quitmsg);
 463 }
 464
 465 sub nick {
 466     my ($nick) = @_;
 467
 468     if ($nick =~ /^$mask{nick}$/) {
 469         rawout("NICK ".$nick);
 470         return 1;
 471     }
 472
 473     return 0;
 474 }
 475
 476 sub invite {
 477     my($who, $chan) = @_;
 478     rawout("INVITE $who $chan");
 479 }
 480
 481
 482 ##########
 483 # Channel related functions...
 484 #
 485
 486 # Usage: &joinNextChan();
 487 sub joinNextChan {
 488     if (scalar @joinchan) {
 489         my $chan = shift @joinchan;
 490         &joinchan($chan);
 491
 492         if (my $i = scalar @joinchan) {
 493             &status("joinNextChan: $i chans to join.");
 494         }
 495         return;
 496     }
 497
 498     if ($nickserv < 1) {
 499         &WARN("jNC: nickserv/chanserv not up.") if (!$nickserv);
 500         $nickserv--;
 501     }
 502
 503     my %chan = &getChanConfList("chanServ");
 504     foreach $chan (keys %chan) {
 505         next unless ($chan{$chan} > 0);
 506
 507         if (!exists $channels{$chan}{'o'}{$ident}) {
 508             &status("ChanServ ==> Requesting ops for $chan.");
 509             &rawout("PRIVMSG ChanServ :OP $chan $ident");
 510         }
 511     }
 512 }
 513
 514 # Usage: &GetNickInChans($nick,$chan);
 515 sub GetNickInChans {
 516     my ($nick) = @_;
 517     my @array;
 518
 519     foreach (keys %channels) {
 520         next unless (grep /^\Q$nick\E$/i, keys %{$channels{$_}{''}});
 521         push(@array, $_);
 522     }
 523
 524     return @array;
 525 }
 526
 527 # Usage: &GetNicksInChan($chan);
 528 sub GetNicksInChan {
 529     my ($chan) = @_;
 530     my @array;
 531
 532     return keys %{ $channels{$chan}{''} };
 533 }
 534
 535 sub IsNickInChan {
 536     my ($nick,$chan) = @_;
 537
 538     $chan =~ tr/A-Z/a-z/;       # not lowercase unfortunately.
 539
 540     if (&validChan($chan) == 0) {
 541         &ERROR("INIC: invalid channel $chan.");
 542         return 0;
 543     }
 544
 545     if (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}}) {
 546         return 1;
 547     } else {
 548         foreach (keys %channels) {
 549             next unless (/[A-Z]/);
 550             &DEBUG("hash channels contains mixed cased chan!!!");
 551         }
 552         return 0;
 553     }
 554 }
 555
 556 sub IsNickInAnyChan {
 557     my ($nick) = @_;
 558
 559     foreach $chan (keys %channels) {
 560         next unless (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}});
 561         return 1;
 562     }
 563     return 0;
 564 }
 565
 566 # Usage: &validChan($chan);
 567 sub validChan {
 568     my ($chan) = @_;
 569
 570     if (lc $chan ne $chan) {
 571         &WARN("validChan: lc chan != chan. ($chan); fixing.");
 572         $chan =~ tr/A-Z/a-z/;
 573     }
 574
 575     if (exists $channels{$chan}) {
 576         return 1;
 577     } else {
 578         return 0;
 579     }
 580 }
 581
 582 ###
 583 # Usage: &DeleteUserInfo($nick,@chans);
 584 sub DeleteUserInfo {
 585     my ($nick,@chans) = @_;
 586     my ($mode,$chan);
 587
 588     foreach $chan (@chans) {
 589         foreach $mode (keys %{$channels{$chan}}) {
 590             # use grep here?
 591             next unless (exists $channels{$chan}{$mode}{$nick});
 592
 593             delete $channels{$chan}{$mode}{$nick};
 594         }
 595     }
 596 }
 597
 598 sub clearChanVars {
 599     my ($chan) = @_;
 600
 601     delete $channels{$chan};
 602 }
 603
 604 sub clearIRCVars {
 605     &DEBUG("clearIRCVars() called!");
 606     undef %channels;
 607     undef %floodjoin;
 608
 609     @joinchan   = &getJoinChans();
 610 }
 611
 612 sub getJoinChans {
 613     my @chans;
 614     my @skip;
 615
 616     foreach (keys %chanconf) {
 617         my $val = $chanconf{$_}{autojoin};
 618         my $skip = 0;
 619         if (defined $val) {
 620             $skip++ if ($val eq "0");
 621         } else {
 622             $skip++;
 623         }
 624
 625         if ($skip) {
 626             push(@skip, $_);
 627             next;
 628         }
 629
 630         push(@chans, $_);
 631     }
 632
 633     if (scalar @skip) {
 634         &status("channels not auto-joining: @skip");
 635     }
 636
 637     return @chans;
 638 }
 639
 640 sub closeDCC {
 641     &DEBUG("closeDCC called.");
 642
 643     foreach $type (keys %dcc) {
 644         next if ($type ne uc($type));
 645
 646         foreach (keys %{$dcc{$type}}) {
 647             &DEBUG("closing DCC $type to $_ (FIXME).");
 648             $dcc{$type}{$_}->close();
 649         }
 650     }
 651 }
 652
 653 sub joinfloodCheck {
 654     my($who,$chan,$userhost) = @_;
 655
 656     return unless (&IsParam("joinfloodCheck"));
 657
 658     if (exists $netsplit{lc $who}) {    # netsplit join.
 659         &DEBUG("jfC: $who was in netsnipe; not checking.");
 660     }
 661
 662     if (exists $floodjoin{$chan}{$who}{Time}) {
 663         &WARN("floodjoin{$chan}{$who} already exists?");
 664     }
 665
 666     $floodjoin{$chan}{$who}{Time} = time();
 667     $floodjoin{$chan}{$who}{Host} = $userhost;
 668
 669     ### Check...
 670     foreach (keys %floodjoin) {
 671         my $c = $_;
 672         my $count = scalar keys %{ $floodjoin{$c} };
 673         next unless ($count > 5);
 674         &DEBUG("count => $count");
 675
 676         my $time;
 677         foreach (keys %{ $floodjoin{$c} }) {
 678             $time += $floodjoin{$c}{$_}{Time};
 679         }
 680         &DEBUG("time => $time");
 681         $time /= $count;
 682
 683         &DEBUG("new time => $time");
 684     }
 685
 686     ### Clean it up.
 687     my $delete = 0;
 688     foreach $chan (keys %floodjoin) {
 689         foreach $who (keys %{ $floodjoin{$chan} }) {
 690             my $time = time() - $floodjoin{$chan}{$who}{Time};
 691             next unless ($time > 10);
 692             delete $floodjoin{$chan}{$who};
 693             $delete++;
 694         }
 695     }
 696
 697     &DEBUG("jfC: $delete deleted.") if ($delete);
 698 }
 699
 700 sub getHostMask {
 701     my($n) = @_;
 702
 703     &FIXME("getHostMask...");
 704 }
 705
 706 1;