X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=a126b20b8f91c7cb4efa62b1db9673f08ee10344;hb=4470e513c0285d0fceb43299bcbe67d7e12c45d5;hp=aa44006786c5d382925d10e45cb324f0ca162766;hpb=f155969d600561b9ef151a7ce2494a0c89aed033;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index aa440067..a126b20b 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.41"; # 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 @@ -106,6 +114,11 @@ sub rec if (!defined $msg || (defined $err && $err)) { if ($dxchan) { + if (defined $err) { + $conn->disconnect; + undef $conn; + $dxchan->conn(undef); + } $dxchan->disconnect; } elsif ($conn) { $conn->disconnect; @@ -115,7 +128,8 @@ sub rec # set up the basic channel info - this needs a bit more thought - there is duplication here if (!defined $dxchan) { - my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + my ($sort, $call, $line) = DXChannel::decode_input(0, $msg); + return unless defined $sort; # is there one already connected to me - locally? my $user = DXUser->get($call); @@ -182,6 +196,8 @@ sub cease $SIG{'TERM'} = 'IGNORE'; $SIG{'INT'} = 'IGNORE'; + DXUser::sync; + eval { Local::finish(); # end local processing }; @@ -211,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; @@ -227,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)) > 0) { + 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 @@ -241,16 +262,9 @@ sub process_inqueue my $data = $self->{data}; my $dxchan = $self->{dxchan}; - my ($sort, $call, $line) = $data =~ /^(\w)([^\|]+)\|(.*)$/; my $error; - - # the above regexp must work - return unless ($sort && $call && $line); - - # 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; - } + my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data); + return unless defined $sort; # 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'; @@ -291,6 +305,7 @@ sub uptime ############################################################# $starttime = $systime = time; +$lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered dbginit(); @@ -320,11 +335,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} = sub { $zombies++ }; + +$SIG{PIPE} = sub { dbg('err', "Broken PIPE signal received"); }; +$SIG{IO} = sub { dbg('err', "SIGIO received"); }; +$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(); @@ -343,9 +377,8 @@ Spot->init(); dbg('err', "reading in duplicate spot and WWV info ..."); 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 ..."); @@ -376,25 +409,26 @@ 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 DXConnect::process(); DXMsg::process(); DXDb::process(); + DXUser::process(); + DXDupe::process(); + eval { Local::process(); # do any localised processing };