X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=3e9a5a1152c10f9fd51299136c864def3de44398;hb=01ba3df164dca5b803527a4b7db6e5d36a334f91;hp=1ecbc094a704487fd96c3998a560eb493d02f976;hpb=4e5b3de7a26563d94678fb790b8a1e2c4daaac8d;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 1ecbc094..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; @@ -61,17 +62,24 @@ use Filter; 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 @@ -219,6 +227,7 @@ sub cease Msg->event_loop(1, 0.05); Msg->event_loop(1, 0.05); DXUser::finish(); + DXDupe::finish(); # close all databases DXDb::closeall; @@ -235,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 @@ -253,11 +266,6 @@ sub process_inqueue my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data); return unless defined $sort; - # translate any crappy characters into hex characters - if ($line =~ /[\x00-\x06\x08\x0a-\x1f\x7f-\xff]/o) { - $line =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; - } - # do the really sexy console interface bit! (Who is going to do the TK interface then?) dbg('chan', "<- $sort $call $line\n") unless $sort eq 'D'; @@ -297,6 +305,7 @@ sub uptime ############################################################# $starttime = $systime = time; +$lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered dbginit(); @@ -326,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"); }; @@ -345,6 +357,9 @@ for (keys %SIG) { } } +# start dupe system +DXDupe::init(); + # read in system messages DXM->init(); @@ -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 @@ -415,6 +428,8 @@ for (;;) { DXMsg::process(); DXDb::process(); DXUser::process(); + DXDupe::process(); + eval { Local::process(); # do any localised processing };