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