X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=3e9a5a1152c10f9fd51299136c864def3de44398;hb=01ba3df164dca5b803527a4b7db6e5d36a334f91;hp=dfae3278efb914bf5bdc944be1ac91c393a7b2e9;hpb=44bab9382ffb0bf12639af84729d1c42ac4d9ae2;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index dfae3278..3e9a5a11 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -25,7 +25,7 @@ BEGIN { # try to create and lock a lockfile (this isn't atomic but # should do for now - $lockfn = "$root/perl/cluster.lock"; # lock file name + my $lockfn = "$root/perl/cluster.lock"; # lock file name if (-e $lockfn) { open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; my $pid = ; @@ -38,6 +38,7 @@ BEGIN { close CLLOCK; } + use Msg; use DXVars; use DXDebug; @@ -62,17 +63,23 @@ use DXDb; use AnnTalk; use WCY; use DXDupe; +use BadWords; use Data::Dumper; use Fcntl ':flock'; +use POSIX ":sys_wait_h"; use Local; package main; +#use strict; +#use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects $zombies $root +# $lang $myalias @debug $userfn $clusteraddr $clusterport $mycall $decease ); + @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.44"; # the version no of the software +$version = "1.45"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @outstanding_connects = (); # list of outstanding connects @@ -237,9 +244,13 @@ sub cease # the reaper of children sub reap { - $SIG{'CHLD'} = \&reap; - my $cpid = wait; - @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects; + my $cpid; + while (($cpid = waitpid(-1, WNOHANG)) != -1) { + dbg('reap', "cpid: $cpid"); + @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects; + $zombies-- if $zombies > 0; + } + dbg('reap', "cpid: $cpid"); } # this is where the input queue is dealt with and things are dispatched off to other parts of @@ -294,6 +305,7 @@ sub uptime ############################################################# $starttime = $systime = time; +$lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered dbginit(); @@ -323,11 +335,14 @@ DXUser->init($userfn, 1); dbg('err', "starting listener ..."); Msg->new_server("$clusteraddr", $clusterport, \&login); +# load bad words +dbg('err', "load badwords: " . (BadWords::load or "Ok")); + # prime some signals $SIG{INT} = \&cease; $SIG{TERM} = \&cease; $SIG{HUP} = 'IGNORE'; -$SIG{CHLD} = \&reap; +$SIG{CHLD} = sub { $zombies++ }; $SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; $SIG{IO} = sub { dbg('err', "SIGIO received"); }; @@ -364,7 +379,7 @@ DXProt->init(); # put in a DXCluster node for us here so we can add users and take them away -DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); +DXNode->new($DXProt::me, $mycall, 0, 1, $DXProt::myprot_version); # read in any existing message headers and clean out old crap dbg('err', "reading existing message headers ..."); @@ -395,19 +410,17 @@ dbg('err', "orft we jolly well go ..."); #open(DB::OUT, "|tee /tmp/aa"); for (;;) { - my $timenow; # $DB::trace = 1; Msg->event_loop(1, 0.1); - $timenow = time; + my $timenow = time; process_inqueue(); # read in lines from the input queue and despatch them # $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { + reap if $zombies; $systime = $timenow; - $cldate = &cldate(); - $ztime = &ztime(); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff