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