]> git.donarmstrong.com Git - infobot.git/blobdiff - src/IRC/Schedulers.pl
- strictify
[infobot.git] / src / IRC / Schedulers.pl
index b1e28c44a8baca38ef5fd9c1e0e1a9595f9037ff..18360d862814aa46bafc8513ad43cc1d7964a635 100644 (file)
@@ -5,7 +5,7 @@
 #         Created: 20000117
 #
 
-if (&IsParam("useStrict")) { use strict; }
+# use strict;  # TODO
 
 use POSIX qw(strftime);
 use vars qw(%sched);
@@ -29,22 +29,22 @@ sub setupSchedulers {
     &leakCheck(2);     # mandatory
     &ignoreCheck(1);   # mandatory
     &seenFlushOld(2);
-#    &ircCheck(2);     # mandatory
     &ircCheck(1);      # mandatory
     &miscCheck(1);     # mandatory
     &miscCheck2(2);    # mandatory
     &shmFlush(1);      # mandatory
     &slashdotLoop(2);
+    &plugLoop(2);
     &freshmeatLoop(2);
     &kernelLoop(2);
     &wingateWriteFile(2);
-    &factoidCheck(1);
+    &factoidCheck(2);  # takes a couple of seconds on a 486. defer it
     &newsFlush(1);
 
+    # todo: squeeze this into a one-liner.
 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
     my $count  = 0;
     foreach (keys %sched) {
-#      next unless (exists $sched{$_}{TIME});
        my $time = $sched{$_}{TIME};
        next unless (defined $time and $time > time());
 
@@ -138,7 +138,7 @@ sub randomFactoid {
 }
 
 sub randomFreshmeat {
-    my $interval = &getChanConfDefault("randomFresheatInterval", 60);
+    my $interval = &getChanConfDefault("randomFreshmeatInterval", 60);
 
     if (@_) {
        &ScheduleThis($interval, "randomFreshmeat");
@@ -195,41 +195,38 @@ sub logLoop {
     }
 
     ### check if all the logs exceed size.
-    my $logdir = "$bot_base_dir/log/";
-    if (opendir(LOGS, $logdir)) {
-       my $tsize = 0;
-       my (%age, %size);
-
-       while (defined($_ = readdir LOGS)) {
-           my $logfile         = "$logdir/$_";
+    if (!opendir(LOGS, $bot_log_dir)) {
+       &WARN("logLoop: could not open dir '$bot_log_dir'");
+       return;
+    }
 
-           next unless ( -f $logfile);
-           my $size            = -s $logfile;
-           my $age             = (stat $logfile)[9];
+    my $tsize          = 0;
+    my (%age, %size);
+    while (defined($_ = readdir LOGS)) {
+       my $logfile     = "$bot_log_dir/$_";
 
-           $age{$age}          = $logfile;
-           $size{$logfile}     = $size;
+       next unless ( -f $logfile);
 
-           $tsize              += $size;
-       }
-       closedir LOGS;
-
-       my $delete      = 0;
-       while ($tsize > $param{'maxLogSize'}) {
-           &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
-           my $oldest  = (sort {$a <=> $b} keys %age)[0];
-           &status("LOG: unlinking $age{$oldest}.");
-           unlink $age{$oldest};
-           $tsize      -= $oldest;
-           $delete++;
-       }
+       my $size        = -s $logfile;
+       my $age         = (stat $logfile)[9];
+       $age{$age}      = $logfile;
+       $size{$logfile} = $size;
+       $tsize          += $size;
+    }
+    closedir LOGS;
 
-       ### TODO: add how many b,kb,mb removed?
-       &status("LOG: removed $delete logs.") if ($delete);
-    } else {
-       &WARN("could not open dir $logdir");
+    my $delete = 0;
+    while ($tsize > $param{'maxLogSize'}) {
+       &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
+       my $oldest      = (sort {$a <=> $b} keys %age)[0];
+       &status("LOG: unlinking $age{$oldest}.");
+       unlink $age{$oldest};
+       $tsize          -= $oldest;
+       $delete++;
     }
 
+    ### TODO: add how many b,kb,mb removed?
+    &status("LOG: removed $delete logs.") if ($delete);
 }
 
 sub seenFlushOld {
@@ -246,10 +243,10 @@ sub seenFlushOld {
     my $max_time = &getChanConfDefault("seenMaxDays", 30) *60*60*24;
     my $delete   = 0;
 
-    if ($param{'DBType'} =~ /^pgsql|mysql/i) {
+    if ($param{'DBType'} =~ /^pgsql|mysql|sqlite/i) {
        my $query;
 
-       if ($param{'DBType'} =~ /^mysql$/i) {
+       if ($param{'DBType'} =~ /^mysql|sqlite$/i) {
            $query = "SELECT nick,time FROM seen GROUP BY nick HAVING ".
                        "UNIX_TIMESTAMP() - time > $max_time";
        } else {        # pgsql.
@@ -389,7 +386,7 @@ sub chanlimitCheck {
        if (scalar keys %netsplitservers) {
            if (defined $limit) {
                &status("chanlimit: netsplit; removing it for $chan.");
-               &rawout("MODE $chan -l");
+               $conn->mode($chan, "-l");
                $cache{chanlimitChange}{$chan} = time();
                &status("chanlimit: netsplit; removed.");
            }
@@ -408,7 +405,7 @@ sub chanlimitCheck {
        }
 
        if (!exists $channels{$chan}{'o'}{$ident}) {
-           &status("ChanLimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan});
+           &status("chanlimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan});
            $cache{warn}{chanlimit}{$chan} = 1;
            &chanServCheck($chan);
            next;
@@ -416,18 +413,18 @@ sub chanlimitCheck {
        delete $cache{warn}{chanlimit}{$chan};
 
        if (!defined $limit) {
-           &status("chanLimit: setting for first time or from netsplit, for $chan");
+           &status("chanlimit: setting for first time or from netsplit, for $chan");
        }
 
        if (exists $cache{chanlimitChange}{$chan}) {
            my $delta = time() - $cache{chanlimitChange}{$chan};
            if ($delta < $interval*60) {
-               &DEBUG("chanLimit: not going to change chanlimit! ($delta<$interval*60)");
+               &DEBUG("chanlimit: not going to change chanlimit! ($delta<$interval*60)");
                return;
            }
        }
 
-       &rawout("MODE $chan +l $newlimit");
+       $conn->mode($chan, "+l", $newlimit);
        $cache{chanlimitChange}{$chan} = time();
     }
 }
@@ -441,7 +438,7 @@ sub netsplitCheck {
     }
 
     $cache{'netsplitCache'}++;
-    &DEBUG("running netsplitCheck... $cache{netsplitCache}");
+#    &DEBUG("running netsplitCheck... $cache{netsplitCache}");
 
     if (!scalar %netsplit and scalar %netsplitservers) {
        &DEBUG("nsC: !hash netsplit but hash netsplitservers <- removing!");
@@ -494,7 +491,7 @@ sub netsplitCheck {
 
     if ($delete) {
        my $j = scalar(keys %netsplit);
-       &DEBUG("nsC: removed from netsplit list: (before: $count; after: $j)");
+       &status("nsC: removed from netsplit list: (before: $count; after: $j)");
     }
 
     if (!scalar %netsplit and scalar %netsplitservers) {
@@ -550,7 +547,7 @@ sub seenFlush {
     $stats{'new'}      = 0;
     $stats{'old'}      = 0;
 
-    if ($param{'DBType'} =~ /^(mysql|pgsql)$/i) {
+    if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite|dbm)$/i) {
        foreach $nick (keys %seencache) {
            my $retval = &dbReplace("seen", "nick", (
                        "nick" => lc $seencache{$nick}{'nick'},
@@ -561,57 +558,6 @@ sub seenFlush {
            ) );
            delete $seencache{$nick};
            $flushed++;
-
-           next;
-
-           ###
-           ### old code.
-           ###
-
-           my $exists = &dbGet("seen", "nick", "nick=".&dbQuote($nick) );
-
-           if (defined $exists and $exists) {
-               &dbUpdate("seen", "nick", $nick, (
-                       "time" => $seencache{$nick}{'time'},
-                       "host" => $seencache{$nick}{'host'},
-                       "channel" => $seencache{$nick}{'chan'},
-                       "message" => $seencache{$nick}{'msg'},
-               ) );
-               $stats{'old'}++;
-           } else {
-               my $retval = &dbInsert("seen", $nick, (
-                       "nick" => $seencache{$nick}{'nick'},
-                       "time" => $seencache{$nick}{'time'},
-                       "host" => $seencache{$nick}{'host'},
-                       "channel" => $seencache{$nick}{'chan'},
-                       "message" => $seencache{$nick}{'msg'},
-               ) );
-               $stats{'new'}++;
-
-               ### TODO: put bad nick into a list and don't do it again!
-               &FIXME("Should never happen! (nick => $nick)") if !$retval;
-           }
-
-           delete $seencache{$nick};
-           $flushed++;
-       }
-
-    } elsif ($param{'DBType'} =~ /^dbm/i) {
-
-       foreach $nick (keys %seencache) {
-           my $retval = &dbInsert("seen", $nick, (
-               "nick" => $seencache{$nick}{'nick'},
-               "time" => $seencache{$nick}{'time'},
-               "host" => $seencache{$nick}{'host'},
-               "channel" => $seencache{$nick}{'chan'},
-               "message" => $seencache{$nick}{'msg'},
-           ) );
-
-           ### TODO: put bad nick into a list and don't do it again!
-           &FIXME("Should never happen! (nick => $nick)") if !$retval;
-
-           delete $seencache{$nick};
-           $flushed++;
        }
     } else {
        &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
@@ -643,7 +589,7 @@ sub leakCheck {
            $count += scalar(keys %{ $flood{$blah1}{$blah2} });
        }
     }
-    &DEBUG("leak: hash flood has $count total keys.",2);
+    &VERB("leak: hash flood has $count total keys.",2);
 
     # floodjoin.
     $count = 0;
@@ -652,11 +598,11 @@ sub leakCheck {
            $count += scalar(keys %{ $floodjoin{$blah1}{$blah2} });
        }
     }
-    &DEBUG("leak: hash floodjoin has $count total keys.",2);
+    &VERB("leak: hash floodjoin has $count total keys.",2);
 
     # floodwarn.
     $count = scalar(keys %floodwarn);
-    &DEBUG("leak: hash floodwarn has $count total keys.",2);
+    &VERB("leak: hash floodwarn has $count total keys.",2);
 
     my $chan;
     foreach $chan (grep /[A-Z]/, keys %channels) {
@@ -671,7 +617,7 @@ sub leakCheck {
 
     # chanstats
     $count = scalar(keys %chanstats);
-    &DEBUG("leak: hash chanstats has $count total keys.",2);
+    &VERB("leak: hash chanstats has $count total keys.",2);
 
     # nuh.
     my $delete = 0;
@@ -709,6 +655,9 @@ sub ignoreCheck {
            $count++;
        }
     }
+
+    $cache{ignoreCheckTime} = time();
+
     &VERB("ignore: $count items deleted.",2);
 }
 
@@ -718,12 +667,16 @@ sub ircCheck {
        return if ($_[0] eq "2");       # defer.
     }
 
+    $cache{statusSafe} = 1;
+
     my @x      = &getJoinChans();
     my $iconf  = scalar( @x );
     my $inow   = scalar( keys %channels );
     if ($iconf > 2 and $inow * 2 <= $iconf) {
        &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
-       @joinchan       = @x;
+       &FIXME("ircCheck: iconf = $iconf");
+       &FIXME("ircCheck: inow  = $inow");
+#      @joinchan       = @x;
        &joinNextChan();
     }
 
@@ -744,7 +697,7 @@ sub ircCheck {
 
     if ($ident !~ /^\Q$param{ircNick}\E$/) {
        # this does not work unfortunately.
-       &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
+       &WARN("ircCheck: ident($ident) != param{ircNick}($param{ircNick}).");
 
        # this check is misleading... perhaps we should do a notify.
        if (! &IsNickInAnyChan( $param{ircNick} ) ) {
@@ -757,15 +710,15 @@ sub ircCheck {
 
     if (grep /^\s*$/, keys %channels) {
        &WARN("ircCheck: we have a NULL chan in hash channels? removing!");
-       if (exists $channels{''}) {
-           &DEBUG("ircCheck: ok it existed!");
-       } else {
-           &DEBUG("ircCheck: this hsould never happen!");
+       if (!exists $channels{''}) {
+           &DEBUG("ircCheck: this should never happen!");
        }
 
        delete $channels{''};
     }
 
+    $cache{statusSafe} = 0;
+
     ### USER FILE.
     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
        &writeUserFile();
@@ -780,7 +733,7 @@ sub ircCheck {
 
 sub miscCheck {
     if (@_) {
-       &ScheduleThis(240, "miscCheck");
+       &ScheduleThis(120, "miscCheck");
        return if ($_[0] eq "2");       # defer.
     }
 
@@ -838,13 +791,13 @@ sub miscCheck2 {
     }
 
     # debian check.
-    opendir(DEBIAN, "$bot_base_dir/debian");
+    opendir(DEBIAN, "$bot_state_dir/debian");
     foreach ( grep /gz$/, readdir(DEBIAN) ) {
-       my $exit = CORE::system("gzip -t $bot_base_dir/debian/$_");
+       my $exit = CORE::system("gzip -t $bot_state_dir/debian/$_");
        next unless ($exit);
 
        &status("debian: unlinking file => $_");
-       unlink "$bot_base_dir/debian/$_";
+       unlink "$bot_state_dir/debian/$_";
     }
     closedir DEBIAN;
 
@@ -870,49 +823,6 @@ sub miscCheck2 {
     closedir DIR;
 }
 
-sub shmFlush {
-    return if ($$ != $::bot_pid); # fork protection.
-
-    if (@_) {
-       &ScheduleThis(5, "shmFlush");
-       return if ($_[0] eq "2");
-    }
-
-    my $time;
-    my $shmmsg = &shmRead($shm);
-    $shmmsg =~ s/\0//g;         # remove padded \0's.
-    if ($shmmsg =~ s/^(\d+): //) {
-       $time   = $1;
-    }
-
-    foreach (split '\|\|', $shmmsg) {
-       next if (/^$/);
-       &VERB("shm: Processing '$_'.",2);
-
-       if (/^DCC SEND (\S+) (\S+)$/) {
-           my ($nick,$file) = ($1,$2);
-           if (exists $dcc{'SEND'}{$who}) {
-               &msg($nick, "DCC already active.");
-           } else {
-               &DEBUG("shm: dcc sending $2 to $1.");
-               $conn->new_send($1,$2);
-               $dcc{'SEND'}{$who} = time();
-           }
-       } elsif (/^SET FORKPID (\S+) (\S+)/) {
-           $forked{$1}{PID} = $2;
-       } elsif (/^DELETE FORK (\S+)$/) {
-           delete $forked{$1};
-       } elsif (/^EVAL (.*)$/) {
-           &DEBUG("evaling '$1'.");
-           eval $1;
-       } else {
-           &DEBUG("shm: unknown msg. ($_)");
-       }
-    }
-
-    &shmWrite($shm,"") if ($shmmsg ne "");
-}
-
 ### this is semi-scheduled
 sub getNickInUse {
     if ($ident eq $param{'ircNick'}) {
@@ -962,6 +872,29 @@ sub slashdotLoop {
     } );
 }
 
+sub plugLoop {
+
+    if (@_) {
+       &ScheduleThis(60, "plugLoop");
+       return if ($_[0] eq "2");
+    }
+
+    my @chans = &ChanConfList("plugAnnounce");
+    return unless (scalar @chans);
+
+    &Forker("plug", sub {
+       my $line = &Plug::plugAnnounce();
+       return unless (defined $line);
+
+       foreach (@chans) {
+           next unless (&::validChan($_));
+
+           &::status("sending plug update to $_.");
+           &notice($_, "Plug: $line");
+       }
+    } );
+}
+
 sub freshmeatLoop {
     if (@_) {
        &ScheduleThis(60, "freshmeatLoop");
@@ -1171,30 +1104,6 @@ sub scheduleList {
     &DEBUG("end of sList.");
 }
 
-sub getChanConfDefault {
-    my($what, $default, $chan) = @_;
-
-    if (exists $param{$what}) {
-       if (!exists $cache{config}{$what}) {
-           &status("conf: backward-compat: found param{$what} ($param{$what}) instead.");
-           $cache{config}{$what} = 1;
-       }
-
-       return $param{$what};
-    }
-
-    my $val = &getChanConf($what, $chan);
-    if (defined $val) {
-       return $val;
-    }
-
-    $param{$what}      = $default;
-    &status("conf: auto-setting param{$what} = $default");
-    $cache{config}{$what} = 1;
-
-    return $default;
-}
-
 sub mkBackup {
     my($file, $time)   = @_;
     my $backup         = 0;