src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   4 #         Version: v0.4b (20000923)
   5 #         Created: 20000117
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub setupSchedulers {
  11     &VERB("Starting schedulers...",2);
  12
  13     # ONCE OFF.
  14
  15     # REPETITIVE.
  16     &uptimeCycle(1)     if (&IsParam("uptime"));
  17     &randomQuote(1)     if (&IsParam("randomQuote"));
  18     &randomFactoid(1)   if (&IsParam("randomFactoid"));
  19     &logCycle(1)        if (defined fileno LOG and &IsParam("logfile") and &IsParam("maxLogSize"));
  20     &chanlimitCheck(1)  if (&IsParam("chanlimitcheck"));
  21     &netsplitCheck(1);  # mandatory
  22     &floodCycle(1);     # mandatory
  23     &seenFlush(1)       if (&IsParam("seen") and &IsParam("seenFlushInterval"));
  24     &leakCheck(1);      # mandatory
  25     &ignoreListCheck(1);# mandatory
  26     &seenFlushOld(1)    if (&IsParam("seen"));
  27     &ircCheck(1);       # mandatory
  28     &miscCheck(1);      # mandatory
  29     &shmFlush(1);       # mandatory
  30     &slashdotCycle(1)   if (&IsParam("slashdot") and &IsParam("slashdotAnnounce"));
  31     &freshmeatCycle(1)  if (&IsParam("freshmeat") and &IsParam("freshmeatAnnounce"));
  32     &kernelCycle(1)     if (&IsParam("kernel") and &IsParam("kernelAnnounce"));
  33     &wingateWriteFile(1) if (&IsParam("wingate"));
  34     &factoidCheck(1)    if (&IsParam("factoidDeleteDelay"));
  35 }
  36
  37 sub ScheduleThis {
  38     my ($interval, $codename, @args) = @_;
  39     my $waittime = &getRandomInt($interval);
  40
  41     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  42     $conn->schedule($waittime, \&$codename, @args);
  43 }
  44
  45 sub randomQuote {
  46     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
  47     if (!defined $line) {
  48         &ERROR("random Quote: weird error?");
  49         return;
  50     }
  51
  52     my @channels = split(/[\s\t]+/, lc $param{'randomQuoteChannels'});
  53     @channels    = keys(%channels) unless (scalar @channels);
  54
  55     my $good = 0;
  56     foreach (@channels) {
  57         next unless (&validChan($_));
  58
  59         &status("sending random Quote to $_.");
  60         &action($_, "Ponders: ".$line);
  61         $good++;
  62     }
  63
  64     if (!$good and scalar @channels) {
  65         &WARN("randomQuote: no valid channels?");
  66     }
  67
  68     my $interval = $param{'randomQuoteInterval'} || 60;
  69     &ScheduleThis($interval, "randomQuote") if (@_);
  70 }
  71
  72 sub randomFactoid {
  73     my ($key,$val);
  74     my $error = 0;
  75     while (1) {
  76         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
  77 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
  78         last if ($val !~ /^</);
  79         $error++;
  80         if ($error == 5) {
  81             &ERROR("rF: tried 5 times but failed.");
  82             return;
  83         }
  84     }
  85
  86     my @channels = split(/[\s\t]+/, lc $param{'randomFactoidChannels'});
  87     @channels    = keys(%channels) unless (scalar @channels);
  88
  89     my $good = 0;
  90     foreach (@channels) {
  91         next unless (&validChan($_));
  92
  93         &status("sending random Factoid to $_.");
  94 ###     &msg($_, "$key is $val");
  95         &action($_, "Thinks: \037$key\037 is $val");
  96         ### FIXME: Use &getReply() on above to format factoid properly?
  97         $good++;
  98     }
  99
 100     if (!$good and scalar @channels) {
 101         &WARN("randomFactoid: no valid channels?");
 102     }
 103
 104     my $interval = $param{'randomFactoidInterval'} || 60;
 105     &ScheduleThis($interval, "randomFactoid") if (@_);
 106 }
 107
 108 sub logCycle {
 109     # check if current size is too large.
 110     if ( -s $file{log} > $param{'maxLogSize'}) {
 111         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
 112         $file{log} = $param{'logfile'} ."-". $date;
 113         &status("cycling log file.");
 114
 115         if ( -e $file{log}) {
 116             my $i = 1;
 117             my $newlog;
 118             while () {
 119                 $newlog = $file{log}."-".$i;
 120                 last if (! -e $newlog);
 121                 $i++;
 122             }
 123             $file{log} = $newlog;
 124         }
 125
 126         &closeLog();
 127         system("/bin/mv '$param{'logfile'}' '$file{log}'");
 128         &compress($file{log});
 129         &openLog();
 130         &status("cycling log file.");
 131     }
 132
 133     # check if all the logs exceed size.
 134     my $logdir = "$bot_base_dir/log/";
 135     if (opendir(LOGS, $logdir)) {
 136         my $tsize = 0;
 137         my (%age, %size);
 138
 139         while (defined($_ = readdir LOGS)) {
 140             my $logfile = "$logdir/$_";
 141
 142             next unless ( -f $logfile);
 143             my $size = -s $logfile;
 144             my $age = (stat $logfile)[9]; ### or 8 ?
 145
 146             $age{$age}          = $logfile;
 147             $size{$logfile}     = $size;
 148
 149             $tsize              += $size;
 150         }
 151         closedir LOGS;
 152
 153         my $delete = 0;
 154         while ($tsize > $param{'maxLogSize'}) {
 155             &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
 156             my $oldest = (sort {$a <=> $b} keys %age)[0];
 157             &status("LOG: unlinking $age{$oldest}.");
 158             unlink $age{$oldest};
 159             $tsize -= $oldest;
 160             $delete++;
 161         }
 162
 163         ### TODO: add how many b,kb,mb removed?
 164         &status("LOG: removed $delete logs.") if ($delete);
 165     } else {
 166         &WARN("could not open dir $logdir");
 167     }
 168
 169     &ScheduleThis(60, "logCycle") if (@_);
 170 }
 171
 172 sub seenFlushOld {
 173     my $max_time = $param{'seenMaxDays'}*60*60*24;
 174     my $delete   = 0;
 175
 176     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 177         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 178         my $sth = $dbh->prepare($query);
 179         $sth->execute;
 180
 181         while (my @row = $sth->fetchrow_array) {
 182             my ($nick,$time) = @row;
 183
 184             &dbDel("seen","nick",$nick);
 185             $delete++;
 186         }
 187         $sth->finish;
 188     } elsif ($param{'DBType'} =~ /^dbm/i) {
 189         my $time = time();
 190
 191         foreach (keys %seen) {
 192             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 193             next unless ($delta_time > $max_time);
 194
 195             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 196             delete $seen{$_};
 197             $delete++;
 198         }
 199     } else {
 200         &FIXME("seenFlushOld: for PG/NO-DB.");
 201     }
 202     &VERB("SEEN deleted $delete seen entries.",2);
 203
 204     &ScheduleThis(1440, "seenFlushOld") if (@_);
 205 }
 206
 207 sub chanlimitCheck {
 208     my $limitplus = $param{'chanlimitcheckPlus'} || 5;
 209     my @channels = split(/[\s\t]+/, lc $param{'chanlimitcheck'});
 210
 211     foreach (@channels) {
 212         next unless (&validChan($_));
 213
 214         my $newlimit = scalar(keys %{$channels{$_}{''}}) + $limitplus;
 215         my $limit = $channels{$_}{'l'};
 216
 217         if (scalar keys %{$channels{$_}{''}} > $limit) {
 218             &status("LIMIT: set too low!!! FIXME");
 219         }
 220
 221         next unless (!defined $limit or $limit != $newlimit);
 222
 223         if (scalar keys %netsplit and $limit) {
 224             &status("Removing limit for $_ [netsplit!!!]");
 225             &rawout("MODE $_ -l");
 226         }
 227
 228         if (!exists $channels{$_}{'o'}{$ident}) {
 229             &ERROR("chanlimitcheck: dont have ops on $_.");
 230             next;
 231         }
 232         &rawout("MODE $_ +l $newlimit");
 233     }
 234
 235     my $interval = $param{'chanlimitcheckInterval'} || 10;
 236     &ScheduleThis($interval, "chanlimitCheck") if (@_);
 237 }
 238
 239 sub netsplitCheck {
 240     my ($s1,$s2);
 241
 242     foreach $s1 (keys %netsplitservers) {
 243         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 244             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 245                 &status("netsplit between $s1 and $s2 appears to be stale.");
 246                 delete $netsplitservers{$s1}{$s2};
 247             }
 248         }
 249     }
 250
 251     # %netsplit hash checker.
 252     foreach (keys %netsplit) {
 253         if (&IsNickInAnyChan($_)) {
 254             &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
 255             delete $netsplit{$_};
 256         }
 257         next unless (time() - $netsplit{$_} > 60*60*2); # 2 hours.
 258         next if (&IsNickInAnyChan($_));
 259
 260         &DEBUG("netsplitC: $_ didn't come back from netsplit in 2 hours; removing from netsplit list.");
 261         delete $netsplit{$_};
 262     }
 263
 264     &ScheduleThis(30, "netsplitCheck") if (@_);
 265 }
 266
 267 sub floodCycle {
 268     my $interval = $param{'floodInterval'} || 60;       # seconds.
 269     my $delete = 0;
 270
 271     my $who;
 272     foreach $who (keys %flood) {
 273         foreach (keys %{$flood{$who}}) {
 274             if (time() - $flood{$who}{$_} > $interval) {
 275                 delete $flood{$who}{$_};
 276                 $delete++;
 277             }
 278         }
 279     }
 280     &VERB("floodCycle: deleted $delete items.",2);
 281
 282     &ScheduleThis($interval, "floodCycle") if (@_);     # minutes.
 283 }
 284
 285 sub seenFlush {
 286     my $nick;
 287     my $flushed = 0;
 288     my %stats;
 289     $stats{'count_old'} = &countKeys("seen");
 290     $stats{'new'}       = 0;
 291     $stats{'old'}       = 0;
 292
 293     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 294         foreach $nick (keys %seencache) {
 295             my $exists = &dbGet("seen","nick", $nick, "nick");
 296
 297             if (defined $exists and $exists) {
 298                 &dbUpdate("seen", "nick", $nick, (
 299                         "time" => $seencache{$nick}{'time'},
 300                         "host" => $seencache{$nick}{'host'},
 301                         "channel" => $seencache{$nick}{'chan'},
 302                         "message" => $seencache{$nick}{'msg'},
 303                 ) );
 304                 $stats{'old'}++;
 305             } else {
 306                 my $retval = &dbInsert("seen", $nick, (
 307                         "nick" => $seencache{$nick}{'nick'},
 308                         "time" => $seencache{$nick}{'time'},
 309                         "host" => $seencache{$nick}{'host'},
 310                         "channel" => $seencache{$nick}{'chan'},
 311                         "message" => $seencache{$nick}{'msg'},
 312                 ) );
 313                 $stats{'new'}++;
 314
 315                 ### TODO: put bad nick into a list and don't do it again!
 316                 &FIXME("Should never happen! (nick => $nick)") if !$retval;
 317             }
 318
 319             delete $seencache{$nick};
 320             $flushed++;
 321         }
 322
 323     } elsif ($param{'DBType'} =~ /^dbm/i) {
 324
 325         foreach $nick (keys %seencache) {
 326             my $retval = &dbInsert("seen", $nick, (
 327                 "nick" => $seencache{$nick}{'nick'},
 328                 "time" => $seencache{$nick}{'time'},
 329                 "host" => $seencache{$nick}{'host'},
 330                 "channel" => $seencache{$nick}{'chan'},
 331                 "message" => $seencache{$nick}{'msg'},
 332             ) );
 333
 334             ### TODO: put bad nick into a list and don't do it again!
 335             &FIXME("Should never happen! (nick => $nick)") if !$retval;
 336
 337             delete $seencache{$nick};
 338             $flushed++;
 339         }
 340     } else {
 341         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 342     }
 343
 344     &status("Flushed $flushed seen entries.")           if ($flushed);
 345     &VERB(sprintf("  new seen: %03.01f%% (%d/%d)",
 346         $stats{'new'}*100/$stats{'count_old'},
 347         $stats{'new'}, $stats{'count_old'} ), 2)        if ($stats{'new'});
 348     &VERB(sprintf("  now seen: %3.1f%% (%d/%d)",
 349         $stats{'old'}*100/&countKeys("seen"),
 350         $stats{'old'}, &countKeys("seen") ), 2)         if ($stats{'old'});
 351
 352     &WARN("scalar keys seenflush != 0!")        if (scalar keys %seenflush);
 353
 354     my $interval = $param{'seenFlushInterval'} || 60;
 355     &ScheduleThis($interval, "seenFlush") if (@_);
 356 }
 357
 358 sub leakCheck {
 359     my ($blah1,$blah2);
 360     my $count = 0;
 361
 362     # flood.
 363     foreach $blah1 (keys %flood) {
 364         foreach $blah2 (keys %{$flood{$blah1}}) {
 365             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 366         }
 367     }
 368     &VERB("\%flood has $count total keys.",2);
 369
 370     my $chan;
 371     foreach $chan (grep /[A-Z]/, keys %channels) {
 372         &DEBUG("leak: chan => '$chan'.");
 373         my ($i,$j);
 374         foreach $i (keys %{$channels{$chan}}) {
 375             foreach (keys %{$channels{$chan}{$i}}) {
 376                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 377             }
 378         }
 379     }
 380
 381     &ScheduleThis(60, "leakCheck") if (@_);
 382 }
 383
 384 sub ignoreListCheck {
 385     my $time = time();
 386     my $count = 0;
 387
 388     foreach (keys %ignoreList) {
 389         next if ($ignoreList{$_} == 1);
 390         next unless ($time > $ignoreList{$_});
 391
 392         delete $ignoreList{$_};
 393         &status("ignore: $_ has expired.");
 394         $count++;
 395     }
 396     &VERB("ignore: $count items deleted.",2);
 397
 398     &ScheduleThis(30, "ignoreListCheck") if (@_);
 399 }
 400
 401 sub ircCheck {
 402     my @array = split /[\t\s]+/, $param{'join_channels'};
 403     my $iconf = scalar(@array);
 404     my $inow  = scalar(keys %channels);
 405     if ($iconf > 2 and $inow * 2 <= $iconf) {
 406         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 407     }
 408
 409     if (!$conn->connected and time - $msgtime > 3600) {
 410         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 411         $msgtime = time();      # just in case.
 412         &ircloop();
 413     }
 414
 415     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 416         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 417     }
 418
 419     &joinNextChan();
 420         # if scalar @joinnext => join more channels
 421         # else check for chanserv.
 422
 423     if (grep /^\s*$/, keys %channels) {
 424         &WARN("we have a NULL chan in hash channels? removing!");
 425         delete $channels{''};
 426         &status("channels now:");
 427         foreach (keys %channels) {
 428             &status("  $_");
 429         }
 430     }
 431
 432
 433     &ScheduleThis(240, "ircCheck") if (@_);
 434 }
 435
 436 sub miscCheck {
 437     # SHM check.
 438     my @ipcs;
 439     if ( -x "/usr/bin/ipcs") {
 440         @ipcs = `/usr/bin/ipcs`;
 441     } else {
 442         &WARN("ircCheck: no 'ipcs' binary.");
 443     }
 444
 445     # shmid stale remove.
 446     foreach (@ipcs) {
 447         chop;
 448
 449         # key, shmid, owner, perms, bytes, nattch
 450         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 451
 452         my ($shmid, $size) = ($2,$5);
 453         next unless ($shmid != $shm and $size == 2000);
 454
 455         &status("SHM: nuking shmid $shmid");
 456         system("/usr/bin/ipcrm shm $shmid >/dev/null");
 457     }
 458
 459     ### check modules if they've been modified. might be evil.
 460     &reloadAllModules();
 461
 462     &ScheduleThis(240, "miscCheck") if (@_);
 463 }
 464
 465 sub shmFlush {
 466     my $shmmsg = &shmRead($shm);
 467     $shmmsg =~ s/\0//g;         # remove padded \0's.
 468
 469     return if ($$ != $main::bot_pid); # fork protection.
 470
 471     foreach (split '\|\|', $shmmsg) {
 472         &VERB("shm: Processing '$_'.",2);
 473
 474         if (/^DCC SEND (\S+) (\S+)$/) {
 475             my ($nick,$file) = ($1,$2);
 476             if (exists $dcc{'SEND'}{$who}) {
 477                 &msg($nick,"DCC already active.");
 478             } else {
 479                 &DEBUG("shm: dcc sending $2 to $1.");
 480                 $conn->new_send($1,$2);
 481                 $dcc{'SEND'}{$who} = time();
 482             }
 483         } elsif (/^SET FORKPID (\S+) (\S+)/) {
 484             $forked{$1}{PID} = $2;
 485         } elsif (/^DELETE FORK (\S+)$/) {
 486             delete $forked{$1};
 487         } elsif (/^EVAL (.*)$/) {
 488             &DEBUG("evaling '$1'.");
 489             eval $1;
 490         } else {
 491             &DEBUG("shm: unknown msg. ($_)");
 492         }
 493     }
 494
 495     &shmWrite($shm,"") if ($shmmsg ne "");
 496
 497     &ScheduleThis(5, "shmFlush") if (@_);
 498 }
 499
 500 ### this is semi-scheduled
 501 sub getNickInUse {
 502     if ($ident eq $param{'ircNick'}) {
 503         &status("okay, got my nick back.");
 504         return;
 505     }
 506
 507     &status("Trying to get my nick back.");
 508     &nick($param{'ircNick'});
 509
 510     &ScheduleThis(5, "getNickInUse") if (@_);
 511 }
 512
 513 sub uptimeCycle {
 514     &uptimeWriteFile();
 515
 516     &ScheduleThis(60, "uptimeCycle") if (@_);
 517 }
 518
 519 sub slashdotCycle {
 520     &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
 521
 522     &ScheduleThis(60, "slashdotCycle") if (@_);
 523 }
 524
 525 sub freshmeatCycle {
 526     &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
 527
 528     &ScheduleThis(60, "freshmeatCycle") if (@_);
 529 }
 530
 531 sub kernelCycle {
 532     &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
 533
 534     &ScheduleThis(240, "kernelCycle") if (@_);
 535 }
 536
 537 sub wingateCheck {
 538     return unless &IsParam("wingate");
 539     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
 540
 541     ### FILE CACHE OF OFFENDING WINGATES.
 542     foreach (grep /^$host$/, @wingateBad) {
 543         &status("Wingate: RUNNING ON $host BY $who");
 544         &ban("*!*\@$host", "") if &IsParam("wingateBan");
 545
 546         next unless (&IsParam("wingateKick"));
 547         &kick($who, "", $param{'wingateKick'})
 548     }
 549
 550     ### RUN CACHE OF TRIED WINGATES.
 551     if (grep /^$host$/, @wingateCache) {
 552         push(@wingateNow, $host);       # per run.
 553         push(@wingateCache, $host);     # cache per run.
 554     } else {
 555         &DEBUG("Already scanned $host. good.");
 556     }
 557
 558     my $interval = $param{'wingateInterval'} || 60;     # seconds.
 559     return if (defined $forked{'wingate'});
 560     return if (time() - $wingaterun <= $interval);
 561     return unless (scalar(keys %wingateToDo));
 562
 563     $wingaterun = time();
 564
 565     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 566     undef @wingateNow;
 567 }
 568
 569 ### TODO.
 570 sub wingateWriteFile {
 571     return unless (scalar @wingateCache);
 572
 573     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 574     if ($bot_pid != $$) {
 575         &DEBUG("wingateWriteFile: Reorganising!");
 576
 577         open(IN, $file);
 578         while (<IN>) {
 579             chop;
 580             push(@wingateNow, $_);
 581         }
 582         close IN;
 583
 584         # very lame hack.
 585         my %hash = map { $_ => 1 } @wingateNow;
 586         @wingateNow = sort keys %hash;
 587     }
 588
 589     &DEBUG("wingateWF: writing...");
 590     open(OUT, ">$file");
 591     foreach (@wingateNow) {
 592         print OUT "$_\n";
 593     }
 594     close OUT;
 595
 596     &ScheduleThis(60, "wingateWriteFile") if (@_);
 597 }
 598
 599 sub factoidCheck {
 600     my @list = &searchTable("factoids", "factoid_key", "factoid_key", " #DEL#");
 601     my $stale = $param{'factoidDeleteDelay'}*60*60*24;
 602
 603     foreach (@list) {
 604         my $age = &getFactInfo($_, "modified_time");
 605         next unless (time() - $age > $stale);
 606
 607         my $fix = $_;
 608         $fix =~ s/ #DEL#$//g;
 609         &VERB("safedel: Removing $fix for good.",2);
 610         &delFactoid($_);
 611     }
 612
 613     &ScheduleThis(1440, "factoidCheck") if (@_);
 614 }
 615
 616 sub schedulerSTUB {
 617
 618     &ScheduleThis(TIME_IN_MINUTES, "FUNCTION") if (@_);
 619 }
 620
 621 1;