attempt to dup check pc16/17/19/21

diff --git a/Changes b/Changes
index 20d4649e6c88598f786a2eaea228bf60e2ed2fcf..2e5c2d67eb6d423e5e96517a010b3a4420e345fc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 19Aug01=======================================================================
 1. Fix rcmds
 2. make isolation when there are no filters present work again?
+3. dup check PC16/17/19/21 !
 17Aug01=======================================================================
 1. Sort out PC41 handling to include type 5 records for QRA locators and also
 remove all filtering (but retain ephemeral dup checking).

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 2e43068a6951c7f42517c98a5170b57bd76fba68..72bce7c0ed45aef5394641a510e32bfbf337461e 100644 (file)
--- 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("^PC21\^$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("^PC19.*$call");
+                       
                        my @rout;
                        my $parent = Route::Node::get($self->{call});
                        unless ($parent) {
@@ -1844,6 +1874,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);