From: Dirk Koopman <djk@tobit.co.uk>
Date: Fri, 28 Jan 2022 00:06:22 +0000 (+0000)
Subject: fixed duplicate spot, always make clean ending
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=770092d94f96b6d22a38fb33e0056b4779a8a1ab;p=spider.git

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.
---

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;
+}