]> git.donarmstrong.com Git - infobot.git/blob - src/IRC/Irc.pl
don't call chanservcheck in joinnextchan
[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 if (&IsParam("useStrict")) { use strict; }
9
10 use vars qw($nickserv);
11 $nickserv       = 0;
12
13 # static scalar variables.
14 $mask{ip}       = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
15 $mask{host}     = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
16 $mask{chan}     = '[\#\&]\S*|_default';
17 my $isnick1     = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
18 my $isnick2     = '0-9\-';
19 $mask{nick}     = "[$isnick1]{1}[$isnick1$isnick2]*";
20 $mask{nuh}      = '\S*!\S*\@\S*';
21
22 sub ircloop {
23     my $error   = 0;
24     my $lastrun = 0;
25
26 loop:;
27     while (my $host = shift @ircServers) {
28         # JUST IN CASE. irq was complaining about this.
29         if ($lastrun == time()) {
30             &DEBUG("ircloop: hrm... lastrun == time()");
31             $error++;
32             sleep 10;
33             next;
34         }
35
36         if (!defined $host) {
37             &DEBUG("ircloop: ircServers[x] = NULL.");
38             $lastrun = time();
39             next;
40         }
41         next unless (exists $ircPort{$host});
42
43         my $retval = &irc($host, $ircPort{$host});
44         &DEBUG("ircloop: after irc()");
45
46         next unless (defined $retval and $retval == 0);
47
48         $error++;
49
50         if ($error % 3 == 0 and $error != 0) {
51             &ERROR("CANNOT connect to this server; next!");
52             next;
53         }
54
55         if ($error >= 3*3) {
56             &ERROR("CANNOT connect to any irc server; stopping.");
57             exit 1;
58         }
59     }
60
61     &DEBUG("ircloop: end... going back.");
62     &loadIRCServers();
63     goto loop;
64 }
65
66 sub irc {
67     my ($server,$port) = @_;
68
69     my $iaddr = inet_aton($server);
70     my $paddr = sockaddr_in($port, $iaddr);
71     my $proto = getprotobyname('tcp');
72
73     select STDOUT;
74     &status("Connecting to port $port of server $server ...");
75
76     # host->ip.
77     if ($server =~ /\D$/) {
78         my $packed = scalar(gethostbyname($server));
79
80         if (!defined $packed) {
81             &status("  cannot resolve $server.");
82             return 0;
83         }
84
85         my $resolve = inet_ntoa($packed);
86         &status("  resolved to $resolve.");
87         ### warning in Sys/Hostname line 78???
88         ### caused inside Net::IRC?
89     }
90
91     $irc = new Net::IRC;
92
93     $conn = $irc->newconn(
94                 Nick    => $param{'ircNick'},
95                 Server  => $server,
96                 Port    => $port,
97                 Ircname => $param{'ircName'},
98                 LocalAddr => $param{'ircHost'},
99     );
100
101     if (!defined $conn) {
102         &ERROR("irc: conn was not created!defined!!!");
103         return 1;
104     }
105
106     &clearIRCVars();
107
108     # change internal timeout value for scheduler.
109     $irc->{_timeout}    = 10;   # how about 60?
110
111     $ircstats{'Server'} = "$server:$port";
112
113     # handler stuff.
114         $conn->add_handler('caction',   \&on_action);
115         $conn->add_handler('cdcc',      \&on_dcc);
116         $conn->add_handler('cping',     \&on_ping);
117         $conn->add_handler('crping',    \&on_ping_reply);
118         $conn->add_handler('cversion',  \&on_version);
119         $conn->add_handler('crversion', \&on_crversion);
120         $conn->add_handler('dcc_open',  \&on_dcc_open);
121         $conn->add_handler('dcc_close', \&on_dcc_close);
122         $conn->add_handler('chat',      \&on_chat);
123         $conn->add_handler('msg',       \&on_msg);
124         $conn->add_handler('public',    \&on_public);
125         $conn->add_handler('join',      \&on_join);
126         $conn->add_handler('part',      \&on_part);
127         $conn->add_handler('topic',     \&on_topic);
128         $conn->add_handler('invite',    \&on_invite);
129         $conn->add_handler('kick',      \&on_kick);
130         $conn->add_handler('mode',      \&on_mode);
131         $conn->add_handler('nick',      \&on_nick);
132         $conn->add_handler('quit',      \&on_quit);
133         $conn->add_handler('notice',    \&on_notice);
134         $conn->add_handler('whoisuser', \&on_whoisuser);
135         $conn->add_handler('other',     \&on_other);
136         $conn->add_global_handler('disconnect', \&on_disconnect);
137         $conn->add_global_handler([251,252,253,254,255], \&on_init);
138 ###     $conn->add_global_handler([251,252,253,254,255,302], \&on_init);
139         $conn->add_global_handler(324, \&on_modeis);
140         $conn->add_global_handler(333, \&on_topicinfo);
141         $conn->add_global_handler(352, \&on_who);
142         $conn->add_global_handler(353, \&on_names);
143         $conn->add_global_handler(366, \&on_endofnames);
144         $conn->add_global_handler(376, \&on_endofmotd); # on_connect.
145         $conn->add_global_handler(433, \&on_nick_taken);
146         $conn->add_global_handler(439, \&on_targettoofast);
147         # for proper joinnextChan behaviour
148         $conn->add_global_handler(471, \&on_chanfull);
149         $conn->add_global_handler(473, \&on_inviteonly);
150         $conn->add_global_handler(474, \&on_banned);
151         $conn->add_global_handler(475, \&on_badchankey);
152
153     # end of handler stuff.
154
155     $irc->start;
156 }
157
158 ######################################################################
159 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
160 ######################################################################
161
162 sub rawout {
163     my ($buf) = @_;
164     $buf =~ s/\n//gi;
165
166     # slow down a bit if traffic is "high".
167     # need to take into account time of last message sent.
168     if ($last{buflen} > 256 and length($buf) > 256) {
169         sleep 1;
170     }
171
172     $conn->sl($buf) if (&whatInterface() =~ /IRC/);
173
174     $last{buflen} = length($buf);
175 }
176
177 sub say {
178     my ($msg) = @_;
179     if (!defined $msg) {
180         $msg ||= "NULL";
181         &WARN("say: msg == $msg.");
182         return;
183     }
184
185     &status("</$talkchannel> $msg");
186     if (&whatInterface() =~ /IRC/) {
187         $msg    = "zero" if ($msg =~ /^0+$/);
188         my $t   = time();
189
190         if ($t == $pubtime) {
191             $pubcount++;
192             $pubsize += length $msg;
193
194             if ( ($pubcount % 4) == 0 and $pubcount) {
195                 sleep 1;
196             } elsif ($pubsize > 1500) {
197                 sleep 1;
198                 $pubsize -= 1500;
199             }
200
201         } else {
202             $pubcount   = 0;
203             $pubtime    = $t;
204             $pubsize    = length $msg;
205         }
206
207         $conn->privmsg($talkchannel, $msg);
208     }
209 }
210
211 sub msg {
212     my ($nick, $msg) = @_;
213     if (!defined $nick) {
214         &ERROR("msg: nick == NULL.");
215         return;
216     }
217
218     if (!defined $msg) {
219         $msg ||= "NULL";
220         &WARN("msg: msg == $msg.");
221         return;
222     }
223
224     &status(">$nick< $msg");
225
226     if (&whatInterface() =~ /IRC/) {
227         my $t = time();
228
229         if ($t == $msgtime) {
230             $msgcount++;
231             $msgsize += length $msg;
232
233             if ( ($msgcount % 4) == 0 and $msgcount) {
234                 sleep 1;
235             } elsif ($msgsize > 1000) {
236                 sleep 1;
237                 $msgsize -= 1000;
238             }
239
240         } else {
241             $msgcount   = 0;
242             $msgtime    = $t;
243             $msgsize    = length $msg;
244         }
245
246         $conn->privmsg($nick, $msg);
247     }
248 }
249
250 # Usage: &action(nick || chan, txt);
251 sub action {
252     my ($target, $txt) = @_;
253     if (!defined $txt) {
254         &WARN("action: txt == NULL.");
255         return;
256     }
257
258     my $rawout = "PRIVMSG $target :\001ACTION $txt\001";
259     if (length $rawout > 510) {
260         &status("action: txt too long; truncating.");
261
262         chop($rawout) while (length($rawout) > 510);
263         $rawout .= "\001";
264     }
265
266     &status("* $ident/$target $txt");
267     rawout($rawout);
268 }
269
270 # Usage: &notice(nick || chan, txt);
271 sub notice {
272     my ($target, $txt) = @_;
273     if (!defined $txt) {
274         &WARN("notice: txt == NULL.");
275         return;
276     }
277
278     &status("-$target- $txt");
279
280     my $t       = time();
281
282     if ($t == $nottime) {
283         $notcount++;
284         $notsize += length $txt;
285
286         if ( ($notcount % 3) == 0 and $notcount) {
287             sleep 1;
288         } elsif ($notsize > 1000) {
289             sleep 1;
290             $notsize -= 1000;
291         }
292
293     } else {
294         $notcount       = 0;
295         $nottime        = $t;
296         $notsize        = length $txt;
297     }
298
299     $conn->notice($target, $txt);
300 }
301
302
303 sub DCCBroadcast {
304     my ($txt,$flag) = @_;
305
306     ### FIXME: flag not supported yet.
307
308     foreach (keys %{ $dcc{'CHAT'} }) {
309         $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
310     }
311 }
312
313 ##########
314 ### perform commands.
315 ###
316
317 # Usage: &performReply($reply);
318 sub performReply {
319     my ($reply) = @_;
320     $reply =~ /([\.\?\s]+)$/;
321
322     &checkMsgType($reply);
323
324     if ($msgType eq 'public') {
325         if (rand() < 0.5 or $reply =~ /[\.\?]$/) {
326             $reply = "$orig{who}: ".$reply;
327         } else {
328             $reply = "$reply, ".$orig{who};
329         }
330         &say($reply);
331     } elsif ($msgType eq 'private') {
332         if (rand() < 0.5) {
333             $reply = $reply;
334         } else {
335             $reply = "$reply, ".$orig{who};
336         }
337         &msg($who, $reply);
338     } elsif ($msgType eq 'chat') {
339         if (!exists $dcc{'CHAT'}{$who}) {
340             &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
341             return;
342         }
343         $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
344     } else {
345         &ERROR("PR: msgType invalid? ($msgType).");
346     }
347 }
348
349 # ...
350 sub performAddressedReply {
351     return unless ($addressed);
352     &performReply(@_);
353 }
354
355 sub pSReply {
356     &performStrictReply(@_);
357 }
358
359 # Usage: &performStrictReply($reply);
360 sub performStrictReply {
361     my ($reply) = @_;
362
363     &checkMsgType($reply);
364
365     if ($msgType eq 'private') {
366         &msg($who, $reply);
367     } elsif ($msgType eq 'public') {
368         &say($reply);
369     } elsif ($msgType eq 'chat') {
370         &dccsay(lc $who,$reply);
371     } else {
372         &ERROR("pSR: msgType invalid? ($msgType).");
373     }
374 }
375
376 sub dccsay {
377     my ($who, $reply) = @_;
378     if (!exists $dcc{'CHAT'}{$who}) {
379         &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
380         return '';
381     }
382
383     &status("=>$who<= $reply");         # dcc chat.
384     $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
385 }
386
387 sub dcc_close {
388     my($who) = @_;
389     my $type;
390
391     foreach $type (keys %dcc) {
392         &FIXME("dcc_close: $who");
393         my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} };
394         next unless (scalar @who);
395         $who = $who[0];
396     }
397 }
398
399 sub joinchan {
400     my ($chankey) = @_;
401     my $chan = lc $chankey;
402
403     if ($chankey =~ s/^($mask{chan}),\S+/ /) {
404         $chan = lc $1;
405     }
406
407     &status("joining $b_blue$chan$ob");
408
409     if (&validChan($chan)) {
410         &status("join: already on $chan");
411     } else {
412         if (!$conn->join($chan)) {
413             &DEBUG("joinchan: join failed. trying connect!");
414             $conn->connect();
415         }
416     }
417 }
418
419 sub part {
420     my $chan;
421
422     foreach $chan (@_) {
423         next if ($chan eq "");
424         $chan =~ tr/A-Z/a-z/;   # lowercase.
425
426         &status("parting $chan");
427         if (!&validChan($chan)) {
428             &WARN("part: not on $chan; doing anyway");
429 #           next;
430         }
431
432         rawout("PART $chan");
433         # deletion of $channels{chan} is done in &entryEvt().
434     }
435 }
436
437 sub mode {
438     my ($chan, @modes) = @_;
439     my $modes = join(" ", @modes);
440
441     if (&validChan($chan) == 0) {
442         &ERROR("mode: invalid chan => '$chan'.");
443         return;
444     }
445
446     &DEBUG("mode: MODE $chan $modes");
447
448     rawout("MODE $chan $modes");
449 }
450
451 sub op {
452     my ($chan, @who) = @_;
453     my $os      = "o" x scalar(@who);
454
455     &mode($chan, "+$os @who");
456 }
457
458 sub deop {
459     my ($chan, @who) = @_;
460     my $os = "o" x scalar(@who);
461
462     &mode($chan, "-$os ".@who);
463 }
464
465 sub kick {
466     my ($nick,$chan,$msg) = @_;
467     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
468
469     if ($chan ne "" and &validChan($chan) == 0) {
470         &ERROR("kick: invalid channel $chan.");
471         return;
472     }
473
474     $nick =~ tr/A-Z/a-z/;
475
476     foreach $chan (@chans) {
477         if (!&IsNickInChan($nick,$chan)) {
478             &status("Kick: $nick is not on $chan.") if (scalar @chans == 1);
479             next;
480         }
481
482         if (!exists $channels{$chan}{o}{$ident}) {
483             &status("Kick: do not have ops on $chan :(");
484             next;
485         }
486
487         &status("Kicking $nick from $chan.");
488         if ($msg eq "") {
489             &rawout("KICK $chan $nick");
490         } else {
491             &rawout("KICK $chan $nick :$msg");
492         }
493     }
494 }
495
496 sub ban {
497     my ($mask,$chan) = @_;
498     my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
499     my $ban     = 0;
500
501     if ($chan !~ /^\*?$/ and &validChan($chan) == 0) {
502         &ERROR("ban: invalid channel $chan.");
503         return;
504     }
505
506     foreach $chan (@chans) {
507         if (!exists $channels{$chan}{o}{$ident}) {
508             &status("Ban: do not have ops on $chan :(");
509             next;
510         }
511
512         &status("Banning $mask from $chan.");
513         &rawout("MODE $chan +b $mask");
514         $ban++;
515     }
516
517     return $ban;
518 }
519
520 sub unban {
521     my ($mask,$chan) = @_;
522     my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
523     my $ban     = 0;
524
525     &DEBUG("unban: mask = $mask, chan = @chans");
526
527     foreach $chan (@chans) {
528         if (!exists $channels{$chan}{o}{$ident}) {
529             &status("unBan: do not have ops on $chan :(");
530             next;
531         }
532
533         &status("Removed ban $mask from $chan.");
534         &rawout("MODE $chan -b $mask");
535         $ban++;
536     }
537
538     return $ban;
539 }
540
541 sub quit {
542     my ($quitmsg) = @_;
543     &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
544     $conn->quit($quitmsg);
545 }
546
547 sub nick {
548     my ($nick) = @_;
549
550     if ($nick =~ /^$mask{nick}$/) {
551         &DEBUG("nick: Changing nick to $nick (from $ident)");
552         rawout("NICK ".$nick);
553         return 1;
554     }
555     &DEBUG("nick: failed... why oh why (nick => $nick)");
556
557     return 0;
558 }
559
560 sub invite {
561     my($who, $chan) = @_;
562     rawout("INVITE $who $chan");
563 }
564
565
566 ##########
567 # Channel related functions...
568 #
569
570 # Usage: &joinNextChan();
571 sub joinNextChan {
572     &DEBUG("joinNextChan called.");
573
574     if (scalar @joinchan) {
575         $chan = shift @joinchan;
576         &joinchan($chan);
577
578         if (my $i = scalar @joinchan) {
579             &status("joinNextChan: $i chans to join.");
580         }
581
582     } else {
583         # chanserv check: global channels, in case we missed one.
584
585         foreach ( &ChanConfList("chanServ_ops") ) {
586             &chanServCheck($_);
587         }
588     }
589 }
590
591 # Usage: &GetNickInChans($nick,$chan);
592 sub GetNickInChans {
593     my ($nick) = @_;
594     my @array;
595
596     foreach (keys %channels) {
597         next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} });
598         push(@array, $_);
599     }
600
601     return @array;
602 }
603
604 # Usage: &GetNicksInChan($chan);
605 sub GetNicksInChan {
606     my ($chan) = @_;
607     my @array;
608
609     return keys %{ $channels{$chan}{''} };
610 }
611
612 sub IsNickInChan {
613     my ($nick,$chan) = @_;
614
615     $chan =~ tr/A-Z/a-z/;       # not lowercase unfortunately.
616
617     if (&validChan($chan) == 0) {
618         &ERROR("INIC: invalid channel $chan.");
619         return 0;
620     }
621
622     if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) {
623         return 1;
624     } else {
625         foreach (keys %channels) {
626             next unless (/[A-Z]/);
627             &DEBUG("iNIC: hash channels contains mixed cased chan!!!");
628         }
629         return 0;
630     }
631 }
632
633 sub IsNickInAnyChan {
634     my ($nick) = @_;
635
636     foreach $chan (keys %channels) {
637         next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''}  });
638         return 1;
639     }
640     return 0;
641 }
642
643 # Usage: &validChan($chan);
644 sub validChan {
645     my ($chan) = @_;
646
647     if (lc $chan ne $chan) {
648         &WARN("validChan: lc chan != chan. ($chan); fixing.");
649         $chan =~ tr/A-Z/a-z/;
650     }
651
652     if (exists $channels{$chan}) {
653         return 1;
654     } else {
655         return 0;
656     }
657 }
658
659 ###
660 # Usage: &DeleteUserInfo($nick,@chans);
661 sub DeleteUserInfo {
662     my ($nick,@chans) = @_;
663     my ($mode,$chan);
664
665     foreach $chan (@chans) {
666         foreach $mode (keys %{ $channels{$chan} }) {
667             # use grep here?
668             next unless (exists $channels{$chan}{$mode}{$nick});
669
670             delete $channels{$chan}{$mode}{$nick};
671         }
672     }
673 }
674
675 sub clearChanVars {
676     my ($chan) = @_;
677
678     delete $channels{$chan};
679 }
680
681 sub clearIRCVars {
682 ###    &DEBUG("clearIRCVars() called!");
683     undef %channels;
684     undef %floodjoin;
685
686     @joinchan   = &getJoinChans();
687 }
688
689 sub getJoinChans {
690     my @chans;
691     my @skip;
692
693     foreach (keys %chanconf) {
694         next if ($_ eq "_default");
695
696         my $val = $chanconf{$_}{autojoin};
697         my $skip = 0;
698
699         if (defined $val) {
700             $skip++ if ($val eq "0");
701         } else {
702             $skip++;
703         }
704
705         if ($skip) {
706             push(@skip, $_);
707             next;
708         }
709
710         push(@chans, $_);
711     }
712
713     if (scalar @skip) {
714         &status("gJC: channels not auto-joining: @skip");
715     } else {
716         &status("gJC: auto-joining all chans.");
717     }
718
719     return @chans;
720 }
721
722 sub closeDCC {
723 ###    &DEBUG("closeDCC called.");
724
725     foreach $type (keys %dcc) {
726         next if ($type ne uc($type));
727  
728         foreach $nick (keys %{ $dcc{$type} }) {
729             next unless (defined $nick);
730             &DEBUG("closing DCC $type to $nick (FIXME).");
731             next unless (defined $dcc{$type}{$nick});
732
733             my $ref = $dcc{$type}{$nick};
734             &DEBUG("ref => $ref");
735
736 #           $dcc{$type}{$nick}->close();
737         }
738     }
739 }
740
741 sub joinfloodCheck {
742     my($who,$chan,$userhost) = @_;
743
744     return unless (&IsChanConf("joinfloodCheck"));
745
746     if (exists $netsplit{lc $who}) {    # netsplit join.
747         &DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
748     }
749
750     if (exists $floodjoin{$chan}{$who}{Time}) {
751         &WARN("floodjoin{$chan}{$who} already exists?");
752     }
753
754     $floodjoin{$chan}{$who}{Time} = time();
755     $floodjoin{$chan}{$who}{Host} = $userhost;
756
757     ### Check...
758     foreach (keys %floodjoin) {
759         my $c = $_;
760         my $count = scalar keys %{ $floodjoin{$c} };
761         next unless ($count > 5);
762         &DEBUG("joinflood: count => $count");
763
764         my $time;
765         foreach (keys %{ $floodjoin{$c} }) {
766             $time += $floodjoin{$c}{$_}{Time};
767         }
768         &DEBUG("joinflood: time => $time");
769         $time /= $count;
770
771         &DEBUG("joinflood: new time => $time");
772     }
773
774     ### Clean it up.
775     my $delete = 0;
776     foreach $chan (keys %floodjoin) {
777         foreach $who (keys %{ $floodjoin{$chan} }) {
778             my $time = time() - $floodjoin{$chan}{$who}{Time};
779             next unless ($time > 10);
780             delete $floodjoin{$chan}{$who};
781             $delete++;
782         }
783     }
784
785     &DEBUG("joinfloodCheck: $delete deleted.") if ($delete);
786 }
787
788 sub getHostMask {
789     my($n) = @_;
790
791     &FIXME("getHostMask($n) called...");
792 }
793
794 1;