X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=5b43496e879e488e9a78e7dd5e37b3ed1fabd9e6;hb=3eb9538d135d9ff21d8ce7c0e0c6b3e6d7fb59a9;hp=5e4dd4d9efcc92880361e07a55bba4298c78a249;hpb=a3fd9341b7ce57dcc058b82cfba3f40f15631241;p=spider.git diff --git a/perl/cluster.pl b/perl/cluster.pl index 5e4dd4d9..5b43496e 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -14,6 +14,8 @@ require 5.004; # make sure that modules are searched in the order local then perl BEGIN { + umask 002; + # root of directory tree for this system $root = "/spider"; $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; @@ -55,16 +57,17 @@ use Prefix; use Bands; use Geomag; use CmdAlias; +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.23"; # 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 @@ -102,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)) { ; @@ -156,6 +166,9 @@ sub login sub cease { my $dxchan; + + $SIG{'TERM'} = 'IGNORE'; + $SIG{'INT'} = 'IGNORE'; eval { Local::finish(); # end local processing @@ -165,8 +178,25 @@ sub cease foreach $dxchan (DXChannel->get_all()) { 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); + 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); } @@ -187,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') { @@ -230,6 +270,7 @@ sub uptime $starttime = $systime = time; # open the debug file, set various FHs to be unbuffered +dbginit(); foreach (@debug) { dbgadd($_); } @@ -250,7 +291,7 @@ Bands::load(); # initialise User file system print "loading user file system ...\n"; -DXUser->init($userfn); +DXUser->init($userfn, 1); # start listening for incoming messages/connects print "starting listener ...\n"; @@ -303,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); @@ -327,5 +369,7 @@ for (;;) { last if --$decease <= 0; } } +cease(0); +exit(0);