remove PC90 completely
[spider.git] / perl / DXProt.pm
index 5028e2f93d049fad78f22f958364d7f62b347f7e..48fad54a02b48f5a35d23c0cfdf99f4a147be6f0 100644 (file)
@@ -304,36 +304,17 @@ sub sendinit
 sub removepc90
 {
        $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
+       $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
 }
 
-sub send
-{
-       my $self = shift;
-       my $line = shift;
-       if ($self->user->wantpc90) {
-               $line = mungepc90($line);
-       } else {
-               removepc90($line);
-       }
-       $self->SUPER::send($line);
-}
-
-my $pc90msgid = 0;
-
-sub nextpc90
-{
-       $pc90msgid = 0 if $pc90msgid > 9999;
-       return $pc90msgid++;
-}
-
-sub mungepc90
-{
-       unless ($_[0] =~ /^PC90/) {
-               my $id = nextpc90();
-               return "PC90^$main::mycall^$id^" . $_[0]; 
-       } 
-       return $_[0];
-}
+#sub send
+#{
+#      my $self = shift;
+#      while (@_) {
+#              my $line = shift;
+#              $self->SUPER::send($line);
+#      }
+#}
 
 #
 # This is the normal pcxx despatcher
@@ -341,6 +322,10 @@ sub mungepc90
 sub normal
 {
        my ($self, $line) = @_;
+
+       # remove any incoming PC90 frames
+       removepc90($line);
+
        my @field = split /\^/, $line;
        return unless @field;
        
@@ -351,8 +336,10 @@ sub normal
        
        # process PC frames, this will fail unless the frame starts PCnn
        my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-       return unless $pcno;
-       return if $pcno < 10 || $pcno > 99;
+       unless (defined $pcno && $pcno >= 10 && $pcno <= 99) {
+               dbg("PCPROT: unknown protocol") if isdbg('chanerr');
+               return;
+       }
 
        # check for and dump bad protocol messages
        my $n = check($pcno, @field);
@@ -361,72 +348,10 @@ sub normal
                return;
        }
 
-       # handle PC90 frames in a special way.
-    # 
-       # PC90 frames are normal frames that that are wrapped in inside a PC90 
-    # The extra fields are "originating node" and a sequence number.
-    # The sequence number is checked against the nodes 'last one' to see if
-       # it is a duplicate and, if so, is dropped at this stage; before any
-       # other processing.
-       #
-       # This is done here simply for efficiency. Adding another function would
-       # add more copying and so on.
-       #
-
-       my $origin = $self->call;
-       
-       if ($pcno >= 90) {
-               $origin = $field[1];
-               if ($origin eq $main::mycall) {
-                       dbg("PCPROT: loop dupe") if isdbg('chanerr');
-                       return;
-               }
-               my $seq = $field[2];
-               my $node = Route::Node::get($origin);
-               if ($node) {
-                       if (my $lid = $node->lid) {
-                               my $cmp = $seq >= $lid ? $seq : $seq + 9999;
-                               if ($cmp <= $lid) {
-                                       dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr');
-                                       return;
-                               }
-                       }
-                       $node->lid($seq);
-               }
-
-               # do a recheck on the contents of the PC90
-               if ($pcno == 90) {
-                       shift @field;
-                       shift @field;
-                       shift @field;
-                       
-                       ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-                       return unless $pcno;
-                       return if $pcno < 10 || $pcno > 99;
-                       
-                       # check for and dump bad protocol messages
-                       my $n = check($pcno, @field);
-                       if ($n) {
-                               dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
-                               return;
-                       }
-               }
-       }
-
-       # local processing 1
-       my $pcr;
-       eval {
-               $pcr = Local::pcprot($self, $pcno, @field);
-       };
-#      dbg("Local::pcprot error $@") if isdbg('local') if $@;
-       return if $pcr;
-
+       my $origin = $self->{call};
        no strict 'subs';
        my $sub = "handle_$pcno";
 
-       # add missing PC90 if not present (for ongoing distribution)
-       $line = mungepc90($line) if $pcno < 90;
-
        if ($self->can($sub)) {
                $self->$sub($pcno, $line, $origin, @field);
        } else {
@@ -809,7 +734,7 @@ sub handle_16
                                        $user->put;
                                                
                                        # route the pc19 - this will cause 'stuttering PC19s' for a while
-                                       $self->route_pc19(@nrout) if @nrout ;
+                                       $self->route_pc19($origin, $line, @nrout) if @nrout ;
                                        $parent = Route::Node::get($ncall);
                                        unless ($parent) {
                                                dbg("PCPROT: lost $ncall after sending PC19 for it?");
@@ -879,8 +804,7 @@ sub handle_16
                $user->lastin($main::systime) unless DXChannel->get($call);
                $user->put;
        }
-                       
-       $self->route_pc16($parent, @rout) if @rout;
+       $self->route_pc16($origin, $line, $parent, @rout) if @rout;
 }
                
 # remove a user
@@ -933,7 +857,7 @@ sub handle_17
                return;
        }
 
-       $self->route_pc17($parent, $uref);
+       $self->route_pc17($origin, $line, $parent, $uref);
 }
                
 # link request
@@ -965,7 +889,7 @@ sub handle_18
        # first clear out any nodes on this dxchannel
        my $parent = Route::Node::get($self->{call});
        my @rout = $parent->del_nodes;
-       $self->route_pc21(@rout, $parent) if @rout;
+       $self->route_pc21($origin, $line, @rout, $parent) if @rout;
        $self->send_local_config();
        $self->send(pc20());
 }
@@ -988,6 +912,8 @@ sub handle_19
 
        # new routing list
        my @rout;
+
+       # first get the INTERFACE node
        my $parent = Route::Node::get($self->{call});
        unless ($parent) {
                dbg("DXPROT: my parent $self->{call} has disappeared");
@@ -995,6 +921,26 @@ sub handle_19
                return;
        }
 
+       # if the origin isn't the same as the INTERFACE, then reparent, creating nodes as necessary
+       if ($origin ne $self->call) {
+               my $op = Route::Node::get($origin);
+               unless ($op) {
+                       $op = $parent->add($origin, 5000, Route::here(1));
+                       my $user = DXUser->get_current($origin);
+                       if (!$user) {
+                               $user = DXUser->new($origin);
+                               $user->sort('S');
+                               $user->priv(1);         # I have relented and defaulted nodes
+                               $user->lockout(1);
+                               $user->homenode($origin);
+                               $user->node($origin);
+                               $user->wantroutepc19(1);
+                       }
+                       $user->put;
+               }
+               $parent = $op;
+       }
+
        # parse the PC19
        for ($i = 1; $i < $#_-1; $i += 4) {
                my $here = $_[$i];
@@ -1076,7 +1022,7 @@ sub handle_19
        }
 
 
-       $self->route_pc19(@rout) if @rout;
+       $self->route_pc19($origin, $line, @rout) if @rout;
 }
                
 # send local configuration
@@ -1146,7 +1092,7 @@ sub handle_21
                }
        }
 
-       $self->route_pc21(@rout) if @rout;
+       $self->route_pc21($origin, $line, @rout) if @rout;
 }
                
 
@@ -1234,7 +1180,7 @@ sub handle_24
        my $ref = $nref || $uref;
        return unless $self->in_filter_route($ref);
 
-       $self->route_pc24($ref, $_[3]);
+       $self->route_pc24($origin, $line, $ref, $_[3]);
 }
                
 # merge request
@@ -1332,7 +1278,13 @@ sub handle_37
        my $pcno = shift;
        my $line = shift;
        my $origin = shift;
-       DXDb::process($self, $line);
+       if ($_[1] eq $main::mycall) {
+               no strict 'refs';
+               my $sub = "DXDb::handle_$pcno";
+               &$sub($self, @_);
+       } else {
+               $self->route($_[1], $line) unless $self->is_clx;
+       }
 }
 
 # node connected list from neighbour
@@ -1474,7 +1426,7 @@ sub handle_50
                # input filter if required
                return unless $self->in_filter_route($node);
 
-               $self->route_pc50($node, $_[2], $_[3]) unless eph_dup($line);
+               $self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line);
        }
 }
                
@@ -1773,7 +1725,6 @@ sub send_wwv_spot
 
                $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
        }
-       
 }
 
 sub wwv
@@ -2021,29 +1972,36 @@ sub send_local_config
        # send our nodes
        if ($self->{isolate}) {
                @localnodes = ( $main::routeroot );
+               $self->send_route($main::mycall, \&pc19, 1, $main::routeroot);
        } else {
                # create a list of all the nodes that are not connected to this connection
                # and are not themselves isolated, this to make sure that isolated nodes
         # don't appear outside of this node
+
+               # send locally connected nodes
                my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
                @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
-               my @intcalls = map { $_->nodes } @localnodes if @localnodes;
+               $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
+
+               my $node;
+               my @rawintcalls = map { $_->nodes } @localnodes if @localnodes;
+               my @intcalls;
+               for $node (@rawintcalls) {
+                       push @intcalls, $node unless grep $node eq $_, @intcalls; 
+               }
                my $ref = Route::Node::get($self->{call});
                my @rnodes = $ref->nodes;
-               for my $node (@intcalls) {
-                       push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes;
+               for $node (@intcalls) {
+                       push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
                }
-               unshift @localnodes, $main::routeroot;
+               $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
        }
        
-
-       $self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
-       
        # get all the users connected on the above nodes and send them out
-       foreach $node (@localnodes, @remotenodes) {
+       foreach $node ($main::routeroot, @localnodes, @remotenodes) {
                if ($node) {
                        my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
-                       $self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+                       $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
                } else {
                        dbg("sent a null value") if isdbg('chanerr');
                }
@@ -2299,7 +2257,7 @@ sub disconnect
        
        # broadcast to all other nodes that all the nodes connected to via me are gone
        unless ($pc39flag && $pc39flag == 2) {
-               $self->route_pc21(@rout) if @rout;
+               $self->route_pc21($main::mycall, undef, @rout) if @rout;
        }
 
        # remove outstanding pings
@@ -2331,9 +2289,11 @@ sub talk
 
 # send it if it isn't the except list and isn't isolated and still has a hop count
 # taking into account filtering and so on
+
 sub send_route
 {
        my $self = shift;
+       my $origin = shift;
        my $generate = shift;
        my $no = shift;     # the no of things to filter on 
        my $routeit;
@@ -2368,6 +2328,7 @@ sub send_route
                                $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
                                next unless $routeit;
                        }
+                       
                        $self->send($routeit);
                }
        }
@@ -2376,10 +2337,11 @@ sub send_route
 sub broadcast_route
 {
        my $self = shift;
+       my $origin = shift;
        my $generate = shift;
+       my $line = shift;
        my @dxchan = DXChannel::get_all_nodes();
        my $dxchan;
-       my $line;
        
        unless ($self->{isolate}) {
                foreach $dxchan (@dxchan) {
@@ -2388,7 +2350,7 @@ sub broadcast_route
                        next unless $dxchan->isa('DXProt');
                        next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
  
-                       $dxchan->send_route($generate, @_);
+                       $dxchan->send_route($origin, $generate, @_);
                }
        }
 }
@@ -2397,44 +2359,58 @@ sub route_pc16
 {
        my $self = shift;
        return unless $self->user->wantpc16;
-       broadcast_route($self, \&pc16, 1, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc16, $line, 1, @_);
 }
 
 sub route_pc17
 {
        my $self = shift;
        return unless $self->user->wantpc16;
-       broadcast_route($self, \&pc17, 1, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc17, $line, 1, @_);
 }
 
 sub route_pc19
 {
        my $self = shift;
-       broadcast_route($self, \&pc19, scalar @_, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc19, $line, scalar @_, @_);
 }
 
 sub route_pc21
 {
        my $self = shift;
-       broadcast_route($self, \&pc21, scalar @_, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc21, $line, scalar @_, @_);
 }
 
 sub route_pc24
 {
        my $self = shift;
-       broadcast_route($self, \&pc24, 1, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc24, $line, 1, @_);
 }
 
 sub route_pc41
 {
        my $self = shift;
-       broadcast_route($self, \&pc41, 1, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc41, $line, 1, @_);
 }
 
 sub route_pc50
 {
        my $self = shift;
-       broadcast_route($self, \&pc50, 1, @_);
+       my $origin = shift;
+       my $line = shift;
+       broadcast_route($self, $origin, \&pc50, $line, 1, @_);
 }
 
 sub in_filter_route
@@ -2458,7 +2434,6 @@ sub eph_dup
 
        # chop the end off
        $s =~ s/\^H\d\d?\^?\~?$//;
-       removepc90($s);
        $r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
        $eph{$s} = $main::systime + $t;
        return $r;