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