src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   4 #         Version: v0.5 (20010124)
   5 #         Created: 20000117
   6 #
   7
   8 # use strict;   # TODO
   9
  10 use POSIX qw(strftime);
  11 use vars qw(%sched %schedule);
  12
  13 # format: function name = (
  14 #       str     chanconfdefault,
  15 #       int     internaldefault,
  16 #       bool    deferred,
  17 #       int     next run,               (optional)
  18 # )
  19
  20 #%schedule = {
  21 #       uptimeLoop => ('', 60, 1),
  22 #};
  23
  24 sub setupSchedulers {
  25     &VERB( 'Starting schedulers...', 2 );
  26
  27     # ONCE OFF.
  28
  29     # REPETITIVE.
  30     # 2 for on next-run.
  31     &randomQuote(2);
  32     &randomFactoid(2);
  33     &seenFlush(2);
  34     &leakCheck(2);    # mandatory
  35     &seenFlushOld(2);
  36     &miscCheck2(2);    # mandatory
  37     &slashdotLoop(2);
  38     &plugLoop(2);
  39     &kernelLoop(2);
  40     &wingateWriteFile(2);
  41     &factoidCheck(2);    # takes a couple of seconds on a 486. defer it
  42
  43     # TODO: convert to new format... or nuke altogether.
  44     &newsFlush(2);
  45     &rssFeeds(2);
  46
  47     # 1 for run straight away
  48     &uptimeLoop(1);
  49     &logLoop(1);
  50     &chanlimitCheck(1);
  51     &netsplitCheck(1);    # mandatory
  52     &floodLoop(1);        # mandatory
  53     &ignoreCheck(1);      # mandatory
  54     &miscCheck(1);        # mandatory
  55     &shmFlush(1);         # mandatory
  56     sleep 1;
  57     &ircCheck(1);         # mandatory
  58
  59     # TODO: squeeze this into a one-liner.
  60     #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
  61     my $count = 0;
  62     foreach ( keys %sched ) {
  63         my $time = $sched{$_}{TIME};
  64         next unless ( defined $time and $time > time() );
  65
  66         $count++;
  67     }
  68
  69     &status("Schedulers: $count will be running.");
  70     &scheduleList();
  71 }
  72
  73 sub ScheduleThis {
  74     my ( $interval, $codename, @args ) = @_;
  75
  76    # Set to supllied value plus a random 0-60 seconds to avoid simultaneous runs
  77     my $waittime =
  78       &getRandomInt( "$interval-" . ( $interval + &getRandomInt(60) ) );
  79
  80     if ( !defined $waittime ) {
  81         &WARN("interval == waittime == UNDEF for $codename.");
  82         return;
  83     }
  84
  85     my $time = $sched{$codename}{TIME};
  86     if ( defined $time and $time > time() ) {
  87         &WARN(  "Sched for $codename already exists in "
  88               . &Time2String( time() - $time )
  89               . '.' );
  90         return;
  91     }
  92
  93     &DEBUG(
  94         "Scheduling \&$codename() "
  95           . \&$codename . ' for '
  96           . &Time2String($waittime),
  97         3
  98     );
  99
 100     my $retval = $conn->schedule( $waittime, \&$codename, @args );
 101     $sched{$codename}{LABEL} = $retval;
 102     $sched{$codename}{TIME}  = time() + $waittime;
 103     $sched{$codename}{LOOP}  = 1;
 104 }
 105
 106 ####
 107 #### LET THE FUN BEGIN.
 108 ####
 109
 110 sub rssFeeds {
 111     my $interval = $param{'rssFeedTime'} || 30;
 112     if (@_) {
 113         &ScheduleThis( $interval * 60, 'rssFeeds' );    # minutes
 114         return if ( $_[0] eq '2' );                     # defer.
 115     }
 116     &Forker(
 117         'RSSFeeds',
 118         sub {
 119             my $line = &RSSFeeds::RSS();
 120             return unless ( defined $line );
 121
 122         }
 123     );
 124 }
 125
 126 sub randomQuote {
 127     my $interval = &getChanConfDefault( 'randomQuoteInterval', 60, $chan );
 128     if (@_) {
 129         &ScheduleThis( $interval * 60, 'randomQuote' );    # every hour
 130         return if ( $_[0] eq '2' );                        # defer.
 131     }
 132
 133     foreach ( &ChanConfList('randomQuote') ) {
 134         next unless ( &validChan($_) );
 135
 136         my $line =
 137           &getRandomLineFromFile( $bot_data_dir . '/infobot.randtext' );
 138         if ( !defined $line ) {
 139             &ERROR('random Quote: weird error?');
 140             return;
 141         }
 142
 143         &status("sending random Quote to $_.");
 144         &action( $_, 'Ponders: ' . $line );
 145     }
 146     ### TODO: if there were no channels, don't reschedule until channel
 147     ###         configuration is modified.
 148 }
 149
 150 sub randomFactoid {
 151     my ( $key, $val );
 152     my $error = 0;
 153
 154     my $interval = &getChanConfDefault( 'randomFactoidInterval', 60, $chan );
 155     if (@_) {
 156         &ScheduleThis( $interval * 60, 'randomFactoid' );    # minutes
 157         return if ( $_[0] eq '2' );                          # defer.
 158     }
 159
 160     foreach ( &ChanConfList('randomFactoid') ) {
 161         next unless ( &validChan($_) );
 162
 163         &status("sending random Factoid to $_.");
 164         while (1) {
 165             ( $key, $val ) =
 166               &randKey( 'factoids', 'factoid_key,factoid_value' );
 167             &DEBUG("rF: $key, $val");
 168 ###         $val =~ tr/^[A-Z]/[a-z]/;   # blah is Good => blah is good.
 169             last
 170               if (  ( defined $val )
 171                 and ( $val !~ /^</ )
 172                 and ( $key !~ /\#DEL\#/ )
 173                 and ( $key !~ /^cmd:/ ) );
 174
 175             $error++;
 176             if ( $error == 5 ) {
 177                 &ERROR('rF: tried 5 times but failed.');
 178                 return;
 179             }
 180         }
 181         &action( $_, "Thinks: \037$key\037 is $val" );
 182         ### FIXME: Use &getReply() on above to format factoid properly?
 183         $good++;
 184     }
 185 }
 186
 187 sub logLoop {
 188     if (@_) {
 189         &ScheduleThis( 3600, 'logLoop' );    # 1 hour
 190         return if ( $_[0] eq '2' );          # defer.
 191     }
 192
 193     return unless ( defined fileno LOG );
 194     return unless ( &IsParam('logfile') );
 195     return unless ( &IsParam('maxLogSize') );
 196
 197     ### check if current size is too large.
 198     if ( -s $file{log} > $param{'maxLogSize'} ) {
 199         my $date = sprintf( '%04d%02d%02d', (gmtime)[ 5, 4, 3 ] );
 200         $file{log} = $param{'logfile'} . '-' . $date;
 201         &status('cycling log file.');
 202
 203         if ( -e $file{log} ) {
 204             my $i = 1;
 205             my $newlog;
 206             while () {
 207                 $newlog = $file{log} . '-' . $i;
 208                 last if ( !-e $newlog );
 209                 $i++;
 210             }
 211             $file{log} = $newlog;
 212         }
 213
 214         &closeLog();
 215         CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'");
 216         &compress( $file{log} );
 217         &openLog();
 218         &status('cycling log file.');
 219     }
 220
 221     ### check if all the logs exceed size.
 222     if ( !opendir( LOGS, $bot_log_dir ) ) {
 223         &WARN("logLoop: could not open dir '$bot_log_dir'");
 224         return;
 225     }
 226
 227     my $tsize = 0;
 228     my ( %age, %size );
 229     while ( defined( $_ = readdir LOGS ) ) {
 230         my $logfile = "$bot_log_dir/$_";
 231
 232         next unless ( -f $logfile );
 233
 234         my $size = -s $logfile;
 235         my $age  = ( stat $logfile )[9];
 236         $age{$age}      = $logfile;
 237         $size{$logfile} = $size;
 238         $tsize += $size;
 239     }
 240     closedir LOGS;
 241
 242     my $delete = 0;
 243     while ( $tsize > $param{'maxLogSize'} ) {
 244         &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
 245         my $oldest = ( sort { $a <=> $b } keys %age )[0];
 246         &status("LOG: unlinking $age{$oldest}.");
 247         unlink $age{$oldest};
 248         $tsize -= $oldest;
 249         $delete++;
 250     }
 251
 252     ### TODO: add how many b,kb,mb removed?
 253     &status("LOG: removed $delete logs.") if ($delete);
 254 }
 255
 256 sub seenFlushOld {
 257     if (@_) {
 258         &ScheduleThis( 86400, 'seenFlushOld' );    # 1 day
 259         return if ( $_[0] eq '2' );                # defer.
 260     }
 261
 262     # is this global-only?
 263     return unless ( &IsChanConf('seen') > 0 );
 264     return unless ( &IsChanConf('seenFlushInterval') > 0 );
 265
 266     # global setting. does not make sense for per-channel.
 267     my $max_time =
 268       &getChanConfDefault( 'seenMaxDays', 30, $chan ) * 60 * 60 * 24;
 269     my $delete = 0;
 270
 271     if ( $param{'DBType'} =~ /^(pgsql|mysql|sqlite(2)?)$/i ) {
 272         my $query;
 273
 274         if ( $param{'DBType'} =~ /^mysql$/i ) {
 275             $query =
 276                 'SELECT nick,time FROM seen GROUP BY nick HAVING '
 277               . "UNIX_TIMESTAMP() - time > $max_time";
 278         }
 279         elsif ( $param{'DBType'} =~ /^sqlite(2)?$/i ) {
 280             $query =
 281                 'SELECT nick,time FROM seen GROUP BY nick HAVING '
 282               . "strftime('%s','now','localtime') - time > $max_time";
 283         }
 284         else {    # pgsql.
 285             $query =
 286                 'SELECT nick,time FROM seen WHERE '
 287               . "extract(epoch from timestamp 'now') - time > $max_time";
 288         }
 289
 290         my $sth = $dbh->prepare($query);
 291         if ( $sth->execute ) {
 292             while ( my @row = $sth->fetchrow_array ) {
 293                 my ( $nick, $time ) = @row;
 294
 295                 &sqlDelete( 'seen', { nick => $nick } );
 296                 $delete++;
 297             }
 298             $sth->finish;
 299         }
 300     }
 301     else {
 302         &FIXME( 'seenFlushOld: for bad DBType:' . $param{'DBType'} . '.' );
 303     }
 304     &VERB( "SEEN deleted $delete seen entries.", 2 );
 305
 306 }
 307
 308 sub newsFlush {
 309     if (@_) {
 310         &ScheduleThis( 3600, 'newsFlush' );    # 1 hour
 311         return if ( $_[0] eq '2' );            # defer.
 312     }
 313
 314     if ( !&ChanConfList('News') ) {
 315         &DEBUG("newsFlush: news disabled? (chan => $chan)");
 316         return;
 317     }
 318
 319     my $delete = 0;
 320     my $oldest = time();
 321     my %none;
 322     foreach $chan ( keys %::news ) {
 323         my $i     = 0;
 324         my $total = scalar( keys %{ $::news{$chan} } );
 325
 326         if ( !$total ) {
 327             delete $::news{$chan};
 328             next;
 329         }
 330
 331         foreach $item ( keys %{ $::news{$chan} } ) {
 332             my $t = $::news{$chan}{$item}{Expire};
 333
 334             my $tadd = $::news{$chan}{$item}{Time};
 335             $oldest = $tadd if ( $oldest > $tadd );
 336
 337             next if ( $t == 0 or $t == -1 );
 338             if ( $t < 1000 ) {
 339                 &status(
 340 "newsFlush: Fixed Expire time for $chan/$item, should not happen anyway."
 341                 );
 342                 $::news{$chan}{$item}{Expire} = time() + $t * 60 * 60 * 24;
 343                 next;
 344             }
 345
 346             my $delta = $t - time();
 347
 348             next unless ( time() > $t );
 349
 350             # TODO: show how old it was.
 351             delete $::news{$chan}{$item};
 352             &status("NEWS: (newsflush) deleted '$item'");
 353             $delete++;
 354             $i++;
 355         }
 356
 357         &status("NEWS (newsflush) {$chan}: deleted [$i/$total] news entries.")
 358           if ($i);
 359         $none{$chan} = 1 if ( $total == $i );
 360     }
 361
 362     # TODO: flush users aswell.
 363     my $duser = 0;
 364     foreach $chan ( keys %::newsuser ) {
 365         next if ( exists $none{$chan} );
 366
 367         foreach ( keys %{ $::newsuser{$chan} } ) {
 368             my $t = $::newsuser{$chan}{$_};
 369             if ( !defined $t or ( $t > 2 and $t < 1000 ) ) {
 370                 &DEBUG("something wrong with newsuser{$chan}{$_} => $t");
 371                 next;
 372             }
 373
 374             next unless ( $oldest > $t );
 375
 376             delete $::newsuser{$chan}{$_};
 377             $duser++;
 378         }
 379
 380         my $i = scalar( keys %{ $::newsuser{$chan} } );
 381         delete $::newsuser{$chan} unless ($i);
 382     }
 383
 384     if ( $delete or $duser ) {
 385         &status("NewsFlush: deleted: $delete news entries; $duser user cache.");
 386     }
 387 }
 388
 389 sub chanlimitCheck {
 390     my $interval = &getChanConfDefault( 'chanlimitcheckInterval', 10, $chan );
 391     my $mynick = $conn->nick();
 392
 393     if (@_) {
 394         &ScheduleThis( $interval * 60, 'chanlimitCheck' );  # default 10 minutes
 395         return if ( $_[0] eq '2' );
 396     }
 397
 398     my $str = join( ' ', &ChanConfList('chanlimitcheck') );
 399
 400     foreach $chan ( &ChanConfList('chanlimitcheck') ) {
 401         next unless ( &validChan($chan) );
 402
 403         if ( $chan eq '_default' ) {
 404             &WARN("chanlimit: we're doing $chan!! HELP ME!");
 405             next;
 406         }
 407
 408         my $limitplus = &getChanConfDefault( 'chanlimitcheckPlus', 5, $chan );
 409         my $newlimit  = scalar( keys %{ $channels{$chan}{''} } ) + $limitplus;
 410         my $limit     = $channels{$chan}{'l'};
 411
 412         if ( scalar keys %netsplitservers ) {
 413             if ( defined $limit ) {
 414                 &status("chanlimit: netsplit; removing it for $chan.");
 415                 $conn->mode( $chan, '-l' );
 416                 $cache{chanlimitChange}{$chan} = time();
 417                 &status('chanlimit: netsplit; removed.');
 418             }
 419
 420             next;
 421         }
 422
 423         if ( defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit )
 424         {
 425             &FIXME('LIMIT: set too low!!!');
 426             ### run NAMES again and flush it.
 427         }
 428
 429         if ( defined $limit and $limit == $newlimit ) {
 430             $cache{chanlimitChange}{$chan} = time();
 431             next;
 432         }
 433
 434         if ( !exists $channels{$chan}{'o'}{$mynick} ) {
 435             &status("chanlimit: dont have ops on $chan.")
 436               unless ( exists $cache{warn}{chanlimit}{$chan} );
 437             $cache{warn}{chanlimit}{$chan} = 1;
 438             &chanServCheck($chan);
 439             next;
 440         }
 441         delete $cache{warn}{chanlimit}{$chan};
 442
 443         if ( !defined $limit ) {
 444             &status(
 445                 "chanlimit: $chan: setting for first time or from netsplit.");
 446         }
 447
 448         if ( exists $cache{chanlimitChange}{$chan} ) {
 449             my $delta = time() - $cache{chanlimitChange}{$chan};
 450             if ( $delta < $interval * 60 ) {
 451                 &DEBUG(
 452 "chanlimit: not going to change chanlimit! ($delta<$interval*60)"
 453                 );
 454                 return;
 455             }
 456         }
 457
 458         $conn->mode( $chan, '+l', $newlimit );
 459         $cache{chanlimitChange}{$chan} = time();
 460     }
 461 }
 462
 463 sub netsplitCheck {
 464     my ( $s1, $s2 );
 465
 466     if (@_) {
 467         &ScheduleThis( 300, 'netsplitCheck' );    # every 5 minutes
 468         return if ( $_[0] eq '2' );
 469     }
 470
 471     $cache{'netsplitCache'}++;
 472
 473     #    &DEBUG("running netsplitCheck... $cache{netsplitCache}");
 474
 475     if ( !scalar %netsplit and scalar %netsplitservers ) {
 476         &DEBUG('nsC: !hash netsplit but hash netsplitservers <- removing!');
 477         undef %netsplitservers;
 478         return;
 479     }
 480
 481     # well... this shouldn't happen since %netsplit code does it anyway.
 482     foreach $s1 ( keys %netsplitservers ) {
 483
 484         foreach $s2 ( keys %{ $netsplitservers{$s1} } ) {
 485             my $delta = time() - $netsplitservers{$s1}{$s2};
 486
 487             if ( $delta > 60 * 30 ) {
 488                 &status("netsplit between $s1 and $s2 appears to be stale.");
 489                 delete $netsplitservers{$s1}{$s2};
 490                 &chanlimitCheck();
 491             }
 492         }
 493
 494         my $i = scalar( keys %{ $netsplitservers{$s1} } );
 495         delete $netsplitservers{$s1} unless ($i);
 496     }
 497
 498     # %netsplit hash checker.
 499     my $count  = scalar keys %netsplit;
 500     my $delete = 0;
 501     foreach ( keys %netsplit ) {
 502         if ( &IsNickInAnyChan($_) ) {    # why would this happen?
 503
 504           #         &DEBUG("nsC: $_ is in some chan; removing from netsplit list.");
 505             delete $netsplit{$_};
 506             $delete++;
 507             next;
 508         }
 509
 510         next unless ( time() - $netsplit{$_} > 60 * 15 );
 511
 512         $delete++;
 513         delete $netsplit{$_};
 514     }
 515
 516 # yet another hack.
 517 # FIXED: $ch should be used rather than $chan since it creates NULL channels in the hash
 518     foreach my $ch ( keys %channels ) {
 519         my $i = $cache{maxpeeps}{$ch} || 0;
 520         my $j = scalar( keys %{ $channels{$ch} } );
 521         next unless ( $i > 10 and 0.25 * $i > $j );
 522
 523         &DEBUG("netsplit: 0.25*max($i) > current($j); possible netsplit?");
 524     }
 525
 526     if ($delete) {
 527         my $j = scalar( keys %netsplit );
 528         &status("nsC: removed from netsplit list: (before: $count; after: $j)");
 529     }
 530
 531     if ( !scalar %netsplit and scalar %netsplitservers ) {
 532         &DEBUG('nsC: ok hash netsplit is NULL; purging hash netsplitservers');
 533         undef %netsplitservers;
 534     }
 535
 536     if ( $count and !scalar keys %netsplit ) {
 537         &DEBUG('nsC: netsplit is hopefully gone. reinstating chanlimit check.');
 538         &chanlimitCheck();
 539     }
 540 }
 541
 542 sub floodLoop {
 543     my $delete = 0;
 544     my $who;
 545
 546     if (@_) {
 547         &ScheduleThis( 60, 'floodLoop' );    # 1 minute
 548         return if ( $_[0] eq '2' );
 549     }
 550
 551     my $time = time();
 552     my $interval = &getChanConfDefault( 'floodCycle', 60, $chan );
 553
 554     foreach $who ( keys %flood ) {
 555         foreach ( keys %{ $flood{$who} } ) {
 556             if ( !exists $flood{$who}{$_} ) {
 557                 &WARN("flood{$who}{$_} undefined?");
 558                 next;
 559             }
 560
 561             if ( $time - $flood{$who}{$_} > $interval ) {
 562                 delete $flood{$who}{$_};
 563                 $delete++;
 564             }
 565         }
 566     }
 567     &VERB( "floodLoop: deleted $delete items.", 2 );
 568 }
 569
 570 sub seenFlush {
 571     if (@_) {
 572         my $interval = &getChanConfDefault( 'seenFlushInterval', 60, $chan );
 573         &ScheduleThis( $interval * 60, 'seenFlush' );    # minutes
 574         return if ( $_[0] eq '2' );
 575     }
 576
 577     my %stats;
 578     my $nick;
 579     my $flushed = 0;
 580     $stats{'count_old'} = &countKeys('seen') || 0;
 581     $stats{'new'}       = 0;
 582     $stats{'old'}       = 0;
 583
 584     if ( $param{'DBType'} =~ /^(mysql|pgsql|sqlite(2)?)$/i ) {
 585         foreach $nick ( keys %seencache ) {
 586             my $retval = &sqlSet(
 587                 'seen',
 588                 { 'nick' => lc $seencache{$nick}{'nick'} },
 589                 {
 590                     time    => $seencache{$nick}{'time'},
 591                     host    => $seencache{$nick}{'host'},
 592                     channel => $seencache{$nick}{'chan'},
 593                     message => $seencache{$nick}{'msg'},
 594                 }
 595             );
 596
 597             delete $seencache{$nick};
 598             $flushed++;
 599         }
 600     }
 601     else {
 602         &DEBUG('seenFlush: NO VALID FACTOID SUPPORT?');
 603     }
 604
 605     &status("Seen: Flushed $flushed entries.") if ($flushed);
 606     &VERB(
 607         sprintf(
 608             '  new seen: %03.01f%% (%d/%d)',
 609             $stats{'new'} * 100 / ( $stats{'count_old'} || 1 ),
 610             $stats{'new'},
 611             ( $stats{'count_old'} || 1 )
 612         ),
 613         2
 614     ) if ( $stats{'new'} );
 615     &VERB(
 616         sprintf(
 617             '  now seen: %3.1f%% (%d/%d)',
 618             $stats{'old'} * 100 / ( &countKeys('seen') || 1 ), $stats{'old'},
 619             &countKeys('seen')
 620         ),
 621         2
 622     ) if ( $stats{'old'} );
 623
 624     &WARN('scalar keys seenflush != 0!') if ( scalar keys %seenflush );
 625 }
 626
 627 sub leakCheck {
 628     my ( $blah1, $blah2 );
 629     my $count = 0;
 630
 631     if (@_) {
 632         &ScheduleThis( 14400, 'leakCheck' );    # every 4 hours
 633         return if ( $_[0] eq '2' );
 634     }
 635
 636     # flood. this is dealt with in floodLoop()
 637     foreach $blah1 ( keys %flood ) {
 638         foreach $blah2 ( keys %{ $flood{$blah1} } ) {
 639             $count += scalar( keys %{ $flood{$blah1}{$blah2} } );
 640         }
 641     }
 642     &VERB( "leak: hash flood has $count total keys.", 2 );
 643
 644     # floodjoin.
 645     $count = 0;
 646     foreach $blah1 ( keys %floodjoin ) {
 647         foreach $blah2 ( keys %{ $floodjoin{$blah1} } ) {
 648             $count += scalar( keys %{ $floodjoin{$blah1}{$blah2} } );
 649         }
 650     }
 651     &VERB( "leak: hash floodjoin has $count total keys.", 2 );
 652
 653     # floodwarn.
 654     $count = scalar( keys %floodwarn );
 655     &VERB( "leak: hash floodwarn has $count total keys.", 2 );
 656
 657     my $chan;
 658     foreach $chan ( grep /[A-Z]/, keys %channels ) {
 659         &DEBUG("leak: chan => '$chan'.");
 660         my ( $i, $j );
 661         foreach $i ( keys %{ $channels{$chan} } ) {
 662             foreach ( keys %{ $channels{$chan}{$i} } ) {
 663                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 664             }
 665         }
 666     }
 667
 668     # chanstats
 669     $count = scalar( keys %chanstats );
 670     &VERB( "leak: hash chanstats has $count total keys.", 2 );
 671
 672     # nuh.
 673     my $delete = 0;
 674     foreach ( keys %nuh ) {
 675         next if ( &IsNickInAnyChan($_) );
 676         next if ( exists $dcc{CHAT}{$_} );
 677
 678         delete $nuh{$_};
 679         $delete++;
 680     }
 681
 682     &status(
 683         "leak: $delete nuh{} items deleted; now have " . scalar( keys %nuh ) )
 684       if ($delete);
 685 }
 686
 687 sub ignoreCheck {
 688     if (@_) {
 689         &ScheduleThis( 60, 'ignoreCheck' );    # once every minute
 690         return if ( $_[0] eq '2' );            # defer.
 691     }
 692
 693     my $time  = time();
 694     my $count = 0;
 695
 696     foreach ( keys %ignore ) {
 697         my $chan = $_;
 698
 699         foreach ( keys %{ $ignore{$chan} } ) {
 700             my @array = @{ $ignore{$chan}{$_} };
 701
 702             next unless ( $array[0] and $time > $array[0] );
 703
 704             delete $ignore{$chan}{$_};
 705             &status("ignore: $_/$chan has expired.");
 706             $count++;
 707         }
 708     }
 709
 710     $cache{ignoreCheckTime} = time();
 711
 712     &VERB( "ignore: $count items deleted.", 2 );
 713 }
 714
 715 sub ircCheck {
 716     my $retval = 0;
 717     if (@_) {
 718         &ScheduleThis( 300, 'ircCheck' );    # every 5 minutes
 719         return $retval if ( $_[0] eq '2' );          # defer.
 720     }
 721
 722     $cache{statusSafe} = 1;
 723     # save current connection
 724     my $saveconn = $conn;
 725     foreach ( sort keys %conns ) {
 726         $conn = $conns{$_};
 727         next if (!defined $myconn);
 728         my $nick = $myconn->nick();
 729         &DEBUG("ircCheck for $_");
 730         # Display with min of 900sec delay between redisplay
 731         # FIXME: should only use 900sec when we are on the LAST %conns
 732         my @join = &getJoinChans(900);
 733         if ( scalar @join ) {
 734             &FIXME( 'ircCheck: found ' . scalar @join . 'channels to join! ' . join( ',', @join ) );
 735             $retval += scalar @join;
 736             &joinNextChan();
 737         }
 738
 739         # TODO: fix on_disconnect()
 740
 741         if ( time() - $msgtime > 3600 ) {
 742
 743             # TODO: shouldn't we use cache{connect} somewhere?
 744             if ( exists $cache{connect} ) {
 745                 &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 746                 $msgtime = time();    # just in case.
 747                 &ircloop();
 748                 delete $cache{connect};
 749             }
 750             else {
 751                 &status( 'ircCheck: possible lost in space; checking.'
 752                       . scalar(gmtime) );
 753                 &msg( $mynick, 'TEST' );
 754                 $cache{connect} = time();
 755             }
 756         }
 757     }
 758     # restore connection we were called from
 759     $conn = $saveconn;
 760
 761     if ( grep /^\s*$/, keys %channels ) {
 762         &WARN('ircCheck: we have a NULL chan in hash channels? removing!');
 763         if ( !exists $channels{''} ) {
 764             &DEBUG('ircCheck: this should never happen!');
 765         }
 766     }
 767     if ( $ident !~ /^\Q$param{ircNick}\E$/ ) {
 768
 769         # this does not work unfortunately.
 770         &WARN("ircCheck: ident($ident) != param{ircNick}($param{ircNick}).");
 771
 772         # this check is misleading... perhaps we should do a notify.
 773         if ( !&IsNickInAnyChan( $param{ircNick} ) ) {
 774             &DEBUG("$param{ircNick} not in use... changing!");
 775             &nick( $param{ircNick} );
 776         }
 777         else {
 778             &WARN("$param{ircNick} is still in use...");
 779         }
 780     }
 781
 782     $cache{statusSafe} = 0;
 783
 784     ### USER FILE.
 785     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
 786         &writeUserFile();
 787         $wtime_userfile = time();
 788     }
 789     ### CHAN FILE.
 790     if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) {
 791         &writeChanFile();
 792         $wtime_chanfile = time();
 793     }
 794     return $retval;
 795 }
 796
 797 sub miscCheck {
 798     if (@_) {
 799         &ScheduleThis( 7200, 'miscCheck' );    # every 2 hours
 800         return if ( $_[0] eq '2' );            # defer.
 801     }
 802
 803     # SHM check.
 804     my @ipcs;
 805     if ( -x '/usr/bin/ipcs' ) {
 806         @ipcs = `/usr/bin/ipcs`;
 807     }
 808     else {
 809         &WARN("ircCheck: no 'ipcs' binary.");
 810         return;
 811     }
 812
 813     # make backup of important files.
 814     &mkBackup( $bot_state_dir . '/infobot.chan',    60 * 60 * 24 * 3 );
 815     &mkBackup( $bot_state_dir . '/infobot.users',   60 * 60 * 24 * 3 );
 816     &mkBackup( $bot_base_dir . '/infobot-news.txt', 60 * 60 * 24 * 1 );
 817
 818     # flush cache{lobotomy}
 819     foreach ( keys %{ $cache{lobotomy} } ) {
 820         next unless ( time() - $cache{lobotomy}{$_} > 60 * 60 );
 821         delete $cache{lobotomy}{$_};
 822     }
 823
 824     ### check modules if they've been modified. might be evil.
 825     &reloadAllModules();
 826
 827     # shmid stale remove.
 828     foreach (@ipcs) {
 829         chop;
 830
 831         # key, shmid, owner, perms, bytes, nattch
 832         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 833
 834         my ( $shmid, $size ) = ( $2, $5 );
 835         next unless ( $shmid != $shm and $size == 2000 );
 836         my $z = &shmRead($shmid);
 837         if ( $z =~ /^(\S+):(\d+):(\d+): / ) {
 838             my $n    = $1;
 839             my $pid  = $2;
 840             my $time = $3;
 841             next if ( time() - $time < 60 * 60 );
 842
 843             # FIXME remove not-pid shm if parent process dead
 844             next if ( $pid == $bot_pid );
 845
 846             # don't touch other bots, if they're running.
 847             next unless ( $param{ircUser} =~ /^\Q$n\E$/ );
 848         }
 849         else {
 850             &DEBUG("shm: $shmid is not ours or old infobot => ($z)");
 851             next;
 852         }
 853
 854         &status("SHM: nuking shmid $shmid");
 855         CORE::system("/usr/bin/ipcrm shm $shmid >/dev/null");
 856     }
 857 }
 858
 859 sub miscCheck2 {
 860     if (@_) {
 861         &ScheduleThis( 14400, 'miscCheck2' );    # every 4 hours
 862         return if ( $_[0] eq '2' );              # defer.
 863     }
 864
 865     # debian check.
 866     opendir( DEBIAN, "$bot_state_dir/debian" );
 867     foreach ( grep /gz$/, readdir(DEBIAN) ) {
 868         my $exit = CORE::system("gzip -t $bot_state_dir/debian/$_");
 869         next unless ($exit);
 870
 871         &status("debian: unlinking file => $_");
 872         unlink "$bot_state_dir/debian/$_";
 873     }
 874     closedir DEBIAN;
 875
 876     # compress logs that should have been compressed.
 877     # TODO: use strftime?
 878     my ( $day, $month, $year ) = ( gmtime( time() ) )[ 3, 4, 5 ];
 879     my $date = sprintf( '%04d%02d%02d', $year + 1900, $month + 1, $day );
 880
 881     if ( !opendir( DIR, "$bot_log_dir" ) ) {
 882         &ERROR("misccheck2: log dir $bot_log_dir does not exist.");
 883         closedir DIR;
 884         return -1;
 885     }
 886
 887     while ( my $f = readdir(DIR) ) {
 888         next unless ( -f "$bot_log_dir/$f" );
 889         next if ( $f =~ /gz|bz2/ );
 890         next unless ( $f =~ /(\d{8})/ );
 891         next if ( $date eq $1 );
 892
 893         &compress("$bot_log_dir/$f");
 894     }
 895     closedir DIR;
 896 }
 897
 898 ### this is semi-scheduled
 899 sub getNickInUse {
 900
 901     # FIXME: broken for multiple connects
 902     #    if ($ident eq $param{'ircNick'}) {
 903     #   &status('okay, got my nick back.');
 904     #   return;
 905     #    }
 906     #
 907     #    if (@_) {
 908     #   &ScheduleThis(30, 'getNickInUse');
 909     #   return if ($_[0] eq '2');       # defer.
 910     #    }
 911     #
 912     #    &nick( $param{'ircNick'} );
 913 }
 914
 915 sub uptimeLoop {
 916     return if ( !defined &uptimeWriteFile );
 917
 918     #    return unless &IsParam('Uptime');
 919
 920     if (@_) {
 921         &ScheduleThis( 3600, 'uptimeLoop' );    # once per hour
 922         return if ( $_[0] eq '2' );             # defer.
 923     }
 924
 925     &uptimeWriteFile();
 926 }
 927
 928 sub slashdotLoop {
 929
 930     if (@_) {
 931         &ScheduleThis( 3600, 'slashdotLoop' );    # once per hour
 932         return if ( $_[0] eq '2' );
 933     }
 934
 935     my @chans = &ChanConfList('slashdotAnnounce');
 936     return unless ( scalar @chans );
 937
 938     &Forker(
 939         'slashdot',
 940         sub {
 941             my $line = &Slashdot::slashdotAnnounce();
 942             return unless ( defined $line );
 943
 944             foreach (@chans) {
 945                 next unless ( &::validChan($_) );
 946
 947                 &::status("sending slashdot update to $_.");
 948                 &notice( $_, "Slashdot: $line" );
 949             }
 950         }
 951     );
 952 }
 953
 954 sub plugLoop {
 955
 956     if (@_) {
 957         &ScheduleThis( 3600, 'plugLoop' );    # once per hour
 958         return if ( $_[0] eq '2' );
 959     }
 960
 961     my @chans = &ChanConfList('plugAnnounce');
 962     return unless ( scalar @chans );
 963
 964     &Forker(
 965         'Plug',
 966         sub {
 967             my $line = &Plug::plugAnnounce();
 968             return unless ( defined $line );
 969
 970             foreach (@chans) {
 971                 next unless ( &::validChan($_) );
 972
 973                 &::status("sending plug update to $_.");
 974                 &notice( $_, "Plug: $line" );
 975             }
 976         }
 977     );
 978 }
 979
 980 sub kernelLoop {
 981     if (@_) {
 982         &ScheduleThis( 14400, 'kernelLoop' );    # once every 4 hours
 983         return if ( $_[0] eq '2' );
 984     }
 985
 986     my @chans = &ChanConfList('kernelAnnounce');
 987     return unless ( scalar @chans );
 988
 989     &Forker(
 990         'Kernel',
 991         sub {
 992             my @data = &Kernel::kernelAnnounce();
 993
 994             foreach (@chans) {
 995                 next unless ( &::validChan($_) );
 996
 997                 &::status("sending kernel update to $_.");
 998                 my $c = $_;
 999                 foreach (@data) {
1000                     &notice( $c, "Kernel: $_" );
1001                 }
1002             }
1003         }
1004     );
1005 }
1006
1007 sub wingateCheck {
1008     return unless &IsChanConf('Wingate') > 0;
1009
1010     ### FILE CACHE OF OFFENDING WINGATES.
1011     foreach ( grep /^$host$/, @wingateBad ) {
1012         &status("Wingate: RUNNING ON $host BY $who");
1013         &ban( "*!*\@$host", '' ) if &IsChanConf('wingateBan') > 0;
1014
1015         my $reason = &getChanConf('wingateKick');
1016
1017         next unless ($reason);
1018         &kick( $who, '', $reason );
1019     }
1020
1021     ### RUN CACHE OF TRIED WINGATES.
1022     if ( grep /^$host$/, @wingateCache ) {
1023         push( @wingateNow,   $host );    # per run.
1024         push( @wingateCache, $host );    # cache per run.
1025     }
1026     else {
1027         &DEBUG("Already scanned $host. good.");
1028     }
1029
1030     my $interval =
1031       &getChanConfDefault( 'wingateInterval', 60, $chan );    # seconds.
1032     return if ( defined $forked{'Wingate'} );
1033     return if ( time() - $wingaterun <= $interval );
1034     return unless ( scalar( keys %wingateToDo ) );
1035
1036     $wingaterun = time();
1037
1038     &Forker( 'Wingate', sub { &Wingate::Wingates( keys %wingateToDo ); } );
1039     undef @wingateNow;
1040 }
1041
1042 ### TODO: ??
1043 sub wingateWriteFile {
1044     if (@_) {
1045         &ScheduleThis( 3600, 'wingateWriteFile' );    # once per hour
1046         return if ( $_[0] eq '2' );                   # defer.
1047     }
1048
1049     return unless ( scalar @wingateCache );
1050
1051     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
1052     if ( $bot_pid != $$ ) {
1053         &DEBUG('wingateWriteFile: Reorganising!');
1054
1055         open( IN, $file );
1056         while (<IN>) {
1057             chop;
1058             push( @wingateNow, $_ );
1059         }
1060         close IN;
1061
1062         # very lame hack.
1063         my %hash = map { $_ => 1 } @wingateNow;
1064         @wingateNow = sort keys %hash;
1065     }
1066
1067     &DEBUG('wingateWF: writing...');
1068     open( OUT, ">$file" );
1069     foreach (@wingateNow) {
1070         print OUT "$_\n";
1071     }
1072     close OUT;
1073 }
1074
1075 sub factoidCheck {
1076     if (@_) {
1077         &ScheduleThis( 43200, 'factoidCheck' );    # ever 12 hours
1078         return if ( $_[0] eq '2' );                # defer.
1079     }
1080
1081     my @list =
1082       &searchTable( 'factoids', 'factoid_key', 'factoid_key', ' #DEL#' );
1083     my $stale =
1084       &getChanConfDefault( 'factoidDeleteDelay', 14, $chan ) * 60 * 60 * 24;
1085     if ( $stale < 1 ) {
1086
1087         # disable it since it's 'illegal'.
1088         return;
1089     }
1090
1091     my $time = time();
1092
1093     foreach (@list) {
1094         my $age = &getFactInfo( $_, 'modified_time' );
1095
1096         if ( !defined $age or $age !~ /^\d+$/ ) {
1097             if ( scalar @list > 50 ) {
1098                 if ( !$cache{warnDel} ) {
1099                     &WARN(  'list is over 50 ('
1100                           . scalar(@list)
1101                           . '... giving it a miss.' );
1102                     $cache{warnDel} = 1;
1103                     last;
1104                 }
1105             }
1106
1107             &WARN("del factoid: old cruft (no time): $_");
1108             &delFactoid($_);
1109             next;
1110         }
1111
1112         next unless ( $time - $age > $stale );
1113
1114         my $fix = $_;
1115         $fix =~ s/ #DEL#$//g;
1116         my $agestr = &Time2String( $time - $age );
1117         &status("safedel: Removing '$_' for good. [$agestr old]");
1118
1119         &delFactoid($_);
1120     }
1121 }
1122
1123 sub dccStatus {
1124     return unless ( scalar keys %{ $dcc{CHAT} } );
1125
1126     if (@_) {
1127         &ScheduleThis( 600, 'dccStatus' );    # every 10 minutes
1128         return if ( $_[0] eq '2' );           # defer.
1129     }
1130
1131     my $time = strftime( '%H:%M', gmtime( time() ) );
1132
1133     my $c;
1134     foreach ( keys %channels ) {
1135         my $c     = $_;
1136         my $users = keys %{ $channels{$c}{''} };
1137         my $chops = keys %{ $channels{$c}{o} };
1138         my $bans  = keys %{ $channels{$c}{b} };
1139
1140         my $txt = "[$time] $c: $users members ($chops chops), $bans bans";
1141         foreach ( keys %{ $dcc{'CHAT'} } ) {
1142             next unless ( exists $channels{$c}{''}{ lc $_ } );
1143             $conn->privmsg( $dcc{'CHAT'}{$_}, $txt );
1144         }
1145     }
1146 }
1147
1148 sub scheduleList {
1149     ###
1150     # custom:
1151     #   a - time == now.
1152     #   b - weird time.
1153     ###
1154
1155     my $reply = 'sched:';
1156     foreach ( keys %{ $irc->{_queue} } ) {
1157         my $q       = $_;
1158         my $coderef = $irc->{_queue}->{$q}->[1];
1159         my $sched;
1160         foreach ( keys %sched ) {
1161             my $schedname = $_;
1162             next unless defined( \&$schedname );
1163             next unless ( $coderef eq \&$schedname );
1164             $sched = $schedname;
1165             last;
1166         }
1167
1168         my $time = $irc->{_queue}->{$q}->[0] - time();
1169
1170         if ( defined $sched ) {
1171             $reply = "$reply, $sched($q):" . &Time2String($time);
1172         }
1173         else {
1174             $reply = "$reply, NULL($q):" . &Time2String($time);
1175         }
1176     }
1177
1178     &DEBUG("$reply");
1179 }
1180
1181 sub mkBackup {
1182     my ( $file, $time ) = @_;
1183     my $backup = 0;
1184
1185     if ( !-f $file ) {
1186         &VERB( "mkB: file '$file' does not exist.", 2 );
1187         return;
1188     }
1189
1190     my $age = 'New';
1191     if ( -e "$file~" ) {
1192         $backup++ if ( ( stat $file )[9] - ( stat "$file~" )[9] > $time );
1193         my $delta = time() - ( stat "$file~" )[9];
1194         $age = &Time2String($delta);
1195     }
1196     else {
1197         $backup++;
1198     }
1199
1200     return unless ($backup);
1201
1202     ### TODO: do internal copying.
1203     &status("Backup: $file ($age)");
1204     CORE::system("/bin/cp $file $file~");
1205 }
1206
1207 1;
1208
1209 # vim:ts=4:sw=4:expandtab:tw=80