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