X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=5b43496e879e488e9a78e7dd5e37b3ed1fabd9e6;hb=3eb9538d135d9ff21d8ce7c0e0c6b3e6d7fb59a9;hp=88131b21a6931b08583b7cf0df5e760c5d4024ee;hpb=4ed8f51684c6f2183ffd5e46f1fc69dc4f52ebd9;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 88131b21..5b43496e 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -61,13 +61,13 @@ use Filter; use Local; use Fcntl ':flock'; -use Carp; +use Carp qw(cluck); 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.30"; # 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,9 +182,21 @@ 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(); + Logclose(); unlink $lockfn; +# $SIG{__WARN__} = $SIG{__DIE__} = sub {my $a = shift; cluck($a); }; exit(0); } @@ -198,10 +217,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') { @@ -241,6 +270,7 @@ sub uptime $starttime = $systime = time; # open the debug file, set various FHs to be unbuffered +dbginit(); foreach (@debug) { dbgadd($_); } @@ -314,6 +344,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);