2 # Irc.pl: IRC core stuff.
5 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
11 use vars qw(%floodjoin %nuh %dcc %cache %channels %param %mask
12 %chanconf %orig %ircPort %ircstats %last %netsplit);
13 use vars qw($irc $nickserv $ident $conn $msgType $who $talkchannel
15 use vars qw($notcount $nottime $notsize $msgcount $msgtime $msgsize
16 $pubcount $pubtime $pubsize);
17 use vars qw($b_blue $ob);
18 use vars qw(@joinchan @ircServers);
20 # static scalar variables.
21 $mask{ip} = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
22 $mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
23 $mask{chan} = '[\#\&]\S*|_default';
24 my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
25 my $isnick2 = '0-9\-';
26 $mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*";
27 $mask{nuh} = '\S*!\S*\@\S*';
36 while (my $host = shift @ircServers) {
37 # JUST IN CASE. irq was complaining about this.
38 if ($lastrun == time()) {
39 &DEBUG("ircloop: hrm... lastrun == time()");
46 &DEBUG("ircloop: ircServers[x] = NULL.");
50 next unless (exists $ircPort{$host});
52 my $retval = &irc($host, $ircPort{$host});
53 next unless (defined $retval and $retval == 0);
56 if ($error % 3 == 0 and $error != 0) {
57 &status("IRC: Could not connect.");
63 &status("IRC: cannot connect to any IRC servers; stopping.");
69 &status("IRC: ok, done one cycle of IRC servers; trying again.");
76 my ($server,$port) = @_;
78 my $iaddr = inet_aton($server);
79 my $paddr = sockaddr_in($port, $iaddr);
80 my $proto = getprotobyname('tcp');
83 &status("Connecting to port $port of server $server ...");
86 if ($server =~ /\D$/) {
87 my $packed = scalar(gethostbyname($server));
89 if (!defined $packed) {
90 &status(" cannot resolve $server.");
94 my $resolve = inet_ntoa($packed);
95 &status(" resolved to $resolve.");
96 ### warning in Sys/Hostname line 78???
97 ### caused inside Net::IRC?
103 Nick => $param{'ircNick'},
106 Ircname => $param{'ircName'},
108 $args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'});
109 $args{'Password'} = $param{'ircPasswd'} if ($param{'ircPasswd'});
111 $conn = $irc->newconn(%args);
113 if (!defined $conn) {
114 &ERROR("internal: perl IRC connection object does not exist.");
120 # change internal timeout value for scheduler.
121 $irc->{_timeout} = 10; # how about 60?
122 # Net::IRC debugging.
125 $ircstats{'Server'} = "$server:$port";
128 $conn->add_handler('caction', \&on_action);
129 $conn->add_handler('cdcc', \&on_dcc);
130 $conn->add_handler('cping', \&on_ping);
131 $conn->add_handler('crping', \&on_ping_reply);
132 $conn->add_handler('cversion', \&on_version);
133 $conn->add_handler('crversion', \&on_crversion);
134 $conn->add_handler('dcc_open', \&on_dcc_open);
135 $conn->add_handler('dcc_close', \&on_dcc_close);
136 $conn->add_handler('chat', \&on_chat);
137 $conn->add_handler('msg', \&on_msg);
138 $conn->add_handler('public', \&on_public);
139 $conn->add_handler('join', \&on_join);
140 $conn->add_handler('part', \&on_part);
141 $conn->add_handler('topic', \&on_topic);
142 $conn->add_handler('invite', \&on_invite);
143 $conn->add_handler('kick', \&on_kick);
144 $conn->add_handler('mode', \&on_mode);
145 $conn->add_handler('nick', \&on_nick);
146 $conn->add_handler('quit', \&on_quit);
147 $conn->add_handler('notice', \&on_notice);
148 $conn->add_handler('whoischannels', \&on_whoischannels);
149 $conn->add_handler('useronchannel', \&on_useronchannel);
150 $conn->add_handler('whois', \&on_whois);
151 $conn->add_handler('other', \&on_other);
152 $conn->add_global_handler('disconnect', \&on_disconnect);
153 $conn->add_global_handler([251,252,253,254,255], \&on_init);
154 ### $conn->add_global_handler([251,252,253,254,255,302], \&on_init);
155 $conn->add_global_handler(303, \&on_ison); # notify.
156 $conn->add_global_handler(315, \&on_endofwho);
157 $conn->add_global_handler(422, \&on_endofwho); # nomotd.
158 $conn->add_global_handler(324, \&on_modeis);
159 $conn->add_global_handler(333, \&on_topicinfo);
160 $conn->add_global_handler(352, \&on_who);
161 $conn->add_global_handler(353, \&on_names);
162 $conn->add_global_handler(366, \&on_endofnames);
163 $conn->add_global_handler(376, \&on_endofmotd); # on_connect.
164 $conn->add_global_handler(433, \&on_nick_taken);
165 $conn->add_global_handler(439, \&on_targettoofast);
166 # for proper joinnextChan behaviour
167 $conn->add_global_handler(471, \&on_chanfull);
168 $conn->add_global_handler(473, \&on_inviteonly);
169 $conn->add_global_handler(474, \&on_banned);
170 $conn->add_global_handler(475, \&on_badchankey);
171 $conn->add_global_handler(443, \&on_useronchan);
173 # end of handler stuff.
178 ######################################################################
179 ######## IRC ALIASES IRC ALIASES IRC ALIASES IRC ALIASES #######
180 ######################################################################
186 # slow down a bit if traffic is "high".
187 # need to take into account time of last message sent.
188 if ($last{buflen} > 256 and length($buf) > 256) {
192 $conn->sl($buf) if (&whatInterface() =~ /IRC/);
194 $last{buflen} = length($buf);
201 &WARN("say: msg == $msg.");
205 &status("</$talkchannel> $msg");
206 if (&whatInterface() =~ /IRC/) {
207 $msg = "zero" if ($msg =~ /^0+$/);
210 if ($t == $pubtime) {
212 $pubsize += length $msg;
214 my $i = &getChanConfDefault("sendPublicLimitLines", 3);
215 my $j = &getChanConfDefault("sendPublicLimitBytes", 1000);
217 if ( ($pubcount % $i) == 0 and $pubcount) {
219 } elsif ($pubsize > $j) {
227 $pubsize = length $msg;
230 $conn->privmsg($talkchannel, $msg);
235 my ($nick, $msg) = @_;
236 if (!defined $nick) {
237 &ERROR("msg: nick == NULL.");
243 &WARN("msg: msg == $msg.");
247 if ($msgType =~ /chat/i) {
248 # todo: warn that we're using msg() to do DCC CHAT?
249 &dccsay($nick, $msg);
250 # todo: make dccsay deal with flood protection?
254 &status(">$nick< $msg");
256 if (&whatInterface() =~ /IRC/) {
259 if ($t == $msgtime) {
261 $msgsize += length $msg;
263 my $i = &getChanConfDefault("sendPrivateLimitLines", 3);
264 my $j = &getChanConfDefault("sendPrivateLimitBytes", 1000);
265 if ( ($msgcount % $i) == 0 and $msgcount) {
267 } elsif ($msgsize > $j) {
275 $msgsize = length $msg;
278 $conn->privmsg($nick, $msg);
282 # Usage: &action(nick || chan, txt);
284 my ($target, $txt) = @_;
286 &WARN("action: txt == NULL.");
290 if (length $txt > 480) {
291 &status("action: txt too long; truncating.");
292 chop($txt) while (length $txt > 480);
295 &status("* $ident/$target $txt");
296 $conn->me($target, $txt);
299 # Usage: ¬ice(nick || chan, txt);
301 my ($target, $txt) = @_;
303 &WARN("notice: txt == NULL.");
307 &status("-$target- $txt");
311 if ($t == $nottime) {
313 $notsize += length $txt;
315 my $i = &getChanConfDefault("sendNoticeLimitLines", 3);
316 my $j = &getChanConfDefault("sendNoticeLimitBytes", 1000);
318 if ( ($notcount % $i) == 0 and $notcount) {
320 } elsif ($notsize > $j) {
328 $notsize = length $txt;
331 $conn->notice($target, $txt);
335 my ($txt,$flag) = @_;
337 ### FIXME: flag not supported yet.
339 foreach (keys %{ $dcc{'CHAT'} }) {
340 $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
345 ### perform commands.
348 # Usage: &performReply($reply);
351 $reply =~ /([\.\?\s]+)$/;
353 &checkMsgType($reply);
355 if ($msgType eq 'public') {
356 if (rand() < 0.5 or $reply =~ /[\.\?]$/) {
357 $reply = "$orig{who}: ".$reply;
359 $reply = "$reply, ".$orig{who};
362 } elsif ($msgType eq 'private') {
366 $reply = "$reply, ".$orig{who};
369 } elsif ($msgType eq 'chat') {
370 if (!exists $dcc{'CHAT'}{$who}) {
371 &VERB("pSR: dcc{'CHAT'}{$who} does not exist.",2);
374 $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
376 &ERROR("PR: msgType invalid? ($msgType).");
381 sub performAddressedReply {
382 return unless ($addressed);
387 &performStrictReply(@_);
390 # Usage: &performStrictReply($reply);
391 sub performStrictReply {
394 &checkMsgType($reply);
396 if ($msgType eq 'private') {
398 } elsif ($msgType eq 'public') {
400 } elsif ($msgType eq 'chat') {
401 &dccsay(lc $who, $reply);
403 &ERROR("pSR: msgType invalid? ($msgType).");
408 my($who, $reply) = @_;
410 if (!defined $reply or $reply =~ /^\s*$/) {
411 &WARN("dccsay: reply == NULL.");
415 if (!exists $dcc{'CHAT'}{$who}) {
416 &VERB("pSR: dcc{'CHAT'}{$who} does not exist. (2)",2);
420 &status("=>$who<= $reply"); # dcc chat.
421 $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
428 foreach $type (keys %dcc) {
429 &FIXME("dcc_close: $who");
430 my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} };
431 next unless (scalar @who);
433 &DEBUG("dcc_close... close $who!");
439 my $key = &getChanConf("chankey", $chan) || "";
441 # forgot for about 2 years to implement channel keys when moving
442 # over to Net::IRC...
444 # hopefully validChan is right.
445 if (&validChan($chan)) {
446 &status("join: already on $chan");
448 &status("joining $b_blue$chan$ob");
450 return if ($conn->join($chan, $key));
452 &DEBUG("joinchan: join failed. trying connect!");
462 next if ($chan eq "");
463 $chan =~ tr/A-Z/a-z/; # lowercase.
465 if ($chan !~ /^$mask{chan}$/) {
466 &WARN("part: chan is invalid ($chan)");
470 &status("parting $chan");
471 if (!&validChan($chan)) {
472 &WARN("part: not on $chan; doing anyway");
477 # deletion of $channels{chan} is done in &entryEvt().
482 my ($chan, @modes) = @_;
483 my $modes = join(" ", @modes);
485 if (&validChan($chan) == 0) {
486 &ERROR("mode: invalid chan => '$chan'.");
490 &DEBUG("mode: MODE $chan $modes");
492 # should move to use Net::IRC's $conn->mode()... but too lazy.
493 rawout("MODE $chan $modes");
497 my ($chan, @who) = @_;
498 my $os = "o" x scalar(@who);
500 &mode($chan, "+$os @who");
504 my ($chan, @who) = @_;
505 my $os = "o" x scalar(@who);
507 &mode($chan, "-$os ".@who);
511 my ($nick,$chan,$msg) = @_;
512 my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
514 if ($chan ne "" and &validChan($chan) == 0) {
515 &ERROR("kick: invalid channel $chan.");
519 $nick =~ tr/A-Z/a-z/;
521 foreach $chan (@chans) {
522 if (!&IsNickInChan($nick,$chan)) {
523 &status("kick: $nick is not on $chan.") if (scalar @chans == 1);
527 if (!exists $channels{$chan}{o}{$ident}) {
528 &status("kick: do not have ops on $chan :(");
532 &status("Kicking $nick from $chan.");
533 $conn->kick($chan, $nick, $msg);
538 my ($mask,$chan) = @_;
539 my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
542 if ($chan !~ /^\*?$/ and &validChan($chan) == 0) {
543 &ERROR("ban: invalid channel $chan.");
547 foreach $chan (@chans) {
548 if (!exists $channels{$chan}{o}{$ident}) {
549 &status("ban: do not have ops on $chan :(");
553 &status("Banning $mask from $chan.");
554 &rawout("MODE $chan +b $mask");
562 my ($mask,$chan) = @_;
563 my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
566 &DEBUG("unban: mask = $mask, chan = @chans");
568 foreach $chan (@chans) {
569 if (!exists $channels{$chan}{o}{$ident}) {
570 &status("unBan: do not have ops on $chan :(");
574 &status("Removed ban $mask from $chan.");
575 &rawout("MODE $chan -b $mask");
584 &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
586 $conn->quit($quitmsg);
588 &WARN("quit: could not quit!");
595 if (!defined $nick) {
596 &ERROR("nick: nick == NULL.");
600 if (defined $ident and $nick eq $ident) {
601 &WARN("nick: nick == ident == '$ident'.");
605 $bad++ if (exists $nuh{ $param{'ircNick'} });
606 $bad++ if (&IsNickInAnyChan($param{'ircNick'}));
609 &WARN("Nick: not going to try and get my nick back. [".
610 scalar(gmtime). "]");
611 # hrm... over time we lose track of our own nick.
615 if ($nick =~ /^$mask{nick}$/) {
616 rawout("NICK ".$nick);
618 if (defined $ident) {
619 &status("nick: Changing nick to $nick (from $ident)");
620 # following shouldn't be here :(
623 &DEBUG("first time nick change.");
629 &DEBUG("nick: failed... why oh why (nick => $nick)");
635 my($who, $chan) = @_;
636 # todo: check if $who or $chan are invalid.
638 $conn->invite($who, $chan);
642 # Channel related functions...
645 # Usage: &joinNextChan();
647 if (scalar @joinchan) {
648 my $chan = shift @joinchan;
651 if (my $i = scalar @joinchan) {
652 &status("joinNextChan: $i chans to join.");
659 my @c = &getJoinChans();
660 if (exists $cache{joinTime} and scalar @c) {
661 my $delta = time() - $cache{joinTime} - 5;
662 my $timestr = &Time2String($delta);
663 my $rate = sprintf("%.1f", $delta / @c);
664 delete $cache{joinTime};
666 &status("time taken to join all chans: $timestr; rate: $rate sec/join");
669 # chanserv check: global channels, in case we missed one.
670 foreach ( &ChanConfList("chanServ_ops") ) {
675 # Usage: &getNickInChans($nick);
680 foreach (keys %channels) {
681 next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} });
688 # Usage: &getNicksInChan($chan);
693 return keys %{ $channels{$chan}{''} };
697 my ($nick,$chan) = @_;
699 $chan =~ tr/A-Z/a-z/; # not lowercase unfortunately.
701 if (&validChan($chan) == 0) {
702 &ERROR("INIC: invalid channel $chan.");
706 if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) {
709 foreach (keys %channels) {
710 next unless (/[A-Z]/);
711 &DEBUG("iNIC: hash channels contains mixed cased chan!!!");
717 sub IsNickInAnyChan {
721 foreach $chan (keys %channels) {
722 next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} });
728 # Usage: &validChan($chan);
730 # todo: use $c instead?
733 if (!defined $chan or $chan =~ /^\s*$/) {
737 if (lc $chan ne $chan) {
738 &WARN("validChan: lc chan != chan. ($chan); fixing.");
739 $chan =~ tr/A-Z/a-z/;
742 # it's possible that this check creates the hash if empty.
743 if (defined $channels{$chan} or exists $channels{$chan}) {
744 if ($chan =~ /^_?default$/) {
745 # &WARN("validC: chan cannot be _default! returning 0!");
756 # Usage: &delUserInfo($nick,@chans);
758 my ($nick,@chans) = @_;
761 foreach $chan (@chans) {
762 foreach $mode (keys %{ $channels{$chan} }) {
764 next unless (exists $channels{$chan}{$mode}{$nick});
766 delete $channels{$chan}{$mode}{$nick};
774 delete $channels{$chan};
778 &DEBUG("clearIRCVars() called!");
782 @joinchan = &getJoinChans(1);
783 $cache{joinTime} = time();
791 foreach (keys %chanconf) {
792 next if ($_ eq "_default");
794 my $val = $chanconf{$_}{autojoin};
798 $skip++ if ($val eq "0");
813 $str = "channels not auto-joining: @skip (joining: @chans)";
815 $str = "auto-joining all chans: @chans";
818 &status("Chans: ".$str) if ($show);
824 # &DEBUG("closeDCC called.");
827 foreach $type (keys %dcc) {
828 next if ($type ne uc($type));
831 foreach $nick (keys %{ $dcc{$type} }) {
832 next unless (defined $nick);
833 &status("DCC CHAT: closing DCC $type to $nick.");
834 next unless (defined $dcc{$type}{$nick});
836 my $ref = $dcc{$type}{$nick};
837 &dccsay($nick, "bye bye, $nick") if ($type =~ /^chat$/i);
838 $dcc{$type}{$nick}->close();
839 delete $dcc{$type}{$nick};
840 &DEBUG("after close for $nick");
847 my($who,$chan,$userhost) = @_;
849 return unless (&IsChanConf("joinfloodCheck"));
851 if (exists $netsplit{lc $who}) { # netsplit join.
852 &DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
855 if (exists $floodjoin{$chan}{$who}{Time}) {
856 &WARN("floodjoin{$chan}{$who} already exists?");
859 $floodjoin{$chan}{$who}{Time} = time();
860 $floodjoin{$chan}{$who}{Host} = $userhost;
863 foreach (keys %floodjoin) {
865 my $count = scalar keys %{ $floodjoin{$c} };
866 next unless ($count > 5);
867 &DEBUG("joinflood: count => $count");
870 foreach (keys %{ $floodjoin{$c} }) {
871 my $t = $floodjoin{$c}{$_}{Time};
872 next unless (defined $t);
876 &DEBUG("joinflood: time => $time");
879 &DEBUG("joinflood: new time => $time");
885 foreach $chan (keys %floodjoin) {
886 foreach $who (keys %{ $floodjoin{$chan} }) {
887 my $t = $floodjoin{$chan}{$who}{Time};
888 next unless (defined $t);
890 my $delta = $time - $t;
891 next unless ($delta > 10);
893 delete $floodjoin{$chan}{$who};
898 &DEBUG("joinfloodCheck: $delete deleted.") if ($delete);
904 if (exists $nuh{$n}) {
905 return &makeHostMask($nuh{$n});
907 $cache{on_who_Hack} = 1;