From 770092d94f96b6d22a38fb33e0056b4779a8a1ab Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 28 Jan 2022 00:06:22 +0000 Subject: [PATCH] fixed duplicate spot, always make clean ending Try to make sure that the user file is always close regardless of what happens to cause the program to end/stop/crash. --- Changes | 2 ++ perl/DXChannel.pm | 26 +++++++++++++------------- perl/DXCommandmode.pm | 1 + perl/DXDupe.pm | 5 +++++ perl/DXLog.pm | 25 +++++++++++-------------- perl/DXProt.pm | 2 ++ perl/DXUser.pm | 11 ++++++++++- perl/QSL.pm | 5 +++++ perl/cluster.pl | 28 +++++++++++++++++++++------- 9 files changed, 70 insertions(+), 35 deletions(-) diff --git a/Changes b/Changes index 9c47b5ba..20462e08 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +28Jan22======================================================================= +1. Fixed duplicate spot display. 25Jan22======================================================================= 1. Fixed grepdbg so that it does what -help says it does. 2. Replaced all " characters with ' in Messages. For some reason things in " diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 9c294640..60b36331 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -137,17 +137,17 @@ $count = 0; $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection # object destruction -sub DESTROY -{ - my $self = shift; - for (keys %$self) { - if (ref($self->{$_})) { - delete $self->{$_}; - } - } - dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan'); - $count--; -} +# sub DESTROY +# { +# my $self = shift; +# for (keys %$self) { +# if (ref($self->{$_})) { +# delete $self->{$_}; +# } +# } +# dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan'); +# $count--; +# } # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] sub alloc @@ -257,7 +257,7 @@ sub get_all_node_calls my $ref; my @out; foreach $ref (values %channels) { - push @out, $ref->{call} if $ref->is_node; + push @out, $ref->{call} if $ref && $ref->is_node; } return @out; } @@ -268,7 +268,7 @@ sub get_all_users my $ref; my @out; foreach $ref (values %channels) { - push @out, $ref if $ref->is_user; + push @out, $ref if $ref && $ref->is_user; } return @out; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index cd15057d..e6432b85 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -100,6 +100,7 @@ sub start $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); + $self->send("Capabilities: ve7cc"); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; $self->{lang} = $user->lang || $main::lang || 'en'; diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index 5b288d1f..9198aee6 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -34,6 +34,11 @@ sub finish unlink $fn; } +sub active +{ + return $dbm; +} + sub check { my $s = shift; diff --git a/perl/DXLog.pm b/perl/DXLog.pm index ede817aa..db7dffdd 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -34,7 +34,7 @@ use DXVars; use DXUtil; use Julian; -use Carp; +use Carp qw(confess cluck); use strict; @@ -56,7 +56,8 @@ sub new # make sure the directory exists mkdir($ref->{prefix}, 0777) unless -e $ref->{prefix}; $logs{$ref} = $ref; - + $ref->{jdate} = $ref->unixtoj($main::systime); + return $ref; } @@ -148,10 +149,14 @@ sub unixtoj($$) sub write($$$) { my ($self, $jdate, $line) = @_; + cluck("Log::write \$jdate undefined") unless $jdate; +# cluck("Log::write \$self->jdate undefined") unless $self->{jdate}; if (!$self->{fh} || - $self->{mode} ne ">>" || - $jdate->year != $self->{jdate}->year || - $jdate->thing != $self->{jdate}->thing) { + $self->{mode} ne ">>" || + $jdate->year != + $self->{jdate}->year || + $jdate->thing + != $self->{jdate}->thing) { $self->open($jdate, ">>") or confess "can't open $self->{fn} $!"; } @@ -183,14 +188,6 @@ sub close delete $self->{fh}; } -sub DESTROY -{ - my $self = shift; - delete $logs{$self}; - undef $self->{fh}; # close the filehandle - delete $self->{fh} if $self->{fh}; -} - sub flushall { foreach my $l (values %logs) { @@ -204,7 +201,7 @@ sub flushall # The user is responsible for making sense of this! sub Log { - my $t = time; + my $t = $main::systime; $log->writeunix($t, join('^', $t, @_) ); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index b6e959e7..3c4b49f3 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -557,6 +557,8 @@ sub send_dx_spot foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; + next if $dxchan == $self; + if ($line =~ /PC61/ && !($dxchan->is_spider || $dxchan->is_user)) { unless ($pc11) { my @f = split /\^/, $line; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 911f35bc..51e6bb56 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -188,6 +188,11 @@ sub init $filename = $ufn; } +sub active +{ + return $dbm; +} + sub del_file { my ($pkg, $fn) = @_; @@ -214,6 +219,7 @@ sub process sub finish { + print "DXUser Finishing\n"; undef $dbm; untie %u; } @@ -873,7 +879,10 @@ __DATA__ } - +sub END +{ + finish() if $dbm; +} 1; __END__ diff --git a/perl/QSL.pm b/perl/QSL.pm index d8a75c7f..3d228d39 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -135,4 +135,9 @@ sub put $dbm->put($key, $value); } +sub active +{ + return $dbm; +} + 1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 466da708..cc96ac59 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -272,10 +272,16 @@ sub login } # cease running this program, close down all the connections nicely +our $is_ceasing; + sub cease { my $dxchan; + cluck("ceasing") if $is_ceasing; + + return if $is_ceasing++; + unless ($is_win) { $SIG{'TERM'} = 'IGNORE'; $SIG{'INT'} = 'IGNORE'; @@ -294,13 +300,14 @@ sub cease foreach $dxchan (DXChannel::get_all_nodes) { $dxchan->disconnect(2) unless $dxchan == $main::me; } - Msg->event_loop(100, 0.01); # disconnect users foreach $dxchan (DXChannel::get_all_users) { $dxchan->disconnect; } + Msg->event_loop(100, 0.01); + # disconnect AGW AGWMsg::finish(); BPQMsg::finish(); @@ -310,8 +317,9 @@ sub cease # end everything else Msg->event_loop(100, 0.01); - DXUser::finish(); DXDupe::finish(); + QSL::finish(); + DXUser::finish(); # close all databases DXDb::closeall; @@ -321,12 +329,12 @@ sub cease $l->close_server; } - LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended"); + $dbh->finish if $dbh; + + LogDbg("DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended"); dbgclose(); Logclose(); - $dbh->finish if $dbh; - unlink $lockfn; # $SIG{__WARN__} = $SIG{__DIE__} = sub {my $a = shift; cluck($a); }; exit(0); @@ -442,7 +450,8 @@ DXXml::init(); my ($year) = (gmtime)[5]; $year += 1900; LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started"); -dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); +LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH"); +LogDbg('cluster', "Capabilities: ve7cc rbn"); # load Prefixes dbg("loading prefixes ..."); @@ -646,7 +655,12 @@ for (;;) { last if --$decease <= 0; } } -cease(0); +cease(0) unless $is_ceasing; exit(0); +# +sub END +{ + cease(0) unless $is_ceasing; +} -- 2.43.0