]> git.donarmstrong.com Git - infobot.git/blob - src/IRC/Irc.pl
- forgot to set forked{}{PID} in addForked
[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(315, \&on_endofwho);
140         $conn->add_global_handler(324, \&on_modeis);
141         $conn->add_global_handler(333, \&on_topicinfo);
142         $conn->add_global_handler(352, \&on_who);
143         $conn->add_global_handler(353, \&on_names);
144         $conn->add_global_handler(366, \&on_endofnames);
145         $conn->add_global_handler(376, \&on_endofmotd); # on_connect.
146         $conn->add_global_handler(433, \&on_nick_taken);
147         $conn->add_global_handler(439, \&on_targettoofast);
148         # for proper joinnextChan behaviour
149         $conn->add_global_handler(471, \&on_chanfull);
150         $conn->add_global_handler(473, \&on_inviteonly);
151         $conn->add_global_handler(474, \&on_banned);
152         $conn->add_global_handler(475, \&on_badchankey);
153
154     # end of handler stuff.
155
156     $irc->start;
157 }
158
159 ######################################################################
160 ######## IRC ALIASES   IRC ALIASES   IRC ALIASES   IRC ALIASES #######
161 ######################################################################
162
163 sub rawout {
164     my ($buf) = @_;
165     $buf =~ s/\n//gi;
166
167     # slow down a bit if traffic is "high".
168     # need to take into account time of last message sent.
169     if ($last{buflen} > 256 and length($buf) > 256) {
170         sleep 1;
171     }
172
173     $conn->sl($buf) if (&whatInterface() =~ /IRC/);
174
175     $last{buflen} = length($buf);
176 }
177
178 sub say {
179     my ($msg) = @_;
180     if (!defined $msg) {
181         $msg ||= "NULL";
182         &WARN("say: msg == $msg.");
183         return;
184     }
185
186     &status("</$talkchannel> $msg");
187     if (&whatInterface() =~ /IRC/) {
188         $msg    = "zero" if ($msg =~ /^0+$/);
189         my $t   = time();
190
191         if ($t == $pubtime) {
192             $pubcount++;
193             $pubsize += length $msg;
194
195             my $i = &getChanConfDefault("sendPublicLimitLines", 3);
196             my $j = &getChanConfDefault("sendPublicLimitBytes", 1000);
197
198             if ( ($pubcount % $i) == 0 and $pubcount) {
199                 sleep 1;
200             } elsif ($pubsize > $j) {
201                 sleep 1;
202                 $pubsize -= $j;
203             }
204
205         } else {
206             $pubcount   = 0;
207             $pubtime    = $t;
208             $pubsize    = length $msg;
209         }
210
211         $conn->privmsg($talkchannel, $msg);
212     }
213 }
214
215 sub msg {
216     my ($nick, $msg) = @_;
217     if (!defined $nick) {
218         &ERROR("msg: nick == NULL.");
219         return;
220     }
221
222     if (!defined $msg) {
223         $msg ||= "NULL";
224         &WARN("msg: msg == $msg.");
225         return;
226     }
227
228     &status(">$nick< $msg");
229
230     if (&whatInterface() =~ /IRC/) {
231         my $t = time();
232
233         if ($t == $msgtime) {
234             $msgcount++;
235             $msgsize += length $msg;
236
237             my $i = &getChanConfDefault("sendPrivateLimitLines", 3);
238             my $j = &getChanConfDefault("sendPrivateLimitBytes", 1000);
239             if ( ($msgcount % $i) == 0 and $msgcount) {
240                 sleep 1;
241             } elsif ($msgsize > $j) {
242                 sleep 1;
243                 $msgsize -= $j;
244             }
245
246         } else {
247             $msgcount   = 0;
248             $msgtime    = $t;
249             $msgsize    = length $msg;
250         }
251
252         $conn->privmsg($nick, $msg);
253     }
254 }
255
256 # Usage: &action(nick || chan, txt);
257 sub action {
258     my ($target, $txt) = @_;
259     if (!defined $txt) {
260         &WARN("action: txt == NULL.");
261         return;
262     }
263
264     my $rawout = "PRIVMSG $target :\001ACTION $txt\001";
265     if (length $rawout > 510) {
266         &status("action: txt too long; truncating.");
267
268         chop($rawout) while (length($rawout) > 510);
269         $rawout .= "\001";
270     }
271
272     &status("* $ident/$target $txt");
273     rawout($rawout);
274 }
275
276 # Usage: &notice(nick || chan, txt);
277 sub notice {
278     my ($target, $txt) = @_;
279     if (!defined $txt) {
280         &WARN("notice: txt == NULL.");
281         return;
282     }
283
284     &status("-$target- $txt");
285
286     my $t       = time();
287
288     if ($t == $nottime) {
289         $notcount++;
290         $notsize += length $txt;
291
292         my $i = &getChanConfDefault("sendNoticeLimitLines", 3);
293         my $j = &getChanConfDefault("sendNoticeLimitBytes", 1000);
294
295         if ( ($notcount % $i) == 0 and $notcount) {
296             sleep 1;
297         } elsif ($notsize > $j) {
298             sleep 1;
299             $notsize -= $j;
300         }
301
302     } else {
303         $notcount       = 0;
304         $nottime        = $t;
305         $notsize        = length $txt;
306     }
307
308     $conn->notice($target, $txt);
309 }
310
311 sub DCCBroadcast {
312     my ($txt,$flag) = @_;
313
314     ### FIXME: flag not supported yet.
315
316     foreach (keys %{ $dcc{'CHAT'} }) {
317         $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
318     }
319 }
320
321 ##########
322 ### perform commands.
323 ###
324
325 # Usage: &performReply($reply);
326 sub performReply {
327     my ($reply) = @_;
328     $reply =~ /([\.\?\s]+)$/;
329
330     &checkMsgType($reply);
331
332     if ($msgType eq 'public') {
333         if (rand() < 0.5 or $reply =~ /[\.\?]$/) {
334             $reply = "$orig{who}: ".$reply;
335         } else {
336             $reply = "$reply, ".$orig{who};
337         }
338         &say($reply);
339     } elsif ($msgType eq 'private') {
340         if (rand() < 0.5) {
341             $reply = $reply;
342         } else {
343             $reply = "$reply, ".$orig{who};
344         }
345         &msg($who, $reply);
346     } elsif ($msgType eq 'chat') {
347         if (!exists $dcc{'CHAT'}{$who}) {
348             &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
349             return;
350         }
351         $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
352     } else {
353         &ERROR("PR: msgType invalid? ($msgType).");
354     }
355 }
356
357 # ...
358 sub performAddressedReply {
359     return unless ($addressed);
360     &performReply(@_);
361 }
362
363 sub pSReply {
364     &performStrictReply(@_);
365 }
366
367 # Usage: &performStrictReply($reply);
368 sub performStrictReply {
369     my ($reply) = @_;
370
371     &checkMsgType($reply);
372
373     if ($msgType eq 'private') {
374         &msg($who, $reply);
375     } elsif ($msgType eq 'public') {
376         &say($reply);
377     } elsif ($msgType eq 'chat') {
378         &dccsay(lc $who,$reply);
379     } else {
380         &ERROR("pSR: msgType invalid? ($msgType).");
381     }
382 }
383
384 sub dccsay {
385     my ($who, $reply) = @_;
386     if (!exists $dcc{'CHAT'}{$who}) {
387         &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
388         return '';
389     }
390
391     &status("=>$who<= $reply");         # dcc chat.
392     $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
393 }
394
395 sub dcc_close {
396     my($who) = @_;
397     my $type;
398
399     foreach $type (keys %dcc) {
400         &FIXME("dcc_close: $who");
401         my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} };
402         next unless (scalar @who);
403         $who = $who[0];
404     }
405 }
406
407 sub joinchan {
408     my ($chankey) = @_;
409     my $chan = lc $chankey;
410
411     if ($chankey =~ s/^($mask{chan}),\S+/ /) {
412         $chan = lc $1;
413     }
414
415     &status("joining $b_blue$chan$ob");
416
417     if (&validChan($chan)) {
418         &status("join: already on $chan");
419     } else {
420         if (!$conn->join($chan)) {
421             &DEBUG("joinchan: join failed. trying connect!");
422             $conn->connect();
423         }
424     }
425 }
426
427 sub part {
428     my $chan;
429
430     foreach $chan (@_) {
431         next if ($chan eq "");
432         $chan =~ tr/A-Z/a-z/;   # lowercase.
433
434         &status("parting $chan");
435         if (!&validChan($chan)) {
436             &WARN("part: not on $chan; doing anyway");
437 #           next;
438         }
439
440         rawout("PART $chan");
441         # deletion of $channels{chan} is done in &entryEvt().
442     }
443 }
444
445 sub mode {
446     my ($chan, @modes) = @_;
447     my $modes = join(" ", @modes);
448
449     if (&validChan($chan) == 0) {
450         &ERROR("mode: invalid chan => '$chan'.");
451         return;
452     }
453
454     &DEBUG("mode: MODE $chan $modes");
455
456     rawout("MODE $chan $modes");
457 }
458
459 sub op {
460     my ($chan, @who) = @_;
461     my $os      = "o" x scalar(@who);
462
463     &mode($chan, "+$os @who");
464 }
465
466 sub deop {
467     my ($chan, @who) = @_;
468     my $os = "o" x scalar(@who);
469
470     &mode($chan, "-$os ".@who);
471 }
472
473 sub kick {
474     my ($nick,$chan,$msg) = @_;
475     my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
476
477     if ($chan ne "" and &validChan($chan) == 0) {
478         &ERROR("kick: invalid channel $chan.");
479         return;
480     }
481
482     $nick =~ tr/A-Z/a-z/;
483
484     foreach $chan (@chans) {
485         if (!&IsNickInChan($nick,$chan)) {
486             &status("Kick: $nick is not on $chan.") if (scalar @chans == 1);
487             next;
488         }
489
490         if (!exists $channels{$chan}{o}{$ident}) {
491             &status("Kick: do not have ops on $chan :(");
492             next;
493         }
494
495         &status("Kicking $nick from $chan.");
496         if ($msg eq "") {
497             &rawout("KICK $chan $nick");
498         } else {
499             &rawout("KICK $chan $nick :$msg");
500         }
501     }
502 }
503
504 sub ban {
505     my ($mask,$chan) = @_;
506     my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
507     my $ban     = 0;
508
509     if ($chan !~ /^\*?$/ and &validChan($chan) == 0) {
510         &ERROR("ban: invalid channel $chan.");
511         return;
512     }
513
514     foreach $chan (@chans) {
515         if (!exists $channels{$chan}{o}{$ident}) {
516             &status("Ban: do not have ops on $chan :(");
517             next;
518         }
519
520         &status("Banning $mask from $chan.");
521         &rawout("MODE $chan +b $mask");
522         $ban++;
523     }
524
525     return $ban;
526 }
527
528 sub unban {
529     my ($mask,$chan) = @_;
530     my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan);
531     my $ban     = 0;
532
533     &DEBUG("unban: mask = $mask, chan = @chans");
534
535     foreach $chan (@chans) {
536         if (!exists $channels{$chan}{o}{$ident}) {
537             &status("unBan: do not have ops on $chan :(");
538             next;
539         }
540
541         &status("Removed ban $mask from $chan.");
542         &rawout("MODE $chan -b $mask");
543         $ban++;
544     }
545
546     return $ban;
547 }
548
549 sub quit {
550     my ($quitmsg) = @_;
551     &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
552     $conn->quit($quitmsg);
553 }
554
555 sub nick {
556     my ($nick) = @_;
557
558     if ($nick =~ /^$mask{nick}$/) {
559         &DEBUG("nick: Changing nick to $nick (from $ident)");
560         rawout("NICK ".$nick);
561         # unfortunately, on_nick doesn't catch ourself.
562         $ident  = $nick;
563         return 1;
564     }
565     &DEBUG("nick: failed... why oh why (nick => $nick)");
566
567     return 0;
568 }
569
570 sub invite {
571     my($who, $chan) = @_;
572     rawout("INVITE $who $chan");
573 }
574
575
576 ##########
577 # Channel related functions...
578 #
579
580 # Usage: &joinNextChan();
581 sub joinNextChan {
582     &DEBUG("joinNextChan called.");
583
584     if (scalar @joinchan) {
585         $chan = shift @joinchan;
586         &joinchan($chan);
587
588         if (my $i = scalar @joinchan) {
589             &status("joinNextChan: $i chans to join.");
590         }
591
592     } else {
593         if (exists $cache{joinTime}) {
594             my $delta   = time() - $cache{joinTime};
595             my $timestr = &Time2String($delta);
596             my $rate    = sprintf("%.1f", $delta / &getJoinChans() );
597             delete $cache{joinTime};
598
599             &DEBUG("time taken to join all chans: $timestr; rate: $rate sec/join");
600         }
601         # chanserv check: global channels, in case we missed one.
602
603         foreach ( &ChanConfList("chanServ_ops") ) {
604             &chanServCheck($_);
605         }
606     }
607 }
608
609 # Usage: &GetNickInChans($nick,$chan);
610 sub GetNickInChans {
611     my ($nick) = @_;
612     my @array;
613
614     foreach (keys %channels) {
615         next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} });
616         push(@array, $_);
617     }
618
619     return @array;
620 }
621
622 # Usage: &GetNicksInChan($chan);
623 sub GetNicksInChan {
624     my ($chan) = @_;
625     my @array;
626
627     return keys %{ $channels{$chan}{''} };
628 }
629
630 sub IsNickInChan {
631     my ($nick,$chan) = @_;
632
633     $chan =~ tr/A-Z/a-z/;       # not lowercase unfortunately.
634
635     if (&validChan($chan) == 0) {
636         &ERROR("INIC: invalid channel $chan.");
637         return 0;
638     }
639
640     if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) {
641         return 1;
642     } else {
643         foreach (keys %channels) {
644             next unless (/[A-Z]/);
645             &DEBUG("iNIC: hash channels contains mixed cased chan!!!");
646         }
647         return 0;
648     }
649 }
650
651 sub IsNickInAnyChan {
652     my ($nick) = @_;
653
654     foreach $chan (keys %channels) {
655         next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''}  });
656         return 1;
657     }
658     return 0;
659 }
660
661 # Usage: &validChan($chan);
662 sub validChan {
663     my ($chan) = @_;
664
665     if (lc $chan ne $chan) {
666         &WARN("validChan: lc chan != chan. ($chan); fixing.");
667         $chan =~ tr/A-Z/a-z/;
668     }
669
670     if (exists $channels{$chan}) {
671         return 1;
672     } else {
673         return 0;
674     }
675 }
676
677 ###
678 # Usage: &DeleteUserInfo($nick,@chans);
679 sub DeleteUserInfo {
680     my ($nick,@chans) = @_;
681     my ($mode,$chan);
682
683     foreach $chan (@chans) {
684         foreach $mode (keys %{ $channels{$chan} }) {
685             # use grep here?
686             next unless (exists $channels{$chan}{$mode}{$nick});
687
688             delete $channels{$chan}{$mode}{$nick};
689         }
690     }
691 }
692
693 sub clearChanVars {
694     my ($chan) = @_;
695
696     delete $channels{$chan};
697 }
698
699 sub clearIRCVars {
700 ###    &DEBUG("clearIRCVars() called!");
701     undef %channels;
702     undef %floodjoin;
703
704     @joinchan           = &getJoinChans(1);
705     $cache{joinTime}    = time();
706 }
707
708 sub getJoinChans {
709     my($show)   = @_;
710     my @chans;
711     my @skip;
712
713     foreach (keys %chanconf) {
714         next if ($_ eq "_default");
715
716         my $val = $chanconf{$_}{autojoin};
717         my $skip = 0;
718
719         if (defined $val) {
720             $skip++ if ($val eq "0");
721         } else {
722             $skip++;
723         }
724
725         if ($skip) {
726             push(@skip, $_);
727             next;
728         }
729
730         push(@chans, $_);
731     }
732
733     my $str;
734     if (scalar @skip) {
735         $str = "gJC: channels not auto-joining: @skip";
736     } else {
737         $str = "gJC: auto-joining all chans.";
738     }
739
740     &status($str) if ($show);
741
742     return @chans;
743 }
744
745 sub closeDCC {
746 ###    &DEBUG("closeDCC called.");
747
748     foreach $type (keys %dcc) {
749         next if ($type ne uc($type));
750  
751         foreach $nick (keys %{ $dcc{$type} }) {
752             next unless (defined $nick);
753             &DEBUG("closing DCC $type to $nick (FIXME).");
754             next unless (defined $dcc{$type}{$nick});
755
756             my $ref = $dcc{$type}{$nick};
757             &DEBUG("ref => $ref");
758
759 #           $dcc{$type}{$nick}->close();
760         }
761     }
762 }
763
764 sub joinfloodCheck {
765     my($who,$chan,$userhost) = @_;
766
767     return unless (&IsChanConf("joinfloodCheck"));
768
769     if (exists $netsplit{lc $who}) {    # netsplit join.
770         &DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
771     }
772
773     if (exists $floodjoin{$chan}{$who}{Time}) {
774         &WARN("floodjoin{$chan}{$who} already exists?");
775     }
776
777     $floodjoin{$chan}{$who}{Time} = time();
778     $floodjoin{$chan}{$who}{Host} = $userhost;
779
780     ### Check...
781     foreach (keys %floodjoin) {
782         my $c = $_;
783         my $count = scalar keys %{ $floodjoin{$c} };
784         next unless ($count > 5);
785         &DEBUG("joinflood: count => $count");
786
787         my $time;
788         foreach (keys %{ $floodjoin{$c} }) {
789             $time += $floodjoin{$c}{$_}{Time};
790         }
791         &DEBUG("joinflood: time => $time");
792         $time /= $count;
793
794         &DEBUG("joinflood: new time => $time");
795     }
796
797     ### Clean it up.
798     my $delete = 0;
799     foreach $chan (keys %floodjoin) {
800         foreach $who (keys %{ $floodjoin{$chan} }) {
801             my $time = time() - $floodjoin{$chan}{$who}{Time};
802             next unless ($time > 10);
803             delete $floodjoin{$chan}{$who};
804             $delete++;
805         }
806     }
807
808     &DEBUG("joinfloodCheck: $delete deleted.") if ($delete);
809 }
810
811 sub getHostMask {
812     my($n) = @_;
813
814     &FIXME("getHostMask($n) called...");
815 }
816
817 1;