X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=b471c754ec82a7999c39b8c50b69e0287ad05292;hb=5ff2fd1ff97212e4e490107d69f25572b71d2409;hp=88131b21a6931b08583b7cf0df5e760c5d4024ee;hpb=4ed8f51684c6f2183ffd5e46f1fc69dc4f52ebd9;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 88131b21..b471c754 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -67,7 +67,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.26"; # the version no of the software +$version = "1.28"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @@ -105,9 +105,16 @@ 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+)\|(.*)$/; + + # 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); + already_conn($conn, $call, $mess); + return; + } # is there one already connected elsewhere in the cluster (and not a cluster) - my $user = DXUser->get($call); if ($user) { if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) { ; @@ -175,8 +182,18 @@ sub cease 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); + 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); DXUser::finish(); + dbg('chan', "DXSpider version $version ended"); Log('cluster', "DXSpider V$version stopped"); + dbgclose(); unlink $lockfn; exit(0); } @@ -198,10 +215,20 @@ sub process_inqueue my $data = $self->{data}; my $dxchan = $self->{dxchan}; my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/; + + # 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?) dbg('chan', "<- $sort $call $line\n") unless $sort eq 'D'; - + # handle A records my $user = $dxchan->user; if ($sort eq 'A' || $sort eq 'O') { @@ -314,6 +341,7 @@ dbg('local', "Local::init error $@") if $@; # this, such as it is, is the main loop! print "orft we jolly well go ...\n"; +dbg('chan', "DXSpider version $version started..."); for (;;) { my $timenow; Msg->event_loop(1, 0.001);