X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=8b45e2bd65d805d7fc411650b387a586199d103f;hb=9e2fbafcfdab1ee45e581524311f1a97ac41f6ad;hp=290838f40557838a3f772c19c7aaf029a9b2bb7b;hpb=d99e357e5203c7742b57c51b7c2dd103c1836c01;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 290838f4..8b45e2bd 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -59,6 +59,7 @@ use Geomag; use CmdAlias; use Filter; use Local; +use DXDb; use Fcntl ':flock'; use Carp qw(cluck); @@ -67,7 +68,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.29"; # the version no of the software +$version = "1.34"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @@ -89,6 +90,8 @@ sub already_conn sleep(1); dbg('chan', "-> Z $call bye\n"); $conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect + sleep(1); + $conn->disconnect; } # handle incoming messages @@ -109,7 +112,7 @@ sub rec # is there one already connected to me ? my $user = DXUser->get($call); if (DXChannel->get($call)) { - my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); + my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call); already_conn($conn, $call, $mess); return; } @@ -174,8 +177,25 @@ sub cease Local::finish(); # end local processing }; dbg('local', "Local::finish error $@") if $@; + + # close all databases + DXDb::closeall; + # disconnect users foreach $dxchan (DXChannel->get_all()) { + next if $dxchan->is_ak1a; + disconnect($dxchan) unless $dxchan == $DXProt::me; + } + Msg->event_loop(1, 0.05); + Msg->event_loop(1, 0.05); + Msg->event_loop(1, 0.05); + Msg->event_loop(1, 0.05); + Msg->event_loop(1, 0.05); + Msg->event_loop(1, 0.05); + + # disconnect nodes + foreach $dxchan (DXChannel->get_all()) { + next unless $dxchan->is_ak1a; disconnect($dxchan) unless $dxchan == $DXProt::me; } Msg->event_loop(1, 0.05); @@ -216,16 +236,15 @@ sub process_inqueue my $data = $self->{data}; my $dxchan = $self->{dxchan}; - my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/; - + my ($sort, $call, $line) = $data =~ /^(\w)([A-Z0-9\-]+)\|(.*)$/; + 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; -# dbg('chan', "<- $sort $call **CRAP**: $line"); -# return; } # do the really sexy console interface bit! (Who is going to do the TK interface then?) @@ -237,10 +256,8 @@ sub process_inqueue $dxchan->start($line, $sort); } elsif ($sort eq 'I') { die "\$user not defined for $call" if !defined $user; - # normal input $dxchan->normal($line); - disconnect($dxchan) if ($dxchan->{state} eq 'bye'); } elsif ($sort eq 'Z') { disconnect($dxchan); @@ -270,6 +287,7 @@ sub uptime $starttime = $systime = time; # open the debug file, set various FHs to be unbuffered +dbginit(); foreach (@debug) { dbgadd($_); } @@ -331,6 +349,10 @@ DXMsg::clean_old(); print "reading cron jobs ...\n"; DXCron->init(); +# read in database descriptors +print "reading database descriptors ...\n"; +DXDb::load(); + # starting local stuff print "doing local initialisation ...\n"; eval { @@ -346,7 +368,7 @@ print "orft we jolly well go ...\n"; dbg('chan', "DXSpider version $version started..."); for (;;) { my $timenow; - Msg->event_loop(1, 0.001); + Msg->event_loop(1, 0.1); $timenow = time; process_inqueue(); # read in lines from the input queue and despatch them @@ -359,6 +381,8 @@ for (;;) { DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff DXConnect::process(); + DXMsg::process(); + DXDb::process(); eval { Local::process(); # do any localised processing };