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                 #binmode $conns{$mynick}->{_socket}, ":encoding(UTF-8)";
 132                 # TODO: need to input bytes, but output utf8
 133                 binmode $conns{$mynick}->{_socket}, ":bytes";
 134                 binmode $conns{$mynick}->socket, ":bytes";
 135
 136                 $conns{$mynick}->maxlinelen($maxlinelen);
 137
 138                 # handler stuff.
 139                 $conns{$mynick}->add_global_handler( 'caction',   \&on_action );
 140                 $conns{$mynick}->add_global_handler( 'cdcc',      \&on_dcc );
 141                 $conns{$mynick}->add_global_handler( 'cping',     \&on_ping );
 142                 $conns{$mynick}->add_global_handler( 'crping',    \&on_ping_reply );
 143                 $conns{$mynick}->add_global_handler( 'cversion',  \&on_version );
 144                 $conns{$mynick}->add_global_handler( 'crversion', \&on_crversion );
 145                 $conns{$mynick}->add_global_handler( 'dcc_open',  \&on_dcc_open );
 146                 $conns{$mynick}->add_global_handler( 'dcc_close', \&on_dcc_close );
 147                 $conns{$mynick}->add_global_handler( 'chat',      \&on_chat );
 148                 $conns{$mynick}->add_global_handler( 'msg',       \&on_msg );
 149                 $conns{$mynick}->add_global_handler( 'public',    \&on_public );
 150                 $conns{$mynick}->add_global_handler( 'join',      \&on_join );
 151                 $conns{$mynick}->add_global_handler( 'part',      \&on_part );
 152                 $conns{$mynick}->add_global_handler( 'topic',     \&on_topic );
 153                 $conns{$mynick}->add_global_handler( 'invite',    \&on_invite );
 154                 $conns{$mynick}->add_global_handler( 'kick',      \&on_kick );
 155                 $conns{$mynick}->add_global_handler( 'mode',      \&on_mode );
 156                 $conns{$mynick}->add_global_handler( 'nick',      \&on_nick );
 157                 $conns{$mynick}->add_global_handler( 'quit',      \&on_quit );
 158                 $conns{$mynick}->add_global_handler( 'notice',    \&on_notice );
 159                 $conns{$mynick}->add_global_handler( 'whoischannels', \&on_whoischannels );
 160                 $conns{$mynick}->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}->add_global_handler( [ 251, 252, 253, 254, 255 ], \&on_init );
 165
 166                 #       $conns{$mynick}->add_global_handler(302, \&on_init); # userhost
 167                 $conns{$mynick}->add_global_handler( 303, \&on_ison );         # notify.
 168                 $conns{$mynick}->add_global_handler( 315, \&on_endofwho );
 169                 $conns{$mynick}->add_global_handler( 422, \&on_endofwho );     # nomotd.
 170                 $conns{$mynick}->add_global_handler( 324, \&on_modeis );
 171                 $conns{$mynick}->add_global_handler( 333, \&on_topicinfo );
 172                 $conns{$mynick}->add_global_handler( 352, \&on_who );
 173                 $conns{$mynick}->add_global_handler( 353, \&on_names );
 174                 $conns{$mynick}->add_global_handler( 366, \&on_endofnames );
 175                 $conns{$mynick}->add_global_handler( "001", \&on_connected )
 176                   ;    # on_connect.
 177                 $conns{$mynick}->add_global_handler( 433, \&on_nick_taken );
 178                 $conns{$mynick}->add_global_handler( 439, \&on_targettoofast );
 179
 180                 # for proper joinnextChan behaviour
 181                 $conns{$mynick}->add_global_handler( 471, \&on_chanfull );
 182                 $conns{$mynick}->add_global_handler( 473, \&on_inviteonly );
 183                 $conns{$mynick}->add_global_handler( 474, \&on_banned );
 184                 $conns{$mynick}->add_global_handler( 475, \&on_badchankey );
 185                 $conns{$mynick}->add_global_handler( 443, \&on_useronchan );
 186
 187                 # end of handler stuff.
 188             }
 189         }
 190     }
 191
 192     &clearIRCVars();
 193
 194     # change internal timeout value for scheduler.
 195     $irc->{_timeout} = 10;    # how about 60?
 196                               # Net::IRC debugging.
 197     $irc->{_debug}   = 1;
 198
 199     $ircstats{'Server'} = "$server:$port";
 200
 201     # works? needs to actually do something
 202     # should likely listen on a tcp port instead
 203     #$irc->addfh(STDIN, \&on_stdin, 'r');
 204
 205     &status('starting main loop');
 206
 207     $irc->start;
 208 }
 209
 210 ######################################################################
 211 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
 212 ######################################################################
 213
 214 sub rawout {
 215     my ($buf) = @_;
 216     $buf =~ s/\n//gi;
 217
 218     # slow down a bit if traffic is 'high'.
 219     # need to take into account time of last message sent.
 220     if ( $last{buflen} > 256 and length($buf) > 256 ) {
 221         sleep 1;
 222     }
 223
 224     $conn->sl($buf) if ( &whatInterface() =~ /IRC/ );
 225
 226     $last{buflen} = length($buf);
 227 }
 228
 229 sub say {
 230     my ($msg) = @_;
 231     my $mynick = $conn->nick();
 232     if ( !defined $msg ) {
 233         $msg ||= 'NULL';
 234         &WARN("say: msg == $msg.");
 235         return;
 236     }
 237
 238     if ( &getChanConf( 'silent', $talkchannel )
 239         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 240     {
 241         &DEBUG("say: silent in $talkchannel, not saying $msg");
 242         return;
 243     }
 244
 245     if ($postprocess) {
 246         undef $postprocess;
 247     }
 248     elsif ( $postprocess = &getChanConf( 'postprocess', $talkchannel ) ) {
 249         &DEBUG("say: $postprocess $msg");
 250         &parseCmdHook( $postprocess . ' ' . $msg );
 251         undef $postprocess;
 252         return;
 253     }
 254
 255     &status("<$mynick/$talkchannel> $msg");
 256
 257     return unless ( &whatInterface() =~ /IRC/ );
 258
 259     $msg = 'zero' if ( $msg =~ /^0+$/ );
 260
 261     my $t = time();
 262
 263     if ( $t == $pubtime ) {
 264         $pubcount++;
 265         $pubsize += length $msg;
 266
 267         my $i = &getChanConfDefault( 'sendPublicLimitLines', 3,    $chan );
 268         my $j = &getChanConfDefault( 'sendPublicLimitBytes', 1000, $chan );
 269
 270         if ( ( $pubcount % $i ) == 0 and $pubcount ) {
 271             sleep 1;
 272         }
 273         elsif ( $pubsize > $j ) {
 274             sleep 1;
 275             $pubsize -= $j;
 276         }
 277
 278     }
 279     else {
 280         $pubcount = 0;
 281         $pubtime  = $t;
 282         $pubsize  = length $msg;
 283     }
 284
 285     $conn->privmsg( $talkchannel, $msg );
 286 }
 287
 288 sub msg {
 289     my ( $nick, $msg ) = @_;
 290     if ( !defined $nick ) {
 291         &ERROR('msg: nick == NULL.');
 292         return;
 293     }
 294
 295     if ( !defined $msg ) {
 296         $msg ||= 'NULL';
 297         &WARN("msg: msg == $msg.");
 298         return;
 299     }
 300
 301     # some say() end up here (eg +help)
 302     if ( &getChanConf( 'silent', $nick )
 303         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 304     {
 305         &DEBUG("msg: silent in $nick, not saying $msg");
 306         return;
 307     }
 308
 309     &status(">$nick< $msg");
 310
 311     return unless ( &whatInterface() =~ /IRC/ );
 312     my $t = time();
 313
 314     if ( $t == $msgtime ) {
 315         $msgcount++;
 316         $msgsize += length $msg;
 317
 318         my $i = &getChanConfDefault( 'sendPrivateLimitLines', 3,    $chan );
 319         my $j = &getChanConfDefault( 'sendPrivateLimitBytes', 1000, $chan );
 320         if ( ( $msgcount % $i ) == 0 and $msgcount ) {
 321             sleep 1;
 322         }
 323         elsif ( $msgsize > $j ) {
 324             sleep 1;
 325             $msgsize -= $j;
 326         }
 327
 328     }
 329     else {
 330         $msgcount = 0;
 331         $msgtime  = $t;
 332         $msgsize  = length $msg;
 333     }
 334
 335     $conn->privmsg( $nick, $msg );
 336 }
 337
 338 # Usage: &action(nick || chan, txt);
 339 sub action {
 340     my $mynick = $conn->nick();
 341     my ( $target, $txt ) = @_;
 342     if ( !defined $txt ) {
 343         &WARN('action: txt == NULL.');
 344         return;
 345     }
 346
 347     if ( &getChanConf( 'silent', $target )
 348         and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
 349     {
 350         &DEBUG("action: silent in $target, not doing $txt");
 351         return;
 352     }
 353
 354     if ( length $txt > 480 ) {
 355         &status('action: txt too long; truncating.');
 356         chop($txt) while ( length $txt > 480 );
 357     }
 358
 359     &status("* $mynick/$target $txt");
 360     $conn->me( $target, $txt );
 361 }
 362
 363 # Usage: &notice(nick || chan, txt);
 364 sub notice {
 365     my ( $target, $txt ) = @_;
 366     if ( !defined $txt ) {
 367         &WARN('notice: txt == NULL.');
 368         return;
 369     }
 370
 371     &status("-$target- $txt");
 372
 373     my $t = time();
 374
 375     if ( $t == $nottime ) {
 376         $notcount++;
 377         $notsize += length $txt;
 378
 379         my $i = &getChanConfDefault( 'sendNoticeLimitLines', 3,    $chan );
 380         my $j = &getChanConfDefault( 'sendNoticeLimitBytes', 1000, $chan );
 381
 382         if ( ( $notcount % $i ) == 0 and $notcount ) {
 383             sleep 1;
 384         }
 385         elsif ( $notsize > $j ) {
 386             sleep 1;
 387             $notsize -= $j;
 388         }
 389
 390     }
 391     else {
 392         $notcount = 0;
 393         $nottime  = $t;
 394         $notsize  = length $txt;
 395     }
 396
 397     $conn->notice( $target, $txt );
 398 }
 399
 400 sub DCCBroadcast {
 401     my ( $txt, $flag ) = @_;
 402
 403     ### FIXME: flag not supported yet.
 404
 405     foreach ( keys %{ $dcc{'CHAT'} } ) {
 406         $conn->privmsg( $dcc{'CHAT'}{$_}, $txt );
 407     }
 408 }
 409
 410 ##########
 411 ### perform commands.
 412 ###
 413
 414 # Usage: &performReply($reply);
 415 sub performReply {
 416     my ($reply) = @_;
 417
 418     if ( !defined $reply or $reply =~ /^\s*$/ ) {
 419         &DEBUG('performReply: reply == NULL.');
 420         return;
 421     }
 422
 423     $reply =~ /([\.\?\s]+)$/;
 424
 425     # FIXME need real throttling....
 426     if ( length($reply) > $maxlinelen - 30 ) {
 427         $reply = substr( $reply, 0, $maxlinelen - 33 );
 428         $reply =~ s/ [^ ]*?$/ .../;
 429     }
 430     &checkMsgType($reply);
 431
 432     if ( $msgType eq 'public' ) {
 433         if ( rand() < 0.5 or $reply =~ /[\.\?]$/ ) {
 434             $reply = "$orig{who}: " . $reply;
 435         }
 436         else {
 437             $reply = "$reply, " . $orig{who};
 438         }
 439         &say($reply);
 440
 441     }
 442     elsif ( $msgType eq 'private' ) {
 443         if ( rand() > 0.5 ) {
 444             $reply = "$reply, " . $orig{who};
 445         }
 446         &msg( $who, $reply );
 447
 448     }
 449     elsif ( $msgType eq 'chat' ) {
 450         if ( !exists $dcc{'CHAT'}{$who} ) {
 451             &VERB( "pSR: dcc{'CHAT'}{$who} does not exist.", 2 );
 452             return;
 453         }
 454         $conn->privmsg( $dcc{'CHAT'}{$who}, $reply );
 455
 456     }
 457     else {
 458         &ERROR("PR: msgType invalid? ($msgType).");
 459     }
 460 }
 461
 462 # ...
 463 sub performAddressedReply {
 464     return unless ($addressed);
 465     &performReply(@_);
 466 }
 467
 468 # Usage: &performStrictReply($reply);
 469 sub performStrictReply {
 470     my ($reply) = @_;
 471
 472     # FIXME need real throttling....
 473     if ( length($reply) > $maxlinelen - 30 ) {
 474         $reply = substr( $reply, 0, $maxlinelen - 33 );
 475         $reply =~ s/ [^ ]*?$/ .../;
 476     }
 477     &checkMsgType($reply);
 478
 479     if ( $msgType eq 'private' ) {
 480         &msg( $who, $reply );
 481     }
 482     elsif ( $msgType eq 'public' ) {
 483         &say($reply);
 484     }
 485     elsif ( $msgType eq 'chat' ) {
 486         &dccsay( lc $who, $reply );
 487     }
 488     else {
 489         &ERROR("pSR: msgType invalid? ($msgType).");
 490     }
 491 }
 492
 493 sub dccsay {
 494     my ( $who, $reply ) = @_;
 495
 496     if ( !defined $reply or $reply =~ /^\s*$/ ) {
 497         &WARN('dccsay: reply == NULL.');
 498         return;
 499     }
 500
 501     if ( !exists $dcc{'CHAT'}{$who} ) {
 502         &VERB( "pSR: dcc{'CHAT'}{$who} does not exist. (2)", 2 );
 503         return;
 504     }
 505
 506     &status("=>$who<= $reply");    # dcc chat.
 507     $conn->privmsg( $dcc{'CHAT'}{$who}, $reply );
 508 }
 509
 510 sub dcc_close {
 511     my ($who) = @_;
 512     my $type;
 513
 514     foreach $type ( keys %dcc ) {
 515         &FIXME("dcc_close: $who");
 516         my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} };
 517         next unless ( scalar @who );
 518         $who = $who[0];
 519         &DEBUG("dcc_close... close $who!");
 520     }
 521 }
 522
 523 sub joinchan {
 524     my ( $chan, $key ) = @_;
 525     $key ||= &getChanConf( 'chankey', $chan );
 526     $key ||= '';
 527     my $mynick = $conn->nick();
 528
 529     # forgot for about 2 years to implement channel keys when moving
 530     # over to Net::IRC...
 531
 532     # hopefully validChan is right.
 533     if ( &validChan($chan) ) {
 534         &status("join: already on $chan?");
 535     }
 536
 537     #} else {
 538     &status("$mynick joining $b_blue$chan $key$ob");
 539
 540     return if ( $conn->join( $chan, $key ) );
 541     return if ( &validChan($chan) );
 542
 543     &DEBUG('joinchan: join failed. trying connect!');
 544     &clearIRCVars();
 545     $conn->connect();
 546
 547     #}
 548 }
 549
 550 sub part {
 551     my $chan;
 552
 553     foreach $chan (@_) {
 554         next if ( $chan eq '' );
 555         $chan =~ tr/A-Z/a-z/;    # lowercase.
 556
 557         if ( $chan !~ /^$mask{chan}$/ ) {
 558             &WARN("part: chan is invalid ($chan)");
 559             next;
 560         }
 561
 562         &status("parting $chan");
 563         if ( !&validChan($chan) ) {
 564             &WARN("part: not on $chan; doing anyway");
 565
 566             #       next;
 567         }
 568
 569         $conn->part($chan);
 570
 571         # deletion of $channels{chan} is done in &entryEvt().
 572     }
 573 }
 574
 575 sub mode {
 576     my ( $chan, @modes ) = @_;
 577     my $modes = join( ' ', @modes );
 578
 579     if ( &validChan($chan) == 0 ) {
 580         &ERROR("mode: invalid chan => '$chan'.");
 581         return;
 582     }
 583
 584     &DEBUG("mode: MODE $chan $modes");
 585
 586     # should move to use Net::IRC's $conn->mode()... but too lazy.
 587     rawout("MODE $chan $modes");
 588 }
 589
 590 sub op {
 591     my ( $chan, @who ) = @_;
 592     my $os = 'o' x scalar(@who);
 593
 594     &mode( $chan, "+$os @who" );
 595 }
 596
 597 sub deop {
 598     my ( $chan, @who ) = @_;
 599     my $os = 'o' x scalar(@who);
 600
 601     &mode( $chan, "-$os " . @who );
 602 }
 603
 604 sub kick {
 605     my ( $nick, $chan, $msg ) = @_;
 606     my (@chans) = ( $chan eq '' ) ? ( keys %channels ) : lc($chan);
 607     my $mynick = $conn->nick();
 608
 609     if ( $chan ne '' and &validChan($chan) == 0 ) {
 610         &ERROR("kick: invalid channel $chan.");
 611         return;
 612     }
 613
 614     $nick =~ tr/A-Z/a-z/;
 615
 616     foreach $chan (@chans) {
 617         if ( !&IsNickInChan( $nick, $chan ) ) {
 618             &status("kick: $nick is not on $chan.") if ( scalar @chans == 1 );
 619             next;
 620         }
 621
 622         if ( !exists $channels{$chan}{o}{$mynick} ) {
 623             &status("kick: do not have ops on $chan :(");
 624             next;
 625         }
 626
 627         &status("Kicking $nick from $chan.");
 628         $conn->kick( $chan, $nick, $msg );
 629     }
 630 }
 631
 632 sub ban {
 633     my ( $mask, $chan ) = @_;
 634     my (@chans) = ( $chan =~ /^\*?$/ ) ? ( keys %channels ) : lc($chan);
 635     my $mynick = $conn->nick();
 636     my $ban    = 0;
 637
 638     if ( $chan !~ /^\*?$/ and &validChan($chan) == 0 ) {
 639         &ERROR("ban: invalid channel $chan.");
 640         return;
 641     }
 642
 643     foreach $chan (@chans) {
 644         if ( !exists $channels{$chan}{o}{$mynick} ) {
 645             &status("ban: do not have ops on $chan :(");
 646             next;
 647         }
 648
 649         &status("Banning $mask from $chan.");
 650         &rawout("MODE $chan +b $mask");
 651         $ban++;
 652     }
 653
 654     return $ban;
 655 }
 656
 657 sub unban {
 658     my ( $mask, $chan ) = @_;
 659     my (@chans) = ( $chan =~ /^\*?$/ ) ? ( keys %channels ) : lc($chan);
 660     my $mynick = $conn->nick();
 661     my $ban    = 0;
 662
 663     &DEBUG("unban: mask = $mask, chan = @chans");
 664
 665     foreach $chan (@chans) {
 666         if ( !exists $channels{$chan}{o}{$mynick} ) {
 667             &status("unBan: do not have ops on $chan :(");
 668             next;
 669         }
 670
 671         &status("Removed ban $mask from $chan.");
 672         &rawout("MODE $chan -b $mask");
 673         $ban++;
 674     }
 675
 676     return $ban;
 677 }
 678
 679 sub quit {
 680     my ($quitmsg) = @_;
 681     if ( defined $conn ) {
 682         &status( 'QUIT ' . $conn->nick() . " has quit IRC ($quitmsg)" );
 683         $conn->quit($quitmsg);
 684     }
 685     else {
 686         &WARN('quit: could not quit!');
 687     }
 688 }
 689
 690 sub nick {
 691     my ($newnick) = @_;
 692     my $mynick = $conn->nick();
 693
 694     if ( !defined $newnick ) {
 695         &ERROR('nick: nick == NULL.');
 696         return;
 697     }
 698
 699     if ( !defined $mynick ) {
 700         &WARN('nick: mynick == NULL.');
 701         return;
 702     }
 703
 704     my $bad = 0;
 705     $bad++ if ( exists $nuh{$newnick} );
 706     $bad++ if ( &IsNickInAnyChan($newnick) );
 707
 708     if ($bad) {
 709         &WARN(  "Nick: not going to try to change from $mynick to $newnick. ["
 710               . scalar(gmtime)
 711               . ']' );
 712
 713         # hrm... over time we lose track of our own nick.
 714         #return;
 715     }
 716
 717     if ( $newnick =~ /^$mask{nick}$/ ) {
 718         &status("nick: Changing nick from $mynick to $newnick");
 719
 720         # ->nick() will NOT change cause we are using rawout?
 721         &rawout("NICK $newnick");
 722         return 1;
 723     }
 724     &DEBUG("nick: failed... why oh why (mynick=$mynick, newnick=$newnick)");
 725     return 0;
 726 }
 727
 728 sub invite {
 729     my ( $who, $chan ) = @_;
 730
 731     # TODO: check if $who or $chan are invalid.
 732
 733     $conn->invite( $who, $chan );
 734 }
 735
 736 ##########
 737 # Channel related functions...
 738 #
 739
 740 # Usage: &joinNextChan();
 741 sub joinNextChan {
 742     my $joined = 0;
 743     if (defined $conn) {
 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     } else {
 910         # Don't display since < 15min since last
 911         $show = 0;
 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         } else {
 935             $skip++;
 936         }
 937
 938         if ($skip) {
 939             push( @skip, $_ );
 940         } else {
 941             if ( defined $channels{$_} or exists $channels{$_} ) {
 942                 push( @in, $_ );
 943             } else {
 944                 push( @join, $_ );
 945             }
 946         }
 947     }
 948
 949     my $str;
 950     $str .= ' join:' . join( ',', sort @join ) if scalar @join;
 951     $str .= ' in:' . join( ',',   sort @in )   if scalar @in;
 952     $str .= ' skip:' . scalar @skip if scalar @skip;
 953
 954     &status("Chans: ($nick)$str") if ($show);
 955
 956     return sort @join;
 957 }
 958
 959 sub closeDCC {
 960
 961     #    &DEBUG('closeDCC called.');
 962     my $type;
 963
 964     foreach $type ( keys %dcc ) {
 965         next if ( $type ne uc($type) );
 966
 967         my $nick;
 968         foreach $nick ( keys %{ $dcc{$type} } ) {
 969             next unless ( defined $nick );
 970             &status("DCC CHAT: closing DCC $type to $nick.");
 971             next unless ( defined $dcc{$type}{$nick} );
 972
 973             my $ref = $dcc{$type}{$nick};
 974             &dccsay( $nick, "bye bye, $nick" ) if ( $type =~ /^chat$/i );
 975             $dcc{$type}{$nick}->close();
 976             delete $dcc{$type}{$nick};
 977             &DEBUG("after close for $nick");
 978         }
 979         delete $dcc{$type};
 980     }
 981 }
 982
 983 sub joinfloodCheck {
 984     my ( $who, $chan, $userhost ) = @_;
 985
 986     return unless ( &IsChanConf('joinfloodCheck') > 0 );
 987
 988     if ( exists $netsplit{ lc $who } ) {    # netsplit join.
 989         &DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
 990     }
 991
 992     if ( exists $floodjoin{$chan}{$who}{Time} ) {
 993         &WARN("floodjoin{$chan}{$who} already exists?");
 994     }
 995
 996     $floodjoin{$chan}{$who}{Time} = time();
 997     $floodjoin{$chan}{$who}{Host} = $userhost;
 998
 999     ### Check...
1000     foreach ( keys %floodjoin ) {
1001         my $c     = $_;
1002         my $count = scalar keys %{ $floodjoin{$c} };
1003         next unless ( $count > 5 );
1004         &DEBUG("joinflood: count => $count");
1005
1006         my $time;
1007         foreach ( keys %{ $floodjoin{$c} } ) {
1008             my $t = $floodjoin{$c}{$_}{Time};
1009             next unless ( defined $t );
1010
1011             $time += $t;
1012         }
1013         &DEBUG("joinflood: time => $time");
1014         $time /= $count;
1015
1016         &DEBUG("joinflood: new time => $time");
1017     }
1018
1019     ### Clean it up.
1020     my $delete = 0;
1021     my $time   = time();
1022     foreach $chan ( keys %floodjoin ) {
1023         foreach $who ( keys %{ $floodjoin{$chan} } ) {
1024             my $t = $floodjoin{$chan}{$who}{Time};
1025             next unless ( defined $t );
1026
1027             my $delta = $time - $t;
1028             next unless ( $delta > 10 );
1029
1030             delete $floodjoin{$chan}{$who};
1031             $delete++;
1032         }
1033     }
1034
1035     &DEBUG("joinfloodCheck: $delete deleted.") if ($delete);
1036 }
1037
1038 sub getHostMask {
1039     my ($n) = @_;
1040
1041     if ( exists $nuh{$n} ) {
1042         return &makeHostMask( $nuh{$n} );
1043     }
1044     else {
1045         $cache{on_who_Hack} = 1;
1046         $conn->who($n);
1047     }
1048 }
1049
1050 1;
1051
1052 # vim:ts=4:sw=4:expandtab:tw=80