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
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
{
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";
}
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;
}
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
$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;
}
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 {
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 {
%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;
eval {
$pcr = Local::pcprot($self, $pcno, @field);
};
- dbg('local', "Local::pcprot error $@") if $@;
+# dbg('local', "Local::pcprot error $@") if $@;
return if $pcr;
SWITCH: {
# 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
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!
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;
}
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;
use Geomag;
use CmdAlias;
use Local;
+use Fcntl ':flock';
use Carp;
$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
{
disconnect($dxchan) unless $dxchan == $DXProt::me;
}
Log('cluster', "DXSpider V$version stopped");
+ unlink $lockfn;
exit(0);
}
};
dbg('local', "Local::init error $@") if $@;
-
-
# print various flags
#print "useful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P\n";
projects / spider.git / commitdiff