src/IRC/Schedulers.pl

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