8. incoming messages for users will now send a 'new message' message (instead

of merely generating the message)[who wrote this rubbish?].
9. Hooked $SIG{__WARN__} and $SIG{__DIE__} so we store these nasty error
messages.
10. Print the no of users on restricted protocol links if we have had PC50
11. Had a go at making the sh/cl stats more accurate.
12. PC11 was trying to call Local::spot1 instead of Local::spot, no warning
previously.
13. Added a simple lockfile to prevent more than one cluster running at a time

diff --git a/Changes b/Changes
index 7255322d9af968c5961534fcabcc2a3a05725b8c..7754e3b875a3a71b8d610b552be3f7498633934a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -14,6 +14,15 @@ the -M semantics are rather strange!
 if connected).
 7. Added present_on(call, node) and presentish_on(ditto) which returns true if 
 the call is connected to the node.
+8. incoming messages for users will now send a 'new message' message (instead
+of merely generating the message)[who wrote this rubbish?].
+9. Hooked $SIG{__WARN__} and $SIG{__DIE__} so we store these nasty error 
+messages.
+10. Print the no of users on restricted protocol links if we have had PC50
+11. Had a go at making the sh/cl stats more accurate.
+12. PC11 was trying to call Local::spot1 instead of Local::spot, no warning 
+previously.
+13. Added a simple lockfile to prevent more than one cluster running at a time
 17Jan99========================================================================
 1. fixed some permission problems on DXLog.
 2. There is a circumstance in DXMsg which caused the cluster to stop on an 

diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index 91c43a7880a8944d7fdbb0754bc7d8c1e58d0b35..a741e5f2c4805742d6d18b1be780f09fc4b99aad 100644 (file)
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -131,7 +131,7 @@ sub cluster
 {
        my $users = DXCommandmode::get_all();
        my $uptime = main::uptime();
-       my $tot = $DXNode::users + 1;
+       my $tot = $DXNode::users;
                
        return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
 }
@@ -175,9 +175,8 @@ sub new
   
        my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
        $self->{mynode} = $node;
-       $node->{list}->{$call} = $self; # add this user to the list on this node
+       $node->add_user($call, $self);
        dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
-       $node->update_users();
        return $self;
 }
 
@@ -187,10 +186,8 @@ sub del
        my $call = $self->{call};
        my $node = $self->{mynode};
 
-       delete $node->{list}->{$call};
-       delete $DXCluster::cluster{$call}; # remove me from the cluster table
+       $node->del_user($call);
        dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
-       $node->update_users();
 }
 
 sub count
@@ -257,19 +254,40 @@ sub del
        $nodes-- if $nodes > 0;
 }
 
+sub add_user
+{
+       my $self = shift;
+       my $call = shift;
+       my $ref = shift;
+       
+       $self->{list}->{$call} = $ref; # add this user to the list on this node
+       $self->{users} = keys %{$self->{list}};
+       $users++;
+       $maxusers = $users+$nodes if $users+$nodes > $maxusers;
+}
+
+sub del_user
+{
+       my $self = shift;
+       my $call = shift;
+
+       delete $self->{list}->{$call};
+       delete $DXCluster::cluster{$call}; # remove me from the cluster table
+       $self->{users} = keys %{$self->{list}};
+       $users--;
+       $users = 0, warn "\$users gone neg, reset" if $users < 0;
+       $maxusers = $users+$nodes if $users+$nodes > $maxusers;
+}
+
 sub update_users
 {
        my $self = shift;
        my $count = shift;
        $count = 0 unless $count;
-  
-       $users -= $self->{users} if $self->{users};
-       if ((keys %{$self->{list}})) {
-               $self->{users} = (keys %{$self->{list}});
-       } else {
-               $self->{users} = $count;
-       }
-       $users += $self->{users} if $self->{users};
+       
+       $users -= $self->{users};
+       $self->{users} = $count unless keys %{$self->{list}};
+       $users += $self->{users};
        $maxusers = $users+$nodes if $users+$nodes > $maxusers;
 }
 

diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index 507a6a12a81053d9de0e6f136da6381beb73cce6..94c1cad0450573d6399a08fdc5ab3c4c9c57515b 100644 (file)
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -247,8 +247,7 @@ sub start_connect
                        alarm(0);
                        DXChannel::closeall();
                        $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
-                       exec $prog, $call, 'connect';
-                       dbg('cron', "exec '$prog' failed $!");
+                       exec $prog, $call, 'connect' or dbg('cron', "exec '$prog' failed $!");
                }
                dbg('cron', "connect to $call started");
        } else {
@@ -274,8 +273,7 @@ sub spawn
                        alarm(0);
                        DXChannel::closeall();
                        $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
-                       exec "$line";
-                       dbg('cron', "exec '$line' failed $!");
+                       exec "$line" or dbg('cron', "exec '$line' failed $!");
                }
                dbg('cron', "spawn of $line started");
        } else {

diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index e19f309ca76cddb7285ed6b2aefa8aa7e2bfe1a7..64ed843944d7d478c4466f541933e75bca0af418 100644 (file)
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -25,6 +25,17 @@ use Carp;
 %dbglevel = ();
 $fp = DXLog::new('debug', 'dat', 'd');
 
+# add sig{__DIE__} handling
+if (!defined $DB::VERSION) {
+       $SIG{__WARN__} = $SIG{__DIE__} = sub { 
+               my $t = time; 
+               for (@_) {
+                       $fp->writeunix($t, "$t^$_"); 
+#                      print STDERR $_;
+               }
+       };
+}
+
 sub dbg
 {
        my $l = shift;

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 0cc714135317ff1119a0dc786a326b2b81c8c23f..b0d21db377ee62d8d7c847cfbc1dd4d1b4c0debc 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -138,7 +138,7 @@ sub normal
        eval {
                $pcr = Local::pcprot($self, $pcno, @field);
        };
-       dbg('local', "Local::pcprot error $@") if $@;
+#      dbg('local', "Local::pcprot error $@") if $@;
        return if $pcr;
        
  SWITCH: {
@@ -195,9 +195,9 @@ sub normal
                        # local processing 
                        my $r;
                        eval {
-                               $r = Local::spot1($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
+                               $r = Local::spot($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
                        };
-                       dbg('local', "Local::spot1 error $@") if $@;
+#                      dbg('local', "Local::spot1 error $@") if $@;
                        return if $r;
 
                        # send orf to the users
@@ -396,9 +396,9 @@ sub normal
 
                        my $r;
                        eval {
-                               $r = Local::wwv2($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+                               $r = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
                        };
-                       dbg('local', "Local::wwv2 error $@") if $@;
+#                      dbg('local', "Local::wwv2 error $@") if $@;
                        return if $r;
 
                        # DON'T be silly and send on PC27s!
@@ -545,7 +545,7 @@ sub normal
                
                if ($pcno == 50) {              # keep alive/user list
                        my $ref = DXCluster->get_exact($field[1]);
-                       $ref->update_users($field[2]) if $ref;
+                       $ref->update_users($field[2]) if $ref;                  
                        last SWITCH;
                }
                

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 8502cbaba6b3d44bc4bd8935a566fd6c042d8ce4..5e4dd4d9efcc92880361e07a55bba4298c78a249 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -20,6 +20,20 @@ BEGIN {
        
        unshift @INC, "$root/perl";     # this IS the right way round!
        unshift @INC, "$root/local";
+
+       # try to create and lock a lockfile (this isn't atomic but 
+       # should do for now
+       $lockfn = "$root/perl/cluster.lock";       # lock file name
+       if (-e $lockfn) {
+               open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
+               my $pid = <CLLOCK>;
+               chomp $pid;
+               die "Lockfile ($lockfn) and process $pid exist, another cluster running?" if kill 0, $pid;
+               close CLLOCK;
+       }
+       open(CLLOCK, ">$lockfn") or die "Can't open Lockfile ($lockfn) $!";
+       print CLLOCK "$$\n";
+       close CLLOCK;
 }
 
 use Msg;
@@ -42,6 +56,7 @@ use Bands;
 use Geomag;
 use CmdAlias;
 use Local;
+use Fcntl ':flock'; 
 
 use Carp;
 
@@ -51,7 +66,8 @@ package main;
 $systime = 0;                                  # the time now (in seconds)
 $version = "1.23";                             # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
- 
+$lockfn = "cluster.lock";       # lock file name
+      
 # handle disconnections
 sub disconnect
 {
@@ -150,6 +166,7 @@ sub cease
                disconnect($dxchan) unless $dxchan == $DXProt::me;
        }
        Log('cluster', "DXSpider V$version stopped");
+       unlink $lockfn;
        exit(0);
 }
 
@@ -281,8 +298,6 @@ eval {
 };
 dbg('local', "Local::init error $@") if $@;
 
-
-
 # print various flags
 #print "useful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P\n";