X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=0759db86587b1d13a6051af2d1becb5626d2ca77;hb=58bd2e8154553c7fa5ccfdcc2c53b85c7453abda;hp=e41951da26b4f932be9b8103bb52e75e21adcfcd;hpb=78cf2dcb9be8128af7f8dc5ae37540c9c53c6057;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e41951da..0759db86 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -527,6 +527,11 @@ sub normal if ($pcno == 16) { # add a user + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + # general checks my $dxchan; my $ncall = $field[1]; @@ -556,6 +561,8 @@ sub normal my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; next unless $call && $conf && defined $here && is_callsign($call); next if $call eq $main::mycall; + + eph_del_regex("^PC17\^$call\^$ncall"); $conf = $conf eq '*'; @@ -594,6 +601,13 @@ sub normal my $dxchan; my $ncall = $field[2]; my $ucall = $field[1]; + if (eph_dup($line)) { + dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); + return; + } + + eph_del_regex("^PC16.*$ncall.*$ucall"); + if ($ncall eq $main::mycall) { dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; @@ -633,6 +647,11 @@ sub normal my $i; my $newline = "PC19^"; + if (eph_dup($line)) { + dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); + return; + } + # new routing list my @rout; my $parent = Route::Node::get($self->{call}); @@ -649,6 +668,9 @@ sub normal my $conf = $field[$i+2]; my $ver = $field[$i+3]; next unless defined $here && defined $conf && is_callsign($call); + + eph_del_regex("^PC(?:21\^$call|17\^[^\^]+\^$call)"); + # check for sane parameters $ver = 5000 if $ver eq '0000'; next if $ver < 5000; # only works with version 5 software @@ -718,7 +740,15 @@ sub normal } if ($pcno == 21) { # delete a cluster from the list + if (eph_dup($line)) { + dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); + return; + } + my $call = uc $field[1]; + + eph_del_regex("^PC1[79].*$call"); + my @rout; my $parent = Route::Node::get($self->{call}); unless ($parent) { @@ -874,6 +904,7 @@ sub normal if ($pcno == 39) { # incoming disconnect if ($field[1] eq $self->{call}) { $self->disconnect(1); + eph_dup_regex("^PC(?:1[679]|21).*$field[1]"); } else { dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); } @@ -1145,7 +1176,7 @@ sub dx_spot ($filter, $hops) = $self->{spotsfilter}->it(@_); return unless $filter; } - send_prot_line($self, $filter, $hops, $isolate, $line) + send_prot_line($self, $filter, $hops, $isolate, $line); } sub send_prot_line @@ -1161,7 +1192,7 @@ sub send_prot_line return unless $routeit; } if ($filter) { - $self->send($routeit) if $routeit; + $self->send($routeit); } else { $self->send($routeit) unless $self->{isolate} || $isolate; } @@ -1605,10 +1636,7 @@ sub process_rcmd_reply my $s = $rcmds{$fromnode}; if ($s) { my $dxchan = DXChannel->get($s->{call}); - my $ref = DXChannel->get($user) || $dxchan; - if ($ref->{call} eq $main::mycall) { - $ref = DXChannel->get($main::myalias) || $ref; - } + my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan); $ref->send($line) if $ref; delete $rcmds{$fromnode} if !$dxchan; } else { @@ -1757,7 +1785,7 @@ sub send_route $routeit = adjust_hops($self, $line); # adjust its hop count by node name next unless $routeit; } - $self->send($routeit) if $self->{routefilter} || !$self->{isolate}; + $self->send($routeit); } } } @@ -1773,10 +1801,10 @@ sub broadcast_route foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan == $me; - if ($dxchan->{routefilter} || !$self->{isolate}) { - $dxchan->send_route($generate, @_) + if ($dxchan->{routefilter}) { + $dxchan->send_route($generate, @_); } else { - dbg('DXPROT: isolated') if isdbg('chanerr'); + $dxchan->send_route($generate, @_) unless $self->{isolate} || $dxchan->{isolate}; } } } @@ -1847,6 +1875,17 @@ sub eph_dup return undef; } +sub eph_del_regex +{ + my $regex = shift; + my ($key, $val); + while (($key, $val) = each %eph) { + if ($key =~ m{$regex}) { + delete $eph{$key}; + } + } +} + sub eph_clean { my ($key, $val);