From: djk <djk>
Date: Thu, 3 Jun 1999 19:47:49 +0000 (+0000)
Subject: 1. cluster seems to have a memory leak, put DESTROY functions in where
X-Git-Tag: R_1_30~23
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=3eb9538d135d9ff21d8ce7c0e0c6b3e6d7fb59a9;p=spider.git

1. cluster seems to have a memory leak, put DESTROY functions in where
appropriate.
2. try to make sure that PC21 commands are not issued inappropriately and
also reformat PC19 for onward broadcast so that nodes coming in on loops are
dropped from those broadcasts.
3. make sure PC16,17,19,21 doen't affect locally connected nodes.
---

diff --git a/Changes b/Changes
index 3f1ccc50..a57bf25b 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,10 @@
+03Jun99=======================================================================
+1. cluster seems to have a memory leak, put DESTROY functions in where 
+appropriate.
+2. try to make sure that PC21 commands are not issued inappropriately and
+also reformat PC19 for onward broadcast so that nodes coming in on loops are
+dropped from those broadcasts.
+3. make sure PC16,17,19,21 doen't affect locally connected nodes.
 01Jun99=======================================================================
 1. removed a output of an unwanted pc21 for isolated nodes
 31May99=======================================================================
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 754cd538..6495e7a7 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -76,6 +76,22 @@ use vars qw(%channels %valid);
 		  passwd => '9,Passwd List,parray',
 		 );
 
+# object destruction
+sub DESTROY
+{
+	my $self = shift;
+	undef $self->{user};
+	undef $self->{conn};
+	undef $self->{loc};
+	undef $self->{pagedata};
+	undef $self->{group};
+	undef $self->{delayed};
+	undef $self->{annfilter};
+	undef $self->{wwvfilter};
+	undef $self->{spotfilter};
+	undef $self->{passwd};
+}
+
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
 sub alloc
 {
diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index c0ec375a..aee8fe4d 100644
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -136,12 +136,6 @@ sub cluster
 	return " $DXNode::nodes nodes, $users local / $tot total users  Max users $DXNode::maxusers  Uptime $uptime";
 }
 
-#sub DESTROY
-#{
-#	my $self = shift;
-#	dbg('cluster', "destroying $self->{call}\n");
-#}
-
 no strict;
 sub AUTOLOAD
 {
@@ -303,5 +297,13 @@ sub dolist
 {
 
 }
+
+sub DESTROY
+{
+	my $self = shift;
+	undef $self->{list} if $self->{list};
+}
+
+
 1;
 __END__
diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index c44ba359..df3cb027 100644
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -11,8 +11,8 @@ package DXDebug;
 
 require Exporter;
 @ISA = qw(Exporter);
-@EXPORT = qw(dbg dbgadd dbgsub dbglist isdbg dbgclose);
-@EXPORT_OK = qw(dbg dbgadd dbgsub dbglist isdbg dbgclose);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
+@EXPORT_OK = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
 
 use strict;
 use vars qw(%dbglevel $fp);
@@ -25,15 +25,21 @@ 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 _store
+{
+	my $t = time; 
+	for (@_) {
+		$fp->writeunix($t, "$t^$_"); 
+		print STDERR $_;
+	}
+}
+
+sub dbginit
+{
+	# add sig{__DIE__} handling
+	if (!defined $DB::VERSION) {
+		$SIG{__WARN__} = $SIG{__DIE__} = \&_store;
+	}
 }
 
 sub dbgclose
diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index 8e2fc66f..f089d73d 100644
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -161,7 +161,14 @@ sub close
 {
 	my $self = shift;
 	undef $self->{fh};			# close the filehandle
-	delete $self->{fh};
+	delete $self->{fh};	
+}
+
+sub DESTROY
+{
+	my $self = shift;
+	undef $self->{fh};			# close the filehandle
+	delete $self->{fh} if $self->{fh};
 }
 
 # log something in the system log 
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index a43880a2..87129ea0 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -67,6 +67,13 @@ $forwardfn = "$msgdir/forward.pl";  # the forwarding table
 		  keep => '0,Keep this?,yesno',
 		 );
 
+sub DESTROY
+{
+	my $self = shift;
+	undef $self->{lines};
+	undef $self->{gotit};
+}
+
 # allocate a new object
 # called fromnode, tonode, from, to, datetime, private?, subject, nolinesper  
 sub alloc                  
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index f4f56e7d..9519c004 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -316,7 +316,11 @@ sub normal
 			return unless $node; # ignore if havn't seen a PC19 for this one yet
 			return unless $node->isa('DXNode');
 			if ($node->dxchan != $self) {
-				dbg('chan', "LOOP: come in on wrong channel");
+				dbg('chan', "LOOP: $field[1] came in on wrong channel");
+				return;
+			}
+			if (DXChannel->get($field[1])) {
+				dbg('chan', "LOOP: $field[1] connected locally");
 				return;
 			}
 			my $i;
@@ -352,7 +356,11 @@ sub normal
 			return unless $node;
 			return unless $node->isa('DXNode');
 			if ($node->dxchan != $self) {
-				dbg('chan', "LOOP: come in on wrong channel");
+				dbg('chan', "LOOP: $field[2] came in on wrong channel");
+				return;
+			}
+			if (DXChannel->get($field[2])) {
+				dbg('chan', "LOOP: $field[2] connected locally");
 				return;
 			}
 			my $ref = DXCluster->get_exact($field[1]);
@@ -369,23 +377,33 @@ sub normal
 		
 		if ($pcno == 19) {		# incoming cluster list
 			my $i;
+			my $newline = "PC19^";
 			for ($i = 1; $i < $#field-1; $i += 4) {
 				my $here = $field[$i];
 				my $call = uc $field[$i+1];
-				my $confmode = $field[$i+2] eq '*';
+				my $confmode = $field[$i+2];
 				my $ver = $field[$i+3];
 				
 				# now check the call over
 				my $node = DXCluster->get_exact($call);
-				if ($node && $node->dxchan != $self) {
-					dbg('chan', "LOOP: come in on wrong channel");
-					return;
+				if ($node) {
+					if (DXChannel->get($call)) {
+						dbg('chan', "LOOP: $call connected locally");
+					}
+				    if ($node->dxchan != $self) {
+						dbg('chan', "LOOP: $call come in on wrong channel");
+						next;
+					}
+					dbg('chan', "already have $call");
+					next;
 				}
-				next if $node; # we already have this
 				
 				# check for sane parameters
 				next if $ver < 5000; # only works with version 5 software
 				next if length $call < 3; # min 3 letter callsigns
+
+				# add it to the nodes table and outgoing line
+				$newline .= "$here^$call^$confmode^$ver^";
 				DXNode->new($self, $call, $confmode, $here, $ver);
 				
 				# unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
@@ -408,6 +426,11 @@ sub normal
 			
 			# queue up any messages
 			DXMsg::queue_msg(0) if $self->state eq 'normal';
+			return if $newline eq "PC19^";
+
+			# add hop count 
+			$newline .=  get_hops(19) . "^";
+			$line = $newline;
 			last SWITCH;
 		}
 		
@@ -428,7 +451,11 @@ sub normal
 				my $node = DXCluster->get_exact($call);
 				if ($node) {
 					if ($node->dxchan != $self) {
-						dbg('chan', "LOOP: come in on wrong channel");
+						dbg('chan', "LOOP: $call come in on wrong channel");
+						return;
+					}
+					if (DXChannel->get($call)) {
+						dbg('chan', "LOOP: $call connected locally");
 						return;
 					}
 					$node->del();
@@ -979,7 +1006,7 @@ sub get_all_user_calls
 
 sub get_hops
 {
-	my ($pcno) = @_;
+	my $pcno = shift;
 	my $hops = $DXProt::hopcount{$pcno};
 	$hops = $DXProt::def_hopcount if !$hops;
 	return "H$hops";       
diff --git a/perl/client.pl b/perl/client.pl
index 8a19719e..fb86542f 100755
--- a/perl/client.pl
+++ b/perl/client.pl
@@ -225,6 +225,8 @@ sub doconnect
 		$rfh = new IO::File;
 		$wfh = new IO::File;
 		$pid = open2($rfh, $wfh, "$line") or die "can't do $line $!";
+		die "no receive channel $!" unless $rfh;
+		die "no transmit channel $!" unless $wfh;
 		dbg('connect', "got pid $pid");
 		$wfh->autoflush(1);
 	} else {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 290838f4..5b43496e 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -67,7 +67,7 @@ package main;
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = "1.29";				# the version no of the software
+$version = "1.30";				# the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 $lockfn = "cluster.lock";       # lock file name
       
@@ -270,6 +270,7 @@ sub uptime
 $starttime = $systime = time;
 
 # open the debug file, set various FHs to be unbuffered
+dbginit();
 foreach (@debug) {
 	dbgadd($_);
 }