X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=ec1030e88096a659e1b4480c7bf78572a2ac874a;hb=cdb2c0e3a1d778485f71d406a561b38ed5238dbc;hp=aa44006786c5d382925d10e45cb324f0ca162766;hpb=f155969d600561b9ef151a7ce2494a0c89aed033;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index aa440067..ec1030e8 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -71,7 +71,7 @@ package main; @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.44"; # 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 +106,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 +120,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 +188,8 @@ sub cease $SIG{'TERM'} = 'IGNORE'; $SIG{'INT'} = 'IGNORE'; + DXUser::sync; + eval { Local::finish(); # end local processing }; @@ -241,16 +249,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'; @@ -321,10 +322,23 @@ dbg('err', "starting listener ..."); Msg->new_server("$clusteraddr", $clusterport, \&login); # 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{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"); }; + } +} # read in system messages DXM->init(); @@ -395,6 +409,7 @@ for (;;) { DXConnect::process(); DXMsg::process(); DXDb::process(); + DXUser::process(); eval { Local::process(); # do any localised processing };