upissued version no

[spider.git] / perl / cluster.pl

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 4c65e86858acb7c7711152562579c06d0384276f..1eb8207806716033fbb16e9014b7e4fa9fd68d21 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -27,6 +27,7 @@ use Msg;
 use DXVars;
 use DXDebug;
 use DXLog;
+use DXLogPrint;
 use DXUtil;
 use DXChannel;
 use DXUser;
@@ -47,8 +48,9 @@ package main;
 
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
-$version = 1.3;                                        # the version no of the software
-
+$version = 1.9;                                        # the version no of the software
+$starttime = 0;                 # the starting time of the cluster   
+ 
 # handle disconnections
 sub disconnect
 {
@@ -83,8 +85,12 @@ sub rec
                        return;
                }
                
-               # is there one already connected elsewhere in the cluster?
-               if (DXCluster->get($call)) {
+               # is there one already connected elsewhere in the cluster (and not a cluster)
+               my $user = DXUser->get($call);
+               if ($user && $user->sort eq 'A' && !DXCluster->get_exact($call)) {
+                       ;
+               } elsif (($call eq $main::myalias && DXCluster->get_exact($call)) ||
+                   DXCluster->get($call)) {
                        my $mess = DXM::msg($lang, 'concluster', $call);
                        dbg('chan', "-> D $call $mess\n"); 
                        $conn->send_now("D$call|$mess");
@@ -94,6 +100,7 @@ sub rec
                        return;
                }
                
+               # the user MAY have an SSID if local, but otherwise doesn't
                my $user = DXUser->get($call);
                if (!defined $user) {
                        $user = DXUser->new($call);
@@ -129,9 +136,16 @@ sub cease
        foreach $dxchan (DXChannel->get_all()) {
                disconnect($dxchan);
        }
+       Log('cluster', "DXSpider V$version stopped");
        exit(0);
 }
 
+# the reaper of children
+sub reap
+{
+       my $cpid = wait;
+}
+
 # this is where the input queue is dealt with and things are dispatched off to other parts of
 # the cluster
 sub process_inqueue
@@ -148,8 +162,8 @@ sub process_inqueue
        
        # handle A records
        my $user = $dxchan->user;
-       if ($sort eq 'A') {
-               $dxchan->start($line);  
+       if ($sort eq 'A' || $sort eq 'O') {
+               $dxchan->start($line, $sort);  
        } elsif ($sort eq 'D') {
                die "\$user not defined for $call" if !defined $user;
                
@@ -164,18 +178,32 @@ sub process_inqueue
        }
 }
 
+sub uptime
+{
+       my $t = $systime - $starttime;
+       my $days = int $t / 86400;
+       $t -= $days * 86400;
+       my $hours = int $t / 3600;
+       $t -= $hours * 3600;
+       my $mins = int $t / 60;
+       return sprintf "%d %02d:%02d", $days, $hours, $mins;
+}
 #############################################################
 #
 # The start of the main line of code 
 #
 #############################################################
 
+$starttime = $systime = time;
+
 # open the debug file, set various FHs to be unbuffered
 foreach (@debug) {
        dbgadd($_);
 }
 STDOUT->autoflush(1);
 
+Log('cluster', "DXSpider V$version started");
+
 # banner
 print "DXSpider DX Cluster Version $version\nCopyright (c) 1998 Dirk Koopman G1TLH\n";
 
@@ -199,6 +227,7 @@ Msg->new_server("$clusteraddr", $clusterport, \&login);
 $SIG{'INT'} = \&cease;
 $SIG{'TERM'} = \&cease;
 $SIG{'HUP'} = 'IGNORE';
+$SIG{'CHLD'} = \&reap;
 
 # read in system messages
 DXM->init();
@@ -218,9 +247,10 @@ Spot->init();
 # put in a DXCluster node for us here so we can add users and take them away
 DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); 
 
-# read in any existing message headers
+# read in any existing message headers and clean out old crap
 print "reading existing message headers\n";
 DXMsg->init();
+DXMsg::clean_old();
 
 # read in any cron jobs
 print "reading cron jobs\n";
@@ -244,6 +274,9 @@ for (;;) {
                DXProt::process();              # process ongoing ak1a pcxx stuff
                DXConnect::process();
        }
+       if ($decease) {
+               last if --$decease <= 0;
+       }
 }