X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=6cdd417d16ccf2b4cfabf8fcf7fed20ca6a5e907;hb=refs%2Ftags%2FR_1_43;hp=be8380c1df0525c18ab69eb6b6d12b274c235344;hpb=88665a2bed3b9ec9e97237938a95a045b2a21bb4;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index be8380c1..6cdd417d 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -60,6 +60,7 @@ use CmdAlias; use Filter; use DXDb; use AnnTalk; +use WCY; use Data::Dumper; use Fcntl ':flock'; @@ -70,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.43"; # 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 @@ -105,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; @@ -114,23 +120,24 @@ 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); if (DXChannel->get($call)) { - my $mess = DXM::msg($lang, ($user && $user->sort eq 'A') ? 'concluster' : 'conother', $call); + my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } # is there one already connected elsewhere in the cluster? if ($user) { - if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) { + if (($user->is_node || $call eq $myalias) && !DXCluster->get_exact($call)) { ; } else { if (DXCluster->get_exact($call)) { - my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); + my $mess = DXM::msg($lang, $user->is_node ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } @@ -153,9 +160,9 @@ sub rec } # create the channel - $dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U'); - $dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A'); - $dxchan = BBS->new($call, $conn, $user) if ($user->sort eq 'B'); + $dxchan = DXCommandmode->new($call, $conn, $user) if $user->is_user; + $dxchan = DXProt->new($call, $conn, $user) if $user->is_node; + $dxchan = BBS->new($call, $conn, $user) if $user->is_bbs; die "Invalid sort of user on $call = $sort" if !$dxchan; } @@ -181,6 +188,8 @@ sub cease $SIG{'TERM'} = 'IGNORE'; $SIG{'INT'} = 'IGNORE'; + DXUser::sync; + eval { Local::finish(); # end local processing }; @@ -188,7 +197,7 @@ sub cease # disconnect nodes foreach $dxchan (DXChannel->get_all()) { - next unless $dxchan->is_ak1a; + next unless $dxchan->is_node; disconnect($dxchan) unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); @@ -200,7 +209,7 @@ sub cease # disconnect users foreach $dxchan (DXChannel->get_all()) { - next if $dxchan->is_ak1a; + next if $dxchan->is_node; disconnect($dxchan) unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); @@ -240,17 +249,15 @@ 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); + 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'; @@ -320,10 +327,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(); @@ -333,6 +353,7 @@ CmdAlias->init(); # initialise the Geomagnetic data engine Geomag->init(); +WCY->init(); # initial the Spot stuff Spot->init(); @@ -393,6 +414,7 @@ for (;;) { DXConnect::process(); DXMsg::process(); DXDb::process(); + DXUser::process(); eval { Local::process(); # do any localised processing };