From: djk Date: Tue, 19 Jan 1999 00:36:20 +0000 (+0000) Subject: 8. incoming messages for users will now send a 'new message' message (instead X-Git-Tag: R_1_23~3 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3fd9341b7ce57dcc058b82cfba3f40f15631241;p=spider.git 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 7255322d..7754e3b8 100644 --- 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 91c43a78..a741e5f2 100644 --- 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 507a6a12..94c1cad0 100644 --- 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 e19f309c..64ed8439 100644 --- 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 0cc71413..b0d21db3 100644 --- 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 8502cbab..5e4dd4d9 100755 --- 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 = ; + 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";