X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=1e850c90f8b9c74a030a1cab913f770d4d86f218;hb=a9fb1f86dd478133c73deb76fc89442cbdd9443b;hp=6ed864b13578ce5bf175310b92351128110ef4bc;hpb=5dd49f32f869e946267b7983499b1df741442472;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 6ed864b1..1e850c90 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -61,9 +61,12 @@ 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; @@ -71,7 +74,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.43"; # 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 +222,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 +239,12 @@ 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; + } + dbg('reap', "cpid: $cpid"); } # this is where the input queue is dealt with and things are dispatched off to other parts of @@ -253,11 +260,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'; @@ -326,18 +328,30 @@ 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{INT} = \&cease; +$SIG{TERM} = \&cease; +$SIG{HUP} = 'IGNORE'; +$SIG{CHLD} = \&reap; $SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; $SIG{IO} = sub { dbg('err', "SIGIO received"); }; -$SIG{ILL} = $SIG{FPE} = - $SIG{SEGV} = $SIG{USR1} = $SIG{USR2} = - $SIG{BUS} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; +$SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE'; +$SIG{KILL} = 'DEFAULT'; # as if it matters.... + +# catch the rest with a hopeful message +for (keys %SIG) { + if (!$SIG{$_}) { +# dbg('chan', "Catching SIG $_"); + $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; + } +} +# start dupe system +DXDupe::init(); # read in system messages DXM->init(); @@ -358,7 +372,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 ..."); @@ -409,6 +423,8 @@ for (;;) { DXMsg::process(); DXDb::process(); DXUser::process(); + DXDupe::process(); + eval { Local::process(); # do any localised processing };