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
  18 sub ircloop {
  19     my $error   = 0;
  20     my $lastrun = 0;
  21
  22     while (1) {
  23         # JUST IN CASE. irq was complaining about this.
  24         if ($lastrun == time()) {
  25             $error++;
  26             sleep 1;
  27             next;
  28         }
  29
  30         foreach (@ircServers) {
  31             if (!defined $_) {
  32                 &DEBUG("ircloop: ircServers[x] = NULL.");
  33                 $lastrun = time();
  34                 next;
  35             }
  36             &DEBUG("ircloop: _ => '$_'.");
  37             next unless (exists $ircPort{$_});
  38
  39             my $retval = &irc($_, $ircPort{$_});
  40             next unless (defined $retval and $retval == 0);
  41             $error++;
  42             if ($error % 3 == 0 and $error != 0) {
  43                 &ERROR("CANNOT connect to this server; next!");
  44                 next;
  45             }
  46
  47             if ($error >= 3*3) {
  48                 &ERROR("CANNOT connect to any irc server; stopping.");
  49                 exit 1;
  50             }
  51         }
  52     }
  53 }
  54
  55 sub irc {
  56     my ($server,$port) = @_;
  57
  58     my $iaddr = inet_aton($server);
  59     my $paddr = sockaddr_in($port, $iaddr);
  60     my $proto = getprotobyname('tcp');
  61
  62     select STDOUT;
  63     &status("Connecting to port $port of server $server ...");
  64     sleep 3;            # lame hack.
  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     # change internal timeout value for scheduler.
  95     $irc->{_timeout}    = 10;   # how about 60?
  96
  97     # clear out hashes before connecting...
  98     &clearIRCVars();
  99
 100     $ident                      = $param{'ircNick'};
 101     ### IRCSTATS.
 102     $ircstats{'ConnectTime'}    = time();
 103     $ircstats{'ConnectCount'}++;
 104     $ircstats{'Server'}         = "$server:$port";
 105
 106     # handler stuff.
 107         $conn->add_handler('caction',   \&on_action);
 108         $conn->add_handler('cdcc',      \&on_dcc);
 109         $conn->add_handler('cping',     \&on_ping);
 110         $conn->add_handler('crping',    \&on_ping_reply);
 111         $conn->add_handler('cversion',  \&on_version);
 112
 113         $conn->add_handler('dcc_open',  \&on_dcc_open);
 114         $conn->add_handler('dcc_close', \&on_dcc_close);
 115         $conn->add_handler('chat',      \&on_chat);
 116         $conn->add_handler('msg',       \&on_msg);
 117         $conn->add_handler('public',    \&on_public);
 118         $conn->add_handler('join',      \&on_join);
 119         $conn->add_handler('part',      \&on_part);
 120         $conn->add_handler('topic',     \&on_topic);
 121         $conn->add_handler('invite',    \&on_invite);
 122         $conn->add_handler('kick',      \&on_kick);
 123         $conn->add_handler('mode',      \&on_mode);
 124         $conn->add_handler('nick',      \&on_nick);
 125         $conn->add_handler('quit',      \&on_quit);
 126         $conn->add_handler('notice',    \&on_notice);
 127         $conn->add_handler('whoisuser', \&on_whoisuser);
 128         $conn->add_handler('other',     \&on_other);
 129         $conn->add_global_handler('disconnect', \&on_disconnect);
 130         $conn->add_global_handler([251,252,253,254,255], \&on_init);
 131 ###     $conn->add_global_handler([251,252,253,254,255,302], \&on_init);
 132         $conn->add_global_handler(324, \&on_modeis);
 133         $conn->add_global_handler(333, \&on_topicinfo);
 134         $conn->add_global_handler(352, \&on_who);
 135         $conn->add_global_handler(353, \&on_names);
 136         $conn->add_global_handler(366, \&on_endofnames);
 137         $conn->add_global_handler(376, \&on_endofmotd);
 138         $conn->add_global_handler(433, \&on_nick_taken);
 139         $conn->add_global_handler(439, \&on_targettoofast);
 140     # end of handler stuff.
 141
 142     $irc->start;
 143 }
 144
 145 ######################################################################
 146 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
 147 ######################################################################
 148
 149 sub rawout {
 150     my ($buf) = @_;
 151     $buf =~ s/\n//gi;
 152
 153     # slow down a bit if traffic is "high".
 154     # need to take into account time of last message sent.
 155     if ($last{buflen} > 256 and length($buf) > 256) {
 156         sleep 1;
 157     }
 158
 159     $conn->sl($buf) if (&whatInterface() =~ /IRC/);
 160
 161     $last{buflen} = length($buf);
 162 }
 163
 164 sub say {
 165     my ($msg) = @_;
 166     if (!defined $msg or $msg eq $noreply) {
 167         $msg ||= "NULL";
 168         &DEBUG("say: msg == $msg.");
 169         return;
 170     }
 171
 172     if ($msg eq $last{say} and length($msg) > 256) {
 173         &status("say: detected repeated message; skipping.");
 174         return;
 175     }
 176     $last{say} = $msg;
 177
 178     &status("</$talkchannel> $msg");
 179     if (&whatInterface() =~ /IRC/) {
 180         $msg = "zero" if ($msg =~ /^0+$/);
 181
 182         $conn->privmsg($talkchannel, $msg);
 183     }
 184 }
 185
 186 sub msg {
 187     my ($nick, $msg) = @_;
 188     if (!defined $nick) {
 189         &ERROR("msg: nick == NULL.");
 190         return;
 191     }
 192
 193     if (!defined $msg or $msg eq $noreply) {
 194         $msg ||= "NULL";
 195         &DEBUG("msg: msg == $msg.");
 196         return;
 197     }
 198
 199     if ($msg eq $last{msg} and length($msg) > 256) {
 200         &status("msg: detected repeated message; skipping.");
 201         return;
 202     }
 203     $last{msg} = $msg;
 204
 205     &status(">$nick< $msg");
 206     $conn->privmsg($nick, $msg) if (&whatInterface() =~ /IRC/);
 207 }
 208
 209 # Usage: &action(nick || chan, txt);
 210 sub action {
 211     my ($target, $txt) = @_;
 212     if (!defined $txt) {
 213         &DEBUG("action: txt == NULL.");
 214         return;
 215     }
 216
 217     my $rawout = "PRIVMSG $target :\001ACTION $txt\001";
 218     if (length $rawout > 510) {
 219         &status("action: txt too long; truncating.");
 220
 221         chop($rawout) while (length($rawout) > 510);
 222         $rawout .= "\001";
 223     }
 224
 225     &status("* $ident/$target $txt");
 226     rawout($rawout);
 227 }
 228
 229 # Usage: &action(nick || chan, txt);
 230 sub notice{
 231     my ($target, $txt) = @_;
 232     if (!defined $txt) {
 233         &DEBUG("action: txt == NULL.");
 234         return;
 235     }
 236
 237     &status("-$target- $txt");
 238
 239     $conn->notice($target, $txt);
 240 }
 241
 242
 243 sub DCCBroadcast {
 244     my ($txt) = @_;
 245
 246     foreach (keys %{$dcc{'CHAT'}}) {
 247         $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
 248     }
 249 }
 250
 251 ##########
 252 ### perform commands.
 253 ###
 254
 255 # Usage: &performReply($reply);
 256 sub performReply {
 257     my ($reply) = @_;
 258     $reply =~ /([\.\?\s]+)$/;
 259
 260     &checkMsgType($reply);
 261
 262     if ($msgType eq 'public') {
 263         if (rand() < 0.5 or $reply =~ /[\.\?]$/) {
 264             $reply = "$orig{who}: ".$reply;
 265         } else {
 266             $reply = "$reply, ".$orig{who};
 267         }
 268         &say($reply);
 269     } elsif ($msgType eq 'private') {
 270         if (rand() < 0.5) {
 271             $reply = $reply;
 272         } else {
 273             $reply = "$reply, ".$orig{who};
 274         }
 275         &msg($who, $reply);
 276     } elsif ($msgType eq 'chat') {
 277         if (!exists $dcc{'CHAT'}{$who}) {
 278             &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
 279             return;
 280         }
 281         $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
 282     } else {
 283         &ERROR("PR: msgType invalid? ($msgType).");
 284     }
 285 }
 286
 287 # ...
 288 sub performAddressedReply {
 289     return unless ($addressed);
 290     &performReply(@_);
 291 }
 292
 293 # Usage: &performStrictReply($reply);
 294 sub performStrictReply {
 295     my ($reply) = @_;
 296
 297     &checkMsgType($reply);
 298
 299     if ($msgType eq 'private') {
 300         &msg($who, $reply);
 301     } elsif ($msgType eq 'public') {
 302         &say($reply);
 303     } elsif ($msgType eq 'chat') {
 304         if (!exists $dcc{'CHAT'}{$who}) {
 305             &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
 306             return;
 307         }
 308         $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
 309     } else {
 310         &ERROR("pSR: msgType invalid? ($msgType).");
 311     }
 312
 313     return '';
 314 }
 315
 316 sub joinchan {
 317     my ($chankey) = @_;
 318     my $chan = lc $chankey;
 319
 320     if ($chankey =~ s/^($mask{chan}),\S+/ /) {
 321         $chan = lc $1;
 322     }
 323
 324     &status("joining $b_blue$chan$ob");
 325
 326     if (&validChan($chan)) {
 327         &status("join: already on $chan");
 328     } else {
 329         $conn->join($chan);
 330     }
 331 }
 332
 333 sub part {
 334     my $chan;
 335
 336     foreach $chan (@_) {
 337         next if ($chan eq "");
 338         $chan =~ tr/A-Z/a-z/;   # lowercase.
 339
 340         &status("parting $chan");
 341         if (!&validChan($chan)) {
 342             &status("part: not on $chan");
 343             next;
 344         }
 345
 346         rawout("PART $chan");
 347         # deletion of $channels{chan} is done in &entryEvt().
 348     }
 349 }
 350
 351 sub mode {
 352     my ($chan, @modes) = @_;
 353     my $modes = join(" ", @modes);
 354
 355     if (&validChan($chan) == 0) {
 356         &ERROR("mode: invalid chan => '$chan'.");
 357         return;
 358     }
 359
 360     &DEBUG("MODE $chan $modes");
 361
 362     rawout("MODE $chan $modes");
 363 }
 364
 365 sub op {
 366     my ($chan, @who) = @_;
 367     my $os      = "o" x scalar(@who);
 368
 369     &mode($chan, "+$os ".@who);
 370 }
 371
 372 sub deop {
 373     my ($chan, @who) = @_;
 374     my $os = "o" x scalar(@who);
 375
 376     &mode($chan, "-$os ".@who);
 377 }
 378
 379 sub kick {
 380     my ($nick,$chan,$msg) = @_;
 381     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
 382
 383     if ($chan ne "" and &validChan($chan) == 0) {
 384         &ERROR("kick: invalid channel $chan.");
 385         return;
 386     }
 387
 388     $nick =~ tr/A-Z/a-z/;
 389
 390     foreach $chan (@chans) {
 391         if (!&IsNickInChan($nick,$chan)) {
 392             &status("Kick: $nick is not on $chan.") if (scalar @chans == 1);
 393             next;
 394         }
 395
 396         if (!exists $channels{$chan}{o}{$ident}) {
 397             &status("Kick: do not have ops on $chan :(");
 398             next;
 399         }
 400
 401         &status("Kicking $nick from $chan.");
 402         if ($msg eq "") {
 403             &rawout("KICK $chan $nick");
 404         } else {
 405             &rawout("KICK $chan $nick :$msg");
 406         }
 407     }
 408 }
 409
 410 sub ban {
 411     my ($mask,$chan) = @_;
 412     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
 413
 414     if ($chan ne "" and &validChan($chan) == 0) {
 415         &ERROR("ban: invalid channel $chan.");
 416         return;
 417     }
 418
 419     $nick =~ tr/A-Z/a-z/;
 420
 421     foreach $chan (@chans) {
 422         if (!&IsNickInChan($nick,$chan) and scalar @chans == 1) {
 423             &status("Ban: $nick is not on $chan.");
 424             next;
 425         }
 426
 427         if (!exists $channels{$chan}{o}{$ident}) {
 428             &status("Ban: do not have ops on $chan :(");
 429             next;
 430         }
 431
 432         &status("Banning $mask from $chan.");
 433         &rawout("MODE $chan +b $mask");
 434     }
 435 }
 436
 437 sub quit {
 438     my ($quitmsg) = @_;
 439     &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
 440     $conn->quit($quitmsg);
 441 }
 442
 443 sub nick {
 444     my ($nick) = @_;
 445
 446     if ($nick =~ /^$mask{nick}$/) {
 447         rawout("NICK ".$nick);
 448         return 1;
 449     }
 450
 451     return 0;
 452 }
 453
 454 sub invite {
 455     my($who, $chan) = @_;
 456     rawout("INVITE $who $chan");
 457 }
 458
 459
 460 ##########
 461 # Channel related functions...
 462 #
 463
 464 # Usage: &joinNextChan();
 465 sub joinNextChan {
 466     if (scalar @joinchan) {
 467         my $chan = shift @joinchan;
 468         &joinchan($chan);
 469
 470         if (my $i = scalar @joinchan) {
 471             &status("joinNextChan: $i chans to join.");
 472         }
 473     } else {
 474         return unless (&IsParam("chanServ_ops"));
 475         if (!$nickserv) {
 476             &DEBUG("jNC: nickserv/chanserv not up?");
 477         }
 478
 479         my @chans = split(/[\s\t]+/, $param{'chanServ_ops'});
 480         foreach $chan (keys %channels) {
 481             next unless (grep /^$chan$/i, @chans);
 482
 483             if (!exists $channels{$chan}{'o'}{$ident}) {
 484                 &status("ChanServ ==> Requesting ops for $chan.");
 485                 &rawout("PRIVMSG ChanServ :OP $chan $ident");
 486             }
 487         }
 488     }
 489 }
 490
 491 # Usage: &GetNickInChans($nick,$chan);
 492 sub GetNickInChans {
 493     my ($nick) = @_;
 494     my @array;
 495
 496     foreach (keys %channels) {
 497         next unless (grep /^\Q$nick\E$/i, keys %{$channels{$_}{''}});
 498         push(@array, $_);
 499     }
 500
 501     return @array;
 502 }
 503
 504 sub IsNickInChan {
 505     my ($nick,$chan) = @_;
 506
 507     $chan =~ tr/A-Z/a-z/;       # not lowercase unfortunately.
 508
 509     if (&validChan($chan) == 0) {
 510         &ERROR("INIC: invalid channel $chan.");
 511         return 0;
 512     }
 513
 514     if (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}}) {
 515         return 1;
 516     } else {
 517         return 0;
 518     }
 519 }
 520
 521 sub IsNickInAnyChan {
 522     my ($nick) = @_;
 523
 524     foreach $chan (keys %channels) {
 525         next unless (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}});
 526         return 1;
 527     }
 528     return 0;
 529 }
 530
 531 # Usage: &validChan($chan);
 532 sub validChan {
 533     my ($chan) = @_;
 534
 535     if (lc $chan ne $chan) {
 536         &WARN("validChan: lc chan != chan. ($chan); fixing.");
 537         $chan =~ tr/A-Z/a-z/;
 538     }
 539
 540     if (exists $channels{$chan}) {
 541         return 1;
 542     } else {
 543         return 0;
 544     }
 545 }
 546
 547 ###
 548 # Usage: &DeleteUserInfo($nick,@chans);
 549 sub DeleteUserInfo {
 550     my ($nick,@chans) = @_;
 551     my ($mode,$chan);
 552
 553     foreach $chan (@chans) {
 554         foreach $mode (keys %{$channels{$chan}}) {
 555             # use grep here?
 556             next unless (exists $channels{$chan}{$mode}{$nick});
 557
 558             delete $channels{$chan}{$mode}{$nick};
 559         }
 560     }
 561 }
 562
 563 sub clearChanVars {
 564     my ($chan) = @_;
 565
 566     delete $channels{$chan};
 567 }
 568
 569 sub clearIRCVars {
 570     &DEBUG("clearIRCVars() called!");
 571     %channels = ();
 572     @joinchan = split /[\t\s]+/, $param{'join_channels'};
 573 }
 574
 575 sub makeChanList {
 576     my ($str)   = @_;
 577     my $inverse = 0;
 578     my @chans;
 579
 580     if ($str eq "ALL") {
 581         return(keys %channels);
 582     } elsif ($str =~ s/^ALL but //i) {
 583         @chans = keys %channels;
 584         foreach (split /[\s\t\,]+/, lc $str) {
 585             @chans = grep !/^$_$/, @chans;
 586         }
 587     } else {
 588         foreach (split /[\s\t\,]+/, lc $str) {
 589             next unless (&validChan($_));
 590             push(@chans, $_);
 591         }
 592     }
 593
 594     @chans;
 595 }
 596
 597 sub closeDCC {
 598     foreach $type (keys %dcc) {
 599         foreach (keys %{$dcc{$type}}) {
 600             &DEBUG("closing DCC $type to $_ (FIXME).");
 601 ###         $irc->removeconn($dcc{$type}{$_});
 602         }
 603     }
 604 }
 605
 606 1;