1. cluster seems to have a memory leak, put DESTROY functions in where
authordjk <djk>
Thu, 3 Jun 1999 19:47:49 +0000 (19:47 +0000)
committerdjk <djk>
Thu, 3 Jun 1999 19:47:49 +0000 (19:47 +0000)
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.

Changes
perl/DXChannel.pm
perl/DXCluster.pm
perl/DXDebug.pm
perl/DXLog.pm
perl/DXMsg.pm
perl/DXProt.pm
perl/client.pl
perl/cluster.pl

diff --git a/Changes b/Changes
index 3f1ccc506f2b640ccb7f87c7bc8284fd9a7a839c..a57bf25be5f95e0fd04c917c194e896cac87b61f 100644 (file)
--- 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=======================================================================
index 754cd5387127edab92d73b6ebec42a93199b5f05..6495e7a7edde6ed7e9ff32ac5630e755d9053816 100644 (file)
@@ -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
 {
index c0ec375a88f56eabc3fe39e2fce91417564ae0af..aee8fe4d94a0c6a0e1c192fb1d94d836b705edd1 100644 (file)
@@ -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__
index c44ba35920f5d049291a4021b78b845c1406a606..df3cb02741cef0d31b606a411358cfa4a3376de9 100644 (file)
@@ -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
index 8e2fc66febaa2021d06fa641bc8771cace0d9708..f089d73d0cecc28058bfd975eaf47df79d207ab5 100644 (file)
@@ -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 
index a43880a2987dc729d77bac8c29e199ce9d3ca82b..87129ea0ed1ce990391b2f182dbeffd6c545a93d 100644 (file)
@@ -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                  
index f4f56e7dff3e701f190daf5a3a97c605ce9b72b0..9519c004dee7f6f924ebcb6345fed3fb66ef368d 100644 (file)
@@ -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";       
index 8a19719ef54ec26333bc6f140d5af1fb3c11e1b2..fb86542f394dbfdf760d56acb1fe0402c5d0eceb 100755 (executable)
@@ -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 {
index 290838f40557838a3f772c19c7aaf029a9b2bb7b..5b43496e879e488e9a78e7dd5e37b3ed1fabd9e6 100755 (executable)
@@ -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($_);
 }