src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   4 #         Version: v0.3 (20000707)
   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     &shmFlush(1);       # mandatory
  29     &slashdotCycle(1)   if (&IsParam("slashdot") and &IsParam("slashdotAnnounce"));
  30     &freshmeatCycle(1)  if (&IsParam("freshmeat") and &IsParam("freshmeatAnnounce"));
  31     &kernelCycle(1)     if (&IsParam("kernel") and &IsParam("kernelAnnounce"));
  32     &wingateWriteFile(1) if (&IsParam("wingate"));
  33 }
  34
  35 sub ScheduleThis {
  36     my ($interval, $codename, @args) = @_;
  37     my $waittime = &getRandomInt($interval);
  38
  39     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  40     $conn->schedule($waittime, \&$codename, @args);
  41 }
  42
  43 sub randomQuote {
  44     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
  45     if (!defined $line) {
  46         &ERROR("random Quote: weird error?");
  47         return;
  48     }
  49
  50     my @channels = split(/[\s\t]+/, lc $param{'randomQuoteChannels'});
  51     @channels    = keys(%channels) unless (scalar @channels);
  52
  53     my $good = 0;
  54     foreach (@channels) {
  55         next unless (&validChan($_));
  56
  57         &status("sending random Quote to $_.");
  58         &action($_, "Ponders: ".$line);
  59         $good++;
  60     }
  61
  62     if (!$good) {
  63         &WARN("randomQuote: no valid channels?");
  64         return;
  65     }
  66
  67     my $interval = $param{'randomQuoteInterval'} || 60;
  68     &ScheduleThis($interval, "randomQuote") if (@_);
  69 }
  70
  71 sub randomFactoid {
  72     my ($key,$val);
  73     my $error = 0;
  74     while (1) {
  75         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
  76 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
  77         last if ($val !~ /^</);
  78         $error++;
  79         if ($error == 5) {
  80             &ERROR("rF: tried 5 times but failed.");
  81             return;
  82         }
  83     }
  84
  85     my @channels = split(/[\s\t]+/, lc $param{'randomFactoidChannels'});
  86     @channels    = keys(%channels) unless (scalar @channels);
  87
  88     my $good = 0;
  89     foreach (@channels) {
  90         next unless (&validChan($_));
  91
  92         &status("sending random Factoid to $_.");
  93 ###     &msg($_, "$key is $val");
  94         &action($_, "Thinks: \037$key\037 is $val");
  95         ### FIXME: Use &getReply() on above to format factoid properly?
  96         $good++;
  97     }
  98
  99     if (!$good) {
 100         &WARN("randomFactoid: no valid channels?");
 101         return;
 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             ### NOT YET.
 159             # unlink $age{$oldest};
 160             $tsize -= $oldest;
 161             $delete++;
 162         }
 163
 164         ### TODO: add how many b,kb,mb removed?
 165         if ($delete) {
 166             &status("LOG: removed $delete logs.");
 167         }
 168     } else {
 169         &WARN("could not open dir $logdir");
 170     }
 171
 172     &ScheduleThis(60, "logCycle") if (@_);
 173 }
 174
 175 sub seenFlushOld {
 176     my $max_time = $param{'seenMaxDays'}*60*60*24;
 177     my $delete   = 0;
 178
 179     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 180         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 181         my $sth = $dbh->prepare($query);
 182         $sth->execute;
 183
 184         while (my @row = $sth->fetchrow_array) {
 185             my ($nick,$time) = @row;
 186
 187             &dbDel("seen","nick",$nick);
 188             $delete++;
 189         }
 190         $sth->finish;
 191     } elsif ($param{'DBType'} =~ /^dbm/i) {
 192         my $time = time();
 193
 194         foreach (keys %seen) {
 195             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 196             next unless ($delta_time > $max_time);
 197
 198             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 199             delete $seen{$_};
 200             $delete++;
 201         }
 202     } else {
 203         &FIXME("seenFlushOld: for PG/NO-DB.");
 204     }
 205     &VERB("SEEN deleted $delete seen entries.",2);
 206
 207     &ScheduleThis(1440, "seenFlushOld") if (@_);
 208 }
 209
 210 sub limitCheck {
 211     my $limitplus = $param{'limitcheckPlus'} || 5;
 212
 213     if (scalar keys %netsplit) {
 214         &status("limitcheck: netsplit active.");
 215         return;
 216     }
 217
 218     my @channels = split(/[\s\t]+/, lc $param{'limitcheck'});
 219
 220     foreach (@channels) {
 221         next unless (&validChan($_));
 222
 223         if (!exists $channels{$_}{'o'}{$ident}) {
 224             &ERROR("limitcheck: dont have ops on $_.");
 225             next;
 226         }
 227
 228         my $newlimit = scalar(keys %{$channels{$_}{''}}) + $limitplus;
 229         my $limit = $channels{$_}{'l'};
 230
 231         next unless (!defined $limit or $limit != $newlimit);
 232
 233         &rawout("MODE $_ +l $newlimit");
 234     }
 235
 236     my $interval = $param{'limitcheckInterval'} || 10;
 237     &ScheduleThis($interval, "limitCheck") if (@_);
 238 }
 239
 240 sub netsplitCheck {
 241     my ($s1,$s2);
 242
 243     foreach $s1 (keys %netsplitservers) {
 244         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 245             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 246                 &status("netsplit between $s1 and $s2 appears to be stale.");
 247                 delete $netsplitservers{$s1}{$s2};
 248             }
 249         }
 250     }
 251
 252     &ScheduleThis(30, "netsplitCheck") if (@_);
 253 }
 254
 255 sub floodCycle {
 256     my $interval = $param{'floodInterval'} || 60;       # seconds.
 257     my $delete = 0;
 258
 259     my $who;
 260     foreach $who (keys %flood) {
 261         foreach (keys %{$flood{$who}}) {
 262             if (time() - $flood{$who}{$_} > $interval) {
 263                 delete $flood{$who}{$_};
 264                 $delete++;
 265             }
 266         }
 267     }
 268     &VERB("floodCycle: deleted $delete items.",2);
 269
 270     &ScheduleThis($interval, "floodCycle") if (@_);     # minutes.
 271 }
 272
 273 sub seenFlush {
 274     my $nick;
 275     my $flushed = 0;
 276
 277     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 278         foreach $nick (keys %seencache) {
 279             my $exists = &dbGet("seen","nick", $nick, "nick");
 280
 281             if (defined $exists and $exists) {
 282                 &dbUpdate("seen", "nick", $nick, (
 283                         "time" => $seencache{$nick}{'time'},
 284                         "host" => $seencache{$nick}{'host'},
 285                         "channel" => $seencache{$nick}{'chan'},
 286                         "message" => $seencache{$nick}{'msg'},
 287                 ) );
 288             } else {
 289                 my $retval = &dbInsert("seen", $nick, (
 290                         "nick" => $seencache{$nick}{'nick'},
 291                         "time" => $seencache{$nick}{'time'},
 292                         "host" => $seencache{$nick}{'host'},
 293                         "channel" => $seencache{$nick}{'chan'},
 294                         "message" => $seencache{$nick}{'msg'},
 295                 ) );
 296
 297                 ### TODO: put bad nick into a list and don't do it again!
 298                 if ($retval == 0) {
 299                     &ERROR("Should never happen! (nick => $nick) FIXME");
 300                 }
 301             }
 302
 303             delete $seencache{$nick};
 304             $flushed++;
 305         }
 306
 307     } elsif ($param{'DBType'} =~ /^dbm/i) {
 308
 309         foreach $nick (keys %seencache) {
 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
 318             ### TODO: put bad nick into a list and don't do it again!
 319             if ($retval == 0) {
 320                 &ERROR("Should never happen! (nick => $nick) FIXME");
 321             }
 322
 323             delete $seencache{$nick};
 324             $flushed++;
 325         }
 326     } else {
 327         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 328     }
 329
 330     &VERB("Flushed $flushed seen entries.",2);
 331
 332     my $interval = $param{'seenFlushInterval'} || 60;
 333     &ScheduleThis($interval, "seenFlush") if (@_);
 334 }
 335
 336 sub leakCheck {
 337     my ($blah1,$blah2);
 338     my $count = 0;
 339
 340     # flood.
 341     foreach $blah1 (keys %flood) {
 342         foreach $blah2 (keys %{$flood{$blah1}}) {
 343             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 344         }
 345     }
 346     &VERB("\%flood has $count total keys.",2);
 347
 348     my $chan;
 349     foreach $chan (grep /[A-Z]/, keys %channels) {
 350         &DEBUG("leak: chan => '$chan'.");
 351         my ($i,$j);
 352         foreach $i (keys %{$channels{$chan}}) {
 353             foreach (keys %{$channels{$chan}{$i}}) {
 354                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 355             }
 356         }
 357     }
 358
 359     &ScheduleThis(60, "leakCheck") if (@_);
 360 }
 361
 362 sub ignoreListCheck {
 363     my $time = time();
 364     my $count = 0;
 365
 366     foreach (keys %ignoreList) {
 367         next if ($ignoreList{$_} == 1);
 368         next unless ($time > $ignoreList{$_});
 369
 370         delete $ignoreList{$_};
 371         &status("ignore: $_ has expired.");
 372         $count++;
 373     }
 374     &VERB("ignore: $count items deleted.",2);
 375
 376     &ScheduleThis(30, "ignoreListCheck") if (@_);
 377 }
 378
 379 sub ircCheck {
 380     my @array = split /[\t\s]+/, $param{'join_channels'};
 381     my $iconf = scalar(@array);
 382     my $inow  = scalar(keys %channels);
 383     if ($iconf > 2 and $inow * 2 <= $iconf) {
 384         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 385     }
 386
 387     # shmid stale remove.
 388     foreach (`ipcs`) {
 389         chop;
 390
 391         # key, shmid, owner, perms, bytes, nattch
 392         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 393
 394         my ($shmid, $size) = ($2,$5);
 395         next unless ($shmid != $shm and $size == 2000);
 396
 397         &status("SHM: nuking shmid $shmid");
 398         system("ipcrm shm $shmid >/dev/null");
 399     }
 400
 401     if (!$conn->connected and time - $msgtime > 3600) {
 402         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 403         $msgtime = time();      # just in case.
 404         &ircloop();
 405     }
 406
 407     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 408         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 409     }
 410
 411     &ScheduleThis(240, "ircCheck") if (@_);
 412 }
 413
 414 sub shmFlush {
 415     my $shmmsg = &shmRead($shm);
 416     $shmmsg =~ s/\0//g;         # remove padded \0's.
 417
 418     foreach (split '\|\|', $shmmsg) {
 419         &status("shm: Processing '$_'.");
 420
 421         if (/^DCC SEND (\S+) (\S+)$/) {
 422             my ($nick,$file) = ($1,$2);
 423             if (exists $dcc{'SEND'}{$who}) {
 424                 &msg($nick,"DCC already active.");
 425             } else {
 426                 &DEBUG("shm: dcc sending $2 to $1.");
 427                 $conn->new_send($1,$2);
 428                 $dcc{'SEND'}{$who} = time();
 429             }
 430         } elsif (/^DELETE FORK (\S+)$/) {
 431             delete $forked{$1};
 432         } elsif (/^EVAL (.*)$/) {
 433             &DEBUG("evaling '$1'.");
 434             eval $1;
 435         } else {
 436             &DEBUG("shm: unknown msg. ($_)");
 437         }
 438     }
 439
 440     &shmWrite($shm,"") if ($shmmsg ne "");
 441
 442     &ScheduleThis(5, "shmFlush") if (@_);
 443 }
 444
 445 sub uptimeCycle {
 446     &uptimeWriteFile();
 447
 448     &ScheduleThis(60, "uptimeCycle") if (@_);
 449 }
 450
 451 sub slashdotCycle {
 452     &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
 453
 454     &ScheduleThis(60, "slashdotCycle") if (@_);
 455 }
 456
 457 sub freshmeatCycle {
 458     &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
 459
 460     &ScheduleThis(60, "freshmeatCycle") if (@_);
 461 }
 462
 463 sub kernelCycle {
 464     &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
 465
 466     &ScheduleThis(240, "kernelCycle") if (@_);
 467 }
 468
 469 sub wingateCheck {
 470     return unless &IsParam("wingate");
 471     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
 472
 473     ### FILE CACHE OF OFFENDING WINGATES.
 474     foreach (grep /^$host$/, @wingateBad) {
 475         &status("Wingate: RUNNING ON $host BY $who");
 476         &ban("*!*\@$host", "") if &IsParam("wingateBan");
 477
 478         next unless (&IsParam("wingateKick"));
 479         &kick($who, "", $param{'wingateKick'})
 480     }
 481
 482     ### RUN CACHE OF TRIED WINGATES.
 483     if (grep /^$host$/, @wingateCache) {
 484         push(@wingateNow, $host);       # per run.
 485         push(@wingateCache, $host);     # cache per run.
 486     } else {
 487         &DEBUG("Already scanned $host. good.");
 488     }
 489
 490     my $interval = $param{'wingateInterval'} || 60;     # seconds.
 491     return if (defined $forked{'wingate'});
 492     return if (time() - $wingaterun <= $interval);
 493     return unless (scalar(keys %wingateToDo));
 494
 495     $wingaterun = time();
 496
 497     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 498     undef @wingateNow;
 499 }
 500
 501 ### TODO.
 502 sub wingateWriteFile {
 503     return unless (scalar @wingateCache);
 504
 505     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 506     if ($bot_pid != $$) {
 507         &DEBUG("wingateWriteFile: Reorganising!");
 508
 509         open(IN, $file);
 510         while (<IN>) {
 511             chop;
 512             push(@wingateNow, $_);
 513         }
 514         close IN;
 515
 516         # very lame hack.
 517         my %hash = map { $_ => 1 } @wingateNow;
 518         @wingateNow = sort keys %hash;
 519     }
 520
 521     &DEBUG("wingateWF: writing...");
 522     open(OUT, ">$file");
 523     foreach (@wingateNow) {
 524         print OUT "$_\n";
 525     }
 526     close OUT;
 527
 528     &ScheduleThis(60, "wingateWriteFile") if (@_);
 529 }
 530
 531 1;