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 use strict;
   9
  10 no strict 'refs';
  11 no strict 'subs';    # IN/STDIN
  12
  13 use vars qw(%floodjoin %nuh %dcc %cache %conns %channels %param %mask
  14   %chanconf %orig %ircPort %ircstats %last %netsplit);
  15 use vars qw($irc $nickserv $conn $msgType $who $talkchannel
  16   $addressed $postprocess);
  17 use vars qw($notcount $nottime $notsize $msgcount $msgtime $msgsize
  18   $pubcount $pubtime $pubsize);
  19 use vars qw($b_blue $ob);
  20 use vars qw(@ircServers);
  21
  22 #use open ':utf8';
  23 #use open ':std';
  24
  25 $nickserv = 0;
  26
  27 # It's probably closer to 510, but let's be cautious until we calculate it extensively.
  28 my $maxlinelen = 490;
  29
  30 # Keep track of last time we displayed Chans: to avoid spam in logs
  31 my $lastChansTime = 0;
  32
  33 sub ircloop {
  34     my $error   = 0;
  35     my $lastrun = 0;
  36
  37   loop:;
  38     while ( my $host = shift @ircServers ) {
  39
  40         # JUST IN CASE. irq was complaining about this.
  41         if ( $lastrun == time() ) {
  42             &DEBUG('ircloop: hrm... lastrun == time()');
  43             $error++;
  44             sleep 10;
  45             next;
  46         }
  47
  48         if ( !defined $host ) {
  49             &DEBUG('ircloop: ircServers[x] = NULL.');
  50             $lastrun = time();
  51             next;
  52         }
  53         next unless ( exists $ircPort{$host} );
  54
  55         my $retval = &irc( $host, $ircPort{$host} );
  56         next unless ( defined $retval and $retval == 0 );
  57         $error++;
  58
  59         if ( $error % 3 == 0 and $error != 0 ) {
  60             &status('IRC: Could not connect.');
  61             &status('IRC: ');
  62             next;
  63         }
  64
  65         if ( $error >= 3 * 2 ) {
  66             &status('IRC: cannot connect to any IRC servers; stopping.');
  67             &shutdown();
  68             exit 1;
  69         }
  70     }
  71
  72     &status('IRC: ok, done one cycle of IRC servers; trying again.');
  73
  74     &loadIRCServers();
  75     goto loop;
  76 }
  77
  78 sub irc {
  79     my ( $server, $port ) = @_;
  80
  81     $irc = new Net::IRC;
  82
  83     # TODO: move all this to an sql table
  84     my $iaddr = inet_aton($server);
  85     my $paddr = sockaddr_in( $port, $iaddr );
  86     my $proto = getprotobyname('tcp');
  87
  88     # why was this here?
  89     #select STDOUT;
  90
  91     # host->ip.
  92     my $resolve;
  93     if ( $server =~ /\D$/ ) {
  94         my $packed = scalar( gethostbyname($server) );
  95
  96         if ( !defined $packed ) {
  97             &status("  cannot resolve $server.");
  98             return 0;
  99         }
 100
 101         $resolve = inet_ntoa($packed);
 102         ### warning in Sys/Hostname line 78???
 103         ### caused inside Net::IRC?
 104     }
 105
 106     my %args = (
 107         Nick    => $param{'ircNick'},
 108         Server  => $server,
 109         Port    => $port,
 110         Ircname => $param{'ircName'},
 111     );
 112     $args{'LocalAddr'} = $param{'ircHost'}   if ( $param{'ircHost'} );
 113     $args{'Password'}  = $param{'ircPasswd'} if ( $param{'ircPasswd'} );
 114
 115     foreach my $mynick ( split ',', $param{'ircNick'} ) {
 116         &status(
 117 "Connecting to port $port of server $server ($resolve) as $mynick ..."
 118         );
 119         $args{'Nick'} = $mynick;
 120         $args{'Username'} = $mynick;
 121         $conns{$mynick} = $irc->newconn(%args);
 122         if ( !defined $conns{$mynick} ) {
 123             &ERROR('IRC: connection failed.');
 124             &ERROR(
 125 "add \"set ircHost 0.0.0.0\" to your config. If that does not work"
 126             );
 127             &ERROR(
 128 'Please check /etc/hosts to see if you have a localhost line like:'
 129             );
 130             &ERROR('127.0.0.1   localhost    localhost');
 131             &ERROR(
 132                 'If this is still a problem, please contact the maintainer.');
 133         }
 134         $conns{$mynick}->maxlinelen($maxlinelen);
 135
 136         # handler stuff.
 137         $conns{$mynick}->add_global_handler( 'caction',   \&on_action );
 138         $conns{$mynick}->add_global_handler( 'cdcc',      \&on_dcc );
 139         $conns{$mynick}->add_global_handler( 'cping',     \&on_ping );
 140         $conns{$mynick}->add_global_handler( 'crping',    \&on_ping_reply );
 141         $conns{$mynick}->add_global_handler( 'cversion',  \&on_version );
 142         $conns{$mynick}->add_global_handler( 'crversion', \&on_crversion );
 143         $conns{$mynick}->add_global_handler( 'dcc_open',  \&on_dcc_open );
 144         $conns{$mynick}->add_global_handler( 'dcc_close', \&on_dcc_close );
 145         $conns{$mynick}->add_global_handler( 'chat',      \&on_chat );
 146         $conns{$mynick}->add_global_handler( 'msg',       \&on_msg );
 147         $conns{$mynick}->add_global_handler( 'public',    \&on_public );
 148         $conns{$mynick}->add_global_handler( 'join',      \&on_join );
 149         $conns{$mynick}->add_global_handler( 'part',      \&on_part );
 150         $conns{$mynick}->add_global_handler( 'topic',     \&on_topic );
 151         $conns{$mynick}->add_global_handler( 'invite',    \&on_invite );
 152         $conns{$mynick}->add_global_handler( 'kick',      \&on_kick );
 153         $conns{$mynick}->add_global_handler( 'mode',      \&on_mode );
 154         $conns{$mynick}->add_global_handler( 'nick',      \&on_nick );
 155         $conns{$mynick}->add_global_handler( 'quit',      \&on_quit );
 156         $conns{$mynick}->add_global_handler( 'notice',    \&on_notice );
 157         $conns{$mynick}
 158           ->add_global_handler( 'whoischannels', \&on_whoischannels );
 159         $conns{$mynick}
 160           ->add_global_handler( 'useronchannel', \&on_useronchannel );
 161         $conns{$mynick}->add_global_handler( 'whois',      \&on_whois );
 162         $conns{$mynick}->add_global_handler( 'other',      \&on_other );
 163         $conns{$mynick}->add_global_handler( 'disconnect', \&on_disconnect );
 164         $conns{$mynick}
 165           ->add_global_handler( [ 251, 252, 253, 254, 255 ], \&on_init );
 166
 167         #       $conns{$mynick}->add_global_handler(302, \&on_init); # userhost
 168         $conns{$mynick}->add_global_handler( 303, \&on_ison );         # notify.
 169         $conns{$mynick}->add_global_handler( 315, \&on_endofwho );
 170         $conns{$mynick}->add_global_handler( 422, \&on_endofwho );     # nomotd.
 171         $conns{$mynick}->add_global_handler( 324, \&on_modeis );
 172         $conns{$mynick}->add_global_handler( 333, \&on_topicinfo );
 173         $conns{$mynick}->add_global_handler( 352, \&on_who );
 174         $conns{$mynick}->add_global_handler( 353, \&on_names );
 175         $conns{$mynick}->add_global_handler( 366, \&on_endofnames );
 176         $conns{$mynick}->add_global_handler( "001", \&on_connected )
 177           ;    # on_connect.
 178         $conns{$mynick}->add_global_handler( 433, \&on_nick_taken );
 179         $conns{$mynick}->add_global_handler( 439, \&on_targettoofast );
 180
 181         # for proper joinnextChan behaviour
 182         $conns{$mynick}->add_global_handler( 471, \&on_chanfull );
 183         $conns{$mynick}->add_global_handler( 473, \&on_inviteonly );
 184         $conns{$mynick}->add_global_handler( 474, \&on_banned );
 185         $conns{$mynick}->add_global_handler( 475, \&on_badchankey );
 186         $conns{$mynick}->add_global_handler( 443, \&on_useronchan );
 187
 188         # end of handler stuff.
 189     }
 190
 191     &clearIRCVars();
 192
 193     # change internal timeout value for scheduler.
 194     $irc->{_timeout} = 10;    # how about 60?
 195                               # Net::IRC debugging.
 196     $irc->{_debug}   = 1;
 197
 198     $ircstats{'Server'} = "$server:$port";
 199
 200     # works? needs to actually do something
 201     # should likely listen on a tcp port instead
 202     #$irc->addfh(STDIN, \&on_stdin, 'r');
 203
 204     &status('starting main loop');
 205
 206     $irc->start;
 207 }
 208
 209 ######################################################################
 210 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
 211 ######################################################################
 212
 213 sub rawout {
 214     my ($buf) = @_;
 215     $buf =~ s/\n//gi;
 216
 217     # slow down a bit if traffic is 'high'.
 218     # need to take into account time of last message sent.
 219     if ( $last{buflen} > 256 and length($buf) > 256 ) {
 220         sleep 1;
 221     }
 222
 223     $conn->sl($buf) if ( &whatInterface() =~ /IRC/ );
 224
 225     $last{buflen} = length($buf);
 226 }
 227
 228 sub say {
 229     my ($msg) = @_;
 230     my $mynick = $conn->nick();
 231     if ( !defined $msg ) {
 232         $msg ||= 'NULL';
 233         &WARN("say: msg == $msg.");
 234         return;
 235     }
 236
 237     if ( &getChanConf( 'silent', $talkchannel )
 238         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 239     {
 240         &DEBUG("say: silent in $talkchannel, not saying $msg");
 241         return;
 242     }
 243
 244     if ($postprocess) {
 245         undef $postprocess;
 246     }
 247     elsif ( $postprocess = &getChanConf( 'postprocess', $talkchannel ) ) {
 248         &DEBUG("say: $postprocess $msg");
 249         &parseCmdHook( $postprocess . ' ' . $msg );
 250         undef $postprocess;
 251         return;
 252     }
 253
 254     &status("<$mynick/$talkchannel> $msg");
 255
 256     return unless ( &whatInterface() =~ /IRC/ );
 257
 258     $msg = 'zero' if ( $msg =~ /^0+$/ );
 259
 260     my $t = time();
 261
 262     if ( $t == $pubtime ) {
 263         $pubcount++;
 264         $pubsize += length $msg;
 265
 266         my $i = &getChanConfDefault( 'sendPublicLimitLines', 3,    $chan );
 267         my $j = &getChanConfDefault( 'sendPublicLimitBytes', 1000, $chan );
 268
 269         if ( ( $pubcount % $i ) == 0 and $pubcount ) {
 270             sleep 1;
 271         }
 272         elsif ( $pubsize > $j ) {
 273             sleep 1;
 274             $pubsize -= $j;
 275         }
 276
 277     }
 278     else {
 279         $pubcount = 0;
 280         $pubtime  = $t;
 281         $pubsize  = length $msg;
 282     }
 283
 284     $conn->privmsg( $talkchannel, $msg );
 285 }
 286
 287 sub msg {
 288     my ( $nick, $msg ) = @_;
 289     if ( !defined $nick ) {
 290         &ERROR('msg: nick == NULL.');
 291         return;
 292     }
 293
 294     if ( !defined $msg ) {
 295         $msg ||= 'NULL';
 296         &WARN("msg: msg == $msg.");
 297         return;
 298     }
 299
 300     # some say() end up here (eg +help)
 301     if ( &getChanConf( 'silent', $nick )
 302         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 303     {
 304         &DEBUG("msg: silent in $nick, not saying $msg");
 305         return;
 306     }
 307
 308     &status(">$nick< $msg");
 309
 310     return unless ( &whatInterface() =~ /IRC/ );
 311     my $t = time();
 312
 313     if ( $t == $msgtime ) {
 314         $msgcount++;
 315         $msgsize += length $msg;
 316
 317         my $i = &getChanConfDefault( 'sendPrivateLimitLines', 3,    $chan );
 318         my $j = &getChanConfDefault( 'sendPrivateLimitBytes', 1000, $chan );
 319         if ( ( $msgcount % $i ) == 0 and $msgcount ) {
 320             sleep 1;
 321         }
 322         elsif ( $msgsize > $j ) {
 323             sleep 1;
 324             $msgsize -= $j;
 325         }
 326
 327     }
 328     else {
 329         $msgcount = 0;
 330         $msgtime  = $t;
 331         $msgsize  = length $msg;
 332     }
 333
 334     $conn->privmsg( $nick, $msg );
 335 }
 336
 337 # Usage: &action(nick || chan, txt);
 338 sub action {
 339     my $mynick = $conn->nick();
 340     my ( $target, $txt ) = @_;
 341     if ( !defined $txt ) {
 342         &WARN('action: txt == NULL.');
 343         return;
 344     }
 345
 346     if ( &getChanConf( 'silent', $target )
 347         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 348     {
 349         &DEBUG("action: silent in $target, not doing $txt");
 350         return;
 351     }
 352
 353     if ( length $txt > 480 ) {
 354         &status('action: txt too long; truncating.');
 355         chop($txt) while ( length $txt > 480 );
 356     }
 357
 358     &status("* $mynick/$target $txt");
 359     $conn->me( $target, $txt );
 360 }
 361
 362 # Usage: &notice(nick || chan, txt);
 363 sub notice {
 364     my ( $target, $txt ) = @_;
 365     if ( !defined $txt ) {
 366         &WARN('notice: txt == NULL.');
 367         return;
 368     }
 369
 370     &status("-$target- $txt");
 371
 372     my $t = time();
 373
 374     if ( $t == $nottime ) {
 375         $notcount++;
 376         $notsize += length $txt;
 377
 378         my $i = &getChanConfDefault( 'sendNoticeLimitLines', 3,    $chan );
 379         my $j = &getChanConfDefault( 'sendNoticeLimitBytes', 1000, $chan );
 380
 381         if ( ( $notcount % $i ) == 0 and $notcount ) {
 382             sleep 1;
 383         }
 384         elsif ( $notsize > $j ) {
 385             sleep 1;
 386             $notsize -= $j;
 387         }
 388
 389     }
 390     else {
 391         $notcount = 0;
 392         $nottime  = $t;
 393         $notsize  = length $txt;
 394     }
 395
 396     $conn->notice( $target, $txt );
 397 }
 398
 399 sub DCCBroadcast {
 400     my ( $txt, $flag ) = @_;
 401
 402     ### FIXME: flag not supported yet.
 403
 404     foreach ( keys %{ $dcc{'CHAT'} } ) {
 405         $conn->privmsg( $dcc{'CHAT'}{$_}, $txt );
 406     }
 407 }
 408
 409 ##########
 410 ### perform commands.
 411 ###
 412
 413 # Usage: &performReply($reply);
 414 sub performReply {
 415     my ($reply) = @_;
 416
 417     if ( !defined $reply or $reply =~ /^\s*$/ ) {
 418         &DEBUG('performReply: reply == NULL.');
 419         return;
 420     }
 421
 422     $reply =~ /([\.\?\s]+)$/;
 423
 424     # FIXME need real throttling....
 425     if ( length($reply) > $maxlinelen - 30 ) {
 426         $reply = substr( $reply, 0, $maxlinelen - 33 );
 427         $reply =~ s/ [^ ]*?$/ .../;
 428     }
 429     &checkMsgType($reply);
 430
 431     if ( $msgType eq 'public' ) {
 432         if ( rand() < 0.5 or $reply =~ /[\.\?]$/ ) {
 433             $reply = "$orig{who}: " . $reply;
 434         }
 435         else {
 436             $reply = "$reply, " . $orig{who};
 437         }
 438         &say($reply);
 439
 440     }
 441     elsif ( $msgType eq 'private' ) {
 442         if ( rand() > 0.5 ) {
 443             $reply = "$reply, " . $orig{who};
 444         }
 445         &msg( $who, $reply );
 446
 447     }
 448     elsif ( $msgType eq 'chat' ) {
 449         if ( !exists $dcc{'CHAT'}{$who} ) {
 450             &VERB( "pSR: dcc{'CHAT'}{$who} does not exist.", 2 );
 451             return;
 452         }
 453         $conn->privmsg( $dcc{'CHAT'}{$who}, $reply );
 454
 455     }
 456     else {
 457         &ERROR("PR: msgType invalid? ($msgType).");
 458     }
 459 }
 460
 461 # ...
 462 sub performAddressedReply {
 463     return unless ($addressed);
 464     &performReply(@_);
 465 }
 466
 467 # Usage: &performStrictReply($reply);
 468 sub performStrictReply {
 469     my ($reply) = @_;
 470
 471     # FIXME need real throttling....
 472     if ( length($reply) > $maxlinelen - 30 ) {
 473         $reply = substr( $reply, 0, $maxlinelen - 33 );
 474         $reply =~ s/ [^ ]*?$/ .../;
 475     }
 476     &checkMsgType($reply);
 477
 478     if ( $msgType eq 'private' ) {
 479         &msg( $who, $reply );
 480     }
 481     elsif ( $msgType eq 'public' ) {
 482         &say($reply);
 483     }
 484     elsif ( $msgType eq 'chat' ) {
 485         &dccsay( lc $who, $reply );
 486     }
 487     else {
 488         &ERROR("pSR: msgType invalid? ($msgType).");
 489     }
 490 }
 491
 492 sub dccsay {
 493     my ( $who, $reply ) = @_;
 494
 495     if ( !defined $reply or $reply =~ /^\s*$/ ) {
 496         &WARN('dccsay: reply == NULL.');
 497         return;
 498     }
 499
 500     if ( !exists $dcc{'CHAT'}{$who} ) {
 501         &VERB( "pSR: dcc{'CHAT'}{$who} does not exist. (2)", 2 );
 502         return;
 503     }
 504
 505     &status("=>$who<= $reply");    # dcc chat.
 506     $conn->privmsg( $dcc{'CHAT'}{$who}, $reply );
 507 }
 508
 509 sub dcc_close {
 510     my ($who) = @_;
 511     my $type;
 512
 513     foreach $type ( keys %dcc ) {
 514         &FIXME("dcc_close: $who");
 515         my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} };
 516         next unless ( scalar @who );
 517         $who = $who[0];
 518         &DEBUG("dcc_close... close $who!");
 519     }
 520 }
 521
 522 sub joinchan {
 523     my ( $chan, $key ) = @_;
 524     $key ||= &getChanConf( 'chankey', $chan );
 525     $key ||= '';
 526     my $mynick = $conn->nick();
 527
 528     # forgot for about 2 years to implement channel keys when moving
 529     # over to Net::IRC...
 530
 531     # hopefully validChan is right.
 532     if ( &validChan($chan) ) {
 533         &status("join: already on $chan?");
 534     }
 535
 536     #} else {
 537     &status("$mynick joining $b_blue$chan $key$ob");
 538
 539     return if ( $conn->join( $chan, $key ) );
 540     return if ( &validChan($chan) );
 541
 542     &DEBUG('joinchan: join failed. trying connect!');
 543     &clearIRCVars();
 544     $conn->connect();
 545
 546     #}
 547 }
 548
 549 sub part {
 550     my $chan;
 551
 552     foreach $chan (@_) {
 553         next if ( $chan eq '' );
 554         $chan =~ tr/A-Z/a-z/;    # lowercase.
 555
 556         if ( $chan !~ /^$mask{chan}$/ ) {
 557             &WARN("part: chan is invalid ($chan)");
 558             next;
 559         }
 560
 561         &status("parting $chan");
 562         if ( !&validChan($chan) ) {
 563             &WARN("part: not on $chan; doing anyway");
 564
 565             #       next;
 566         }
 567
 568         $conn->part($chan);
 569
 570         # deletion of $channels{chan} is done in &entryEvt().
 571     }
 572 }
 573
 574 sub mode {
 575     my ( $chan, @modes ) = @_;
 576     my $modes = join( ' ', @modes );
 577
 578     if ( &validChan($chan) == 0 ) {
 579         &ERROR("mode: invalid chan => '$chan'.");
 580         return;
 581     }
 582
 583     &DEBUG("mode: MODE $chan $modes");
 584
 585     # should move to use Net::IRC's $conn->mode()... but too lazy.
 586     rawout("MODE $chan $modes");
 587 }
 588
 589 sub op {
 590     my ( $chan, @who ) = @_;
 591     my $os = 'o' x scalar(@who);
 592
 593     &mode( $chan, "+$os @who" );
 594 }
 595
 596 sub deop {
 597     my ( $chan, @who ) = @_;
 598     my $os = 'o' x scalar(@who);
 599
 600     &mode( $chan, "-$os " . @who );
 601 }
 602
 603 sub kick {
 604     my ( $nick, $chan, $msg ) = @_;
 605     my (@chans) = ( $chan eq '' ) ? ( keys %channels ) : lc($chan);
 606     my $mynick = $conn->nick();
 607
 608     if ( $chan ne '' and &validChan($chan) == 0 ) {
 609         &ERROR("kick: invalid channel $chan.");
 610         return;
 611     }
 612
 613     $nick =~ tr/A-Z/a-z/;
 614
 615     foreach $chan (@chans) {
 616         if ( !&IsNickInChan( $nick, $chan ) ) {
 617             &status("kick: $nick is not on $chan.") if ( scalar @chans == 1 );
 618             next;
 619         }
 620
 621         if ( !exists $channels{$chan}{o}{$mynick} ) {
 622             &status("kick: do not have ops on $chan :(");
 623             next;
 624         }
 625
 626         &status("Kicking $nick from $chan.");
 627         $conn->kick( $chan, $nick, $msg );
 628     }
 629 }
 630
 631 sub ban {
 632     my ( $mask, $chan ) = @_;
 633     my (@chans) = ( $chan =~ /^\*?$/ ) ? ( keys %channels ) : lc($chan);
 634     my $mynick = $conn->nick();
 635     my $ban    = 0;
 636
 637     if ( $chan !~ /^\*?$/ and &validChan($chan) == 0 ) {
 638         &ERROR("ban: invalid channel $chan.");
 639         return;
 640     }
 641
 642     foreach $chan (@chans) {
 643         if ( !exists $channels{$chan}{o}{$mynick} ) {
 644             &status("ban: do not have ops on $chan :(");
 645             next;
 646         }
 647
 648         &status("Banning $mask from $chan.");
 649         &rawout("MODE $chan +b $mask");
 650         $ban++;
 651     }
 652
 653     return $ban;
 654 }
 655
 656 sub unban {
 657     my ( $mask, $chan ) = @_;
 658     my (@chans) = ( $chan =~ /^\*?$/ ) ? ( keys %channels ) : lc($chan);
 659     my $mynick = $conn->nick();
 660     my $ban    = 0;
 661
 662     &DEBUG("unban: mask = $mask, chan = @chans");
 663
 664     foreach $chan (@chans) {
 665         if ( !exists $channels{$chan}{o}{$mynick} ) {
 666             &status("unBan: do not have ops on $chan :(");
 667             next;
 668         }
 669
 670         &status("Removed ban $mask from $chan.");
 671         &rawout("MODE $chan -b $mask");
 672         $ban++;
 673     }
 674
 675     return $ban;
 676 }
 677
 678 sub quit {
 679     my ($quitmsg) = @_;
 680     if ( defined $conn ) {
 681         &status( 'QUIT ' . $conn->nick() . " has quit IRC ($quitmsg)" );
 682         $conn->quit($quitmsg);
 683     }
 684     else {
 685         &WARN('quit: could not quit!');
 686     }
 687 }
 688
 689 sub nick {
 690     my ($newnick) = @_;
 691     my $mynick = $conn->nick();
 692
 693     if ( !defined $newnick ) {
 694         &ERROR('nick: nick == NULL.');
 695         return;
 696     }
 697
 698     if ( !defined $mynick ) {
 699         &WARN('nick: mynick == NULL.');
 700         return;
 701     }
 702
 703     my $bad = 0;
 704     $bad++ if ( exists $nuh{$newnick} );
 705     $bad++ if ( &IsNickInAnyChan($newnick) );
 706
 707     if ($bad) {
 708         &WARN(  "Nick: not going to try to change from $mynick to $newnick. ["
 709               . scalar(gmtime)
 710               . ']' );
 711
 712         # hrm... over time we lose track of our own nick.
 713         #return;
 714     }
 715
 716     if ( $newnick =~ /^$mask{nick}$/ ) {
 717         &status("nick: Changing nick from $mynick to $newnick");
 718
 719         # ->nick() will NOT change cause we are using rawout?
 720         &rawout("NICK $newnick");
 721         return 1;
 722     }
 723     &DEBUG("nick: failed... why oh why (mynick=$mynick, newnick=$newnick)");
 724     return 0;
 725 }
 726
 727 sub invite {
 728     my ( $who, $chan ) = @_;
 729
 730     # TODO: check if $who or $chan are invalid.
 731
 732     $conn->invite( $who, $chan );
 733 }
 734
 735 ##########
 736 # Channel related functions...
 737 #
 738
 739 # Usage: &joinNextChan();
 740 sub joinNextChan {
 741     my $joined = 0;
 742     foreach ( sort keys %conns ) {
 743         $conn = $conns{$_};
 744         my $mynick = $conn->nick();
 745         my @join   = getJoinChans(1);
 746
 747         if ( scalar @join ) {
 748             my $chan = shift @join;
 749             &joinchan($chan);
 750
 751             if ( my $i = scalar @join ) {
 752                 &status("joinNextChan: $mynick $i chans to join.");
 753             }
 754             $joined = 1;
 755         }
 756     }
 757     return if $joined;
 758
 759     if ( exists $cache{joinTime} ) {
 760         my $delta   = time() - $cache{joinTime} - 5;
 761         my $timestr = &Time2String($delta);
 762
 763         # FIXME: @join should be @in instead (hacked to 10)
 764         #my $rate       = sprintf('%.1f', $delta / @in);
 765         my $rate = sprintf( '%.1f', $delta / 10 );
 766         delete $cache{joinTime};
 767
 768         &status("time taken to join all chans: $timestr; rate: $rate sec/join");
 769     }
 770
 771     # chanserv check: global channels, in case we missed one.
 772     foreach ( &ChanConfList('chanServ_ops') ) {
 773         &chanServCheck($_);
 774     }
 775 }
 776
 777 # Usage: &getNickInChans($nick);
 778 sub getNickInChans {
 779     my ($nick) = @_;
 780     my @array;
 781
 782     foreach ( keys %channels ) {
 783         next unless ( grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} } );
 784         push( @array, $_ );
 785     }
 786
 787     return @array;
 788 }
 789
 790 # Usage: &getNicksInChan($chan);
 791 sub getNicksInChan {
 792     my ($chan) = @_;
 793     my @array;
 794
 795     return keys %{ $channels{$chan}{''} };
 796 }
 797
 798 sub IsNickInChan {
 799     my ( $nick, $chan ) = @_;
 800
 801     $chan =~ tr/A-Z/a-z/;    # not lowercase unfortunately.
 802
 803     if ( $chan =~ /^$/ ) {
 804         &DEBUG('INIC: chan == NULL.');
 805         return 0;
 806     }
 807
 808     if ( &validChan($chan) == 0 ) {
 809         &ERROR("INIC: invalid channel $chan.");
 810         return 0;
 811     }
 812
 813     if ( grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} } ) {
 814         return 1;
 815     }
 816     else {
 817         foreach ( keys %channels ) {
 818             next unless (/[A-Z]/);
 819             &DEBUG('iNIC: hash channels contains mixed cased chan!!!');
 820         }
 821         return 0;
 822     }
 823 }
 824
 825 sub IsNickInAnyChan {
 826     my ($nick) = @_;
 827     my $chan;
 828
 829     foreach $chan ( keys %channels ) {
 830         next unless ( grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} } );
 831         return 1;
 832     }
 833     return 0;
 834 }
 835
 836 # Usage: &validChan($chan);
 837 sub validChan {
 838
 839     # TODO: use $c instead?
 840     my ($chan) = @_;
 841
 842     if ( !defined $chan or $chan =~ /^\s*$/ ) {
 843         return 0;
 844     }
 845
 846     if ( lc $chan ne $chan ) {
 847         &WARN("validChan: lc chan != chan. ($chan); fixing.");
 848         $chan =~ tr/A-Z/a-z/;
 849     }
 850
 851     # it's possible that this check creates the hash if empty.
 852     if ( defined $channels{$chan} or exists $channels{$chan} ) {
 853         if ( $chan =~ /^_?default$/ ) {
 854
 855             #       &WARN('validC: chan cannot be _default! returning 0!');
 856             return 0;
 857         }
 858
 859         return 1;
 860     }
 861     else {
 862         return 0;
 863     }
 864 }
 865
 866 ###
 867 # Usage: &delUserInfo($nick,@chans);
 868 sub delUserInfo {
 869     my ( $nick, @chans ) = @_;
 870     my ( $mode, $chan );
 871
 872     foreach $chan (@chans) {
 873         foreach $mode ( keys %{ $channels{$chan} } ) {
 874
 875             # use grep here?
 876             next unless ( exists $channels{$chan}{$mode}{$nick} );
 877
 878             delete $channels{$chan}{$mode}{$nick};
 879         }
 880     }
 881 }
 882
 883 sub clearChanVars {
 884     my ($chan) = @_;
 885
 886     delete $channels{$chan};
 887 }
 888
 889 sub clearIRCVars {
 890     undef %channels;
 891     undef %floodjoin;
 892
 893     $cache{joinTime} = time();
 894 }
 895
 896 sub getJoinChans {
 897
 898     # $show should contain the min number of seconds between display
 899     # of the Chans: status line. Use 0 to disable
 900     my $show = shift;
 901
 902     my @in;
 903     my @skip;
 904     my @join;
 905
 906     # Display 'Chans:' only if more than $show seconds since last display
 907     if ( time() - $lastChansTime > $show ) {
 908         $lastChansTime = time();
 909     }
 910     else {
 911         $show = 0;    # Don't display since < 15min since last
 912     }
 913
 914     # can't join any if not connected
 915     return @join if ( !$conn );
 916
 917     my $nick = $conn->nick();
 918
 919     foreach ( keys %chanconf ) {
 920         next if ( $_ eq '_default' );
 921
 922         my $skip = 0;
 923         my $val  = $chanconf{$_}{autojoin};
 924
 925         if ( defined $val ) {
 926             $skip++ if ( $val eq '0' );
 927             if ( $val eq '1' ) {
 928
 929                 # convert old +autojoin to autojoin <nick>
 930                 $val = lc $nick;
 931                 $chanconf{$_}{autojoin} = $val;
 932             }
 933             $skip++ if ( lc $val ne lc $nick );
 934         }
 935         else {
 936             $skip++;
 937         }
 938
 939         if ($skip) {
 940             push( @skip, $_ );
 941         }
 942         else {
 943             if ( defined $channels{$_} or exists $channels{$_} ) {
 944                 push( @in, $_ );
 945             }
 946             else {
 947                 push( @join, $_ );
 948             }
 949         }
 950     }
 951
 952     my $str;
 953     $str .= ' in:' . join( ',',   sort @in )   if scalar @in;
 954     $str .= ' skip:' . join( ',', sort @skip ) if scalar @skip;
 955     $str .= ' join:' . join( ',', sort @join ) if scalar @join;
 956
 957     &status("Chans: ($nick)$str") if ($show);
 958
 959     return sort @join;
 960 }
 961
 962 sub closeDCC {
 963
 964     #    &DEBUG('closeDCC called.');
 965     my $type;
 966
 967     foreach $type ( keys %dcc ) {
 968         next if ( $type ne uc($type) );
 969
 970         my $nick;
 971         foreach $nick ( keys %{ $dcc{$type} } ) {
 972             next unless ( defined $nick );
 973             &status("DCC CHAT: closing DCC $type to $nick.");
 974             next unless ( defined $dcc{$type}{$nick} );
 975
 976             my $ref = $dcc{$type}{$nick};
 977             &dccsay( $nick, "bye bye, $nick" ) if ( $type =~ /^chat$/i );
 978             $dcc{$type}{$nick}->close();
 979             delete $dcc{$type}{$nick};
 980             &DEBUG("after close for $nick");
 981         }
 982         delete $dcc{$type};
 983     }
 984 }
 985
 986 sub joinfloodCheck {
 987     my ( $who, $chan, $userhost ) = @_;
 988
 989     return unless ( &IsChanConf('joinfloodCheck') > 0 );
 990
 991     if ( exists $netsplit{ lc $who } ) {    # netsplit join.
 992         &DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
 993     }
 994
 995     if ( exists $floodjoin{$chan}{$who}{Time} ) {
 996         &WARN("floodjoin{$chan}{$who} already exists?");
 997     }
 998
 999     $floodjoin{$chan}{$who}{Time} = time();
1000     $floodjoin{$chan}{$who}{Host} = $userhost;
1001
1002     ### Check...
1003     foreach ( keys %floodjoin ) {
1004         my $c     = $_;
1005         my $count = scalar keys %{ $floodjoin{$c} };
1006         next unless ( $count > 5 );
1007         &DEBUG("joinflood: count => $count");
1008
1009         my $time;
1010         foreach ( keys %{ $floodjoin{$c} } ) {
1011             my $t = $floodjoin{$c}{$_}{Time};
1012             next unless ( defined $t );
1013
1014             $time += $t;
1015         }
1016         &DEBUG("joinflood: time => $time");
1017         $time /= $count;
1018
1019         &DEBUG("joinflood: new time => $time");
1020     }
1021
1022     ### Clean it up.
1023     my $delete = 0;
1024     my $time   = time();
1025     foreach $chan ( keys %floodjoin ) {
1026         foreach $who ( keys %{ $floodjoin{$chan} } ) {
1027             my $t = $floodjoin{$chan}{$who}{Time};
1028             next unless ( defined $t );
1029
1030             my $delta = $time - $t;
1031             next unless ( $delta > 10 );
1032
1033             delete $floodjoin{$chan}{$who};
1034             $delete++;
1035         }
1036     }
1037
1038     &DEBUG("joinfloodCheck: $delete deleted.") if ($delete);
1039 }
1040
1041 sub getHostMask {
1042     my ($n) = @_;
1043
1044     if ( exists $nuh{$n} ) {
1045         return &makeHostMask( $nuh{$n} );
1046     }
1047     else {
1048         $cache{on_who_Hack} = 1;
1049         $conn->who($n);
1050     }
1051 }
1052
1053 1;
1054
1055 # vim:ts=4:sw=4:expandtab:tw=80