summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
d6f2077)
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.
+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=======================================================================
01Jun99=======================================================================
1. removed a output of an unwanted pc21 for isolated nodes
31May99=======================================================================
passwd => '9,Passwd List,parray',
);
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
{
# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
sub alloc
{
return " $DXNode::nodes nodes, $users local / $tot total users Max users $DXNode::maxusers Uptime $uptime";
}
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
{
no strict;
sub AUTOLOAD
{
+
+sub DESTROY
+{
+ my $self = shift;
+ undef $self->{list} if $self->{list};
+}
+
+
require Exporter;
@ISA = qw(Exporter);
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);
use strict;
use vars qw(%dbglevel $fp);
%dbglevel = ();
$fp = DXLog::new('debug', 'dat', 'd');
%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;
+ }
{
my $self = shift;
undef $self->{fh}; # close the filehandle
{
my $self = shift;
undef $self->{fh}; # close the filehandle
+ 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
}
# log something in the system log
keep => '0,Keep this?,yesno',
);
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
# allocate a new object
# called fromnode, tonode, from, to, datetime, private?, subject, nolinesper
sub alloc
return unless $node; # ignore if havn't seen a PC19 for this one yet
return unless $node->isa('DXNode');
if ($node->dxchan != $self) {
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 unless $node;
return unless $node->isa('DXNode');
if ($node->dxchan != $self) {
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]);
return;
}
my $ref = DXCluster->get_exact($field[1]);
if ($pcno == 19) { # incoming cluster list
my $i;
if ($pcno == 19) { # incoming cluster list
my $i;
for ($i = 1; $i < $#field-1; $i += 4) {
my $here = $field[$i];
my $call = uc $field[$i+1];
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);
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
# 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)
DXNode->new($self, $call, $confmode, $here, $ver);
# unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
# queue up any messages
DXMsg::queue_msg(0) if $self->state eq '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;
my $node = DXCluster->get_exact($call);
if ($node) {
if ($node->dxchan != $self) {
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");
my $hops = $DXProt::hopcount{$pcno};
$hops = $DXProt::def_hopcount if !$hops;
return "H$hops";
my $hops = $DXProt::hopcount{$pcno};
$hops = $DXProt::def_hopcount if !$hops;
return "H$hops";
$rfh = new IO::File;
$wfh = new IO::File;
$pid = open2($rfh, $wfh, "$line") or die "can't do $line $!";
$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 {
dbg('connect', "got pid $pid");
$wfh->autoflush(1);
} else {
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
@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
$starttime = 0; # the starting time of the cluster
$lockfn = "cluster.lock"; # lock file name
$starttime = $systime = time;
# open the debug file, set various FHs to be unbuffered
$starttime = $systime = time;
# open the debug file, set various FHs to be unbuffered
foreach (@debug) {
dbgadd($_);
}
foreach (@debug) {
dbgadd($_);
}