wip
[spider.git] / perl / DXProt.pm
index cbd0ff65a92480a839db78234bea83929e800903..fb09e99df8e0f32a27b7f0ebcbf1716a2d4fb55e 100644 (file)
@@ -304,53 +304,17 @@ sub sendinit
 sub removepc90
 {
        $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
-}
-
-sub removepc91
-{
        $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
 }
 
-sub send
-{
-       my $self = shift;
-       while (@_) {
-               my $line = shift;
-               if ($self->user->wantpc90) {
-                       $line = mungepc90($line);
-               } else {
-                       removepc91($line);
-                       removepc90($line);
-               }
-               $self->SUPER::send($line);
-       }
-}
-
-my $pc90msgid = 0;
-
-sub nextpc90
-{
-       $pc90msgid = 0 if $pc90msgid > 9999;
-       return $pc90msgid++;
-}
-
-sub mungepc90
-{
-       unless ($_[0] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC90^$main::mycall^$id^" . $_[0]; 
-       } 
-       return $_[0];
-}
-
-sub mungepc91
-{
-       unless ($_[1] =~ /^PC9\d/) {
-               my $id = nextpc90();
-               return "PC91^$main::mycall^$id^$_[0]^" . $_[1]; 
-       } 
-       return $_[1];
-}
+#sub send
+#{
+#      my $self = shift;
+#      while (@_) {
+#              my $line = shift;
+#              $self->SUPER::send($line);
+#      }
+#}
 
 #
 # This is the normal pcxx despatcher
@@ -358,6 +322,10 @@ sub mungepc91
 sub normal
 {
        my ($self, $line) = @_;
+
+       # remove any incoming PC90 frames
+       removepc90($line);
+
        my @field = split /\^/, $line;
        return unless @field;
        
@@ -380,68 +348,7 @@ 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;
-               }
-               $self->user->wantpc90(1) unless $self->user->wantpc90 || $origin ne $self->{call};
-               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;
-                       $origin = shift @field if $pcno == 91;
-
-                       ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-                       unless (defined $pcno && $pcno >= 10 && $pcno <= 89) {
-                               dbg("PCPROT: unknown protocol") if isdbg('chanerr');
-                               return;
-                       }
-                       
-                       # 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;
-                       }
-               }
-       } else {
-               if ($pcno == 16 || $pcno == 17 || $pcno == 19 || $pcno == 21) {
-                       $line = mungepc91($origin, $line);
-               } else {
-                       $line = mungepc90($line);
-               }
-       }
-
        no strict 'subs';
        my $sub = "handle_$pcno";
 
@@ -926,30 +833,32 @@ sub handle_17
        my $uref = Route::User::get($ucall);
        unless ($uref) {
                dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
-               return;
        }
        my $parent = Route::Node::get($ncall);
        unless ($parent) {
                dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
-               return;
        }                       
 
-       $dxchan = $parent->dxchan;
+       $dxchan = $parent->dxchan if $parent;
        if ($dxchan && $dxchan ne $self) {
                dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
                return;
        }
 
-       # input filter if required
-       return unless $self->in_filter_route($parent);
-                       
-       $parent->del_user($uref);
+       # input filter if required and then remove user if present
+       if ($parent) {
+#              return unless $self->in_filter_route($parent);  
+               $parent->del_user($uref) if $uref;
+       } else {
+               $parent = Route->new($ncall);  # throw away
+       }
 
        if (eph_dup($line)) {
                dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
                return;
        }
 
+       $uref = Route->new($ucall) unless $uref; # throw away
        $self->route_pc17($origin, $line, $parent, $uref);
 }
                
@@ -978,6 +887,7 @@ sub handle_18
                $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
                $self->user->version($self->version);
        }
+       $self->newroute( $_[1] =~ /NewRoute/ );
 
        # first clear out any nodes on this dxchannel
        my $parent = Route::Node::get($self->{call});
@@ -1005,6 +915,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");
@@ -1012,6 +924,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('A');
+                               $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];
@@ -1193,7 +1125,10 @@ sub handle_23
                }
        }
 
-       return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]);
+       # only do a rspf check on PC23 (not 27)
+       if ($pcno == 23) {
+               return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7])
+       }
 
        # do some de-duping
        my $d = cltounix($_[1], sprintf("%02d18Z", $_[2]));
@@ -1349,7 +1284,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
@@ -1549,7 +1490,7 @@ sub handle_51
                        }
                }
        } else {
-               if ($line !~ /^PC90/ && eph_dup($line)) {
+               if (eph_dup($line)) {
                        dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
                        return;
                }
@@ -1558,6 +1499,116 @@ sub handle_51
        }
 }
 
+# New style routing handler
+sub handle_59
+{
+       my $self = shift;
+       my $pcno = shift;
+       my $line = shift;
+       my $origin = shift;
+
+       return unless eph_dup($line);
+
+       my ($sort, $hextime, $ncall) = @_[1,2,3];
+       if ($ncall eq $main::mycall) {
+               dbg("PCPROT: ignoring PC59 for me") if isdbg('chan');
+               return;
+       }
+
+       # mark myself as NewRoute if I get a PC59
+       $self->{newroute} = 1 if $ncall eq $self->{call};
+
+       # do this once for filtering with a throwaway routing entry if a new node
+       my $fnode = Route::Node::get($ncall) || Route::new($ncall);
+       return unless $self->in_filter_route($fnode);
+
+       # now do it properly for actions
+       my $node = Route::Node::get($ncall) || Route::Node::new($ncall);
+
+       # find each of the entries (or create new ones)
+       my @refs;
+       for my $ent (@_[4..-1]) {
+               my ($esort, $ehere, $ecall) = unpack "A A A*", $ent;
+               my $ref;
+               
+               # create user, if required
+               my $user = DXUser->get_current($ecall);
+               unless ($user) {
+                       $user = DXUser->new($ecall);
+                       $user->sort();
+                       $user->priv(1);         # I have relented and defaulted nodes
+                       $user->lockout(1);
+                       $user->homenode($call);
+                       $user->node($call);
+               }
+               if ($esort eq 'U') {
+                       $ref = Route::User::get($ecall);
+                       unless ($ref) {
+                               # create user, if required
+                               my $user = DXUser->get_current($ecall);
+                               unless ($user) {
+                                       $user = DXUser->new($ecall);
+                                       $user->sort('U');
+                                       $user->homenode($ncall);
+                                       $user->node($ncall);
+                                       $user->put;
+                               }
+                               $ref = Route::User::new($ecall, 0); 
+                       }
+               } elsif ($esort eq 'N') {
+                       $ref = Route::Node::get($ecall);
+                       unless ($ref) {
+                               # create user, if required
+                               my $user = DXUser->get_current($ecall);
+                               unless ($user) {
+                                       $user = DXUser->new($ecall);
+                                       $user->priv(1);         # I have relented and defaulted nodes
+                                       $user->lockout(1);
+                                       $user->sort('A');
+                                       $user->homenode($ncall);
+                                       $user->node($ncall);
+                                       $user->put;
+                               }
+                               $ref = Route::Node::new($ecall, 0); 
+                       } 
+               } else {
+                       dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan');
+                       next;
+               }
+               $ref->here($here);              # might as well set this here
+               push @refs, $ref;
+       }
+
+       # if it is a delete or a configure, disconnect all the entries mentioned
+       # from this node (which is a parent in this context).
+       my @del;
+       if ($sort eq 'D' || $sort eq 'C') {
+               for my $ref (@refs) {
+                       next if $ref->call eq $ncall;
+                       if ($ref->isa('Route::Node')) {
+                               push @del, $ref->del($node);
+                       } elsif ($ref->isa('Route::User')) {
+                               push @del, $node->del_user($ref);
+                       }
+               }
+       }
+
+       # if it is an add or a configure, connect all the entries
+       my @add;
+       if ($sort eq 'A' || $sort eq 'C') {
+               for my $ref (@refs) {
+                       next if $ref->call eq $ncall;
+                       if ($ref->isa('Route::Node')) {
+                               my $new = $node->add($ref->call);
+                               push @add, $new if $new;
+                       } elsif ($ref->isa('Route::User')) {
+                               push @add, $node->add_user($ref->call);
+                       }
+               }
+       }
+}
+       
+
 # dunno but route it
 sub handle_75
 {
@@ -1766,20 +1817,8 @@ sub send_wwv_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
-       my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-       my @dxcc = Prefix::extract($_[6]);
-       if (@dxcc > 0) {
-               $wwv_dxcc = $dxcc[1]->dxcc;
-               $wwv_itu = $dxcc[1]->itu;
-               $wwv_cq = $dxcc[1]->cq;                                         
-       }
-       @dxcc = Prefix::extract($_[7]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-       }
-       
+       my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]);
+
        # 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
        foreach $dxchan (@dxchan) {
@@ -1788,7 +1827,7 @@ sub send_wwv_spot
                my $routeit;
                my ($filter, $hops);
 
-               $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, @dxcc);
        }
 }
 
@@ -1812,19 +1851,7 @@ sub send_wcy_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
-       my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-       my @dxcc = Prefix::extract($_[10]);
-       if (@dxcc > 0) {
-               $wcy_dxcc = $dxcc[1]->dxcc;
-               $wcy_itu = $dxcc[1]->itu;
-               $wcy_cq = $dxcc[1]->cq;                                         
-       }
-       @dxcc = Prefix::extract($_[11]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-       }
+       my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]);
        
        # 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
@@ -1832,7 +1859,7 @@ sub send_wcy_spot
                next if $dxchan == $main::me;
                next if $dxchan == $self;
 
-               $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc);
        }
 }
 
@@ -1876,28 +1903,13 @@ sub send_announce
 
 
        # obtain country codes etc 
-       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-       my ($ann_state, $org_state) = ("", "");
-       my @dxcc = Prefix::extract($_[0]);
-       if (@dxcc > 0) {
-               $ann_dxcc = $dxcc[1]->dxcc;
-               $ann_itu = $dxcc[1]->itu;
-               $ann_cq = $dxcc[1]->cq;                                         
-               $ann_state = $dxcc[1]->state;
-       }
-       @dxcc = Prefix::extract($_[4]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-               $org_state = $dxcc[1]->state;
-       }
-
+       my @a = Prefix::cty_data($_[0]);
+       my @b = Prefix::cty_data($_[4]);
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
-                                                                        $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+                                                                        @a[0..2],
+                                                                        @b[0..2], $a[3], $b[3]);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1916,7 +1928,8 @@ sub send_announce
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
-               $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call},
+                                                 @a[0..2], @b[0..2]);
        }
 }
 
@@ -1946,28 +1959,13 @@ sub send_chat
        }
        
        # obtain country codes etc 
-       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-       my ($ann_state, $org_state) = ("", "");
-       my @dxcc = Prefix::extract($_[0]);
-       if (@dxcc > 0) {
-               $ann_dxcc = $dxcc[1]->dxcc;
-               $ann_itu = $dxcc[1]->itu;
-               $ann_cq = $dxcc[1]->cq;                                         
-               $ann_state = $dxcc[1]->state;
-       }
-       @dxcc = Prefix::extract($_[4]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-               $org_state = $dxcc[1]->state;
-       }
-
+       my @a = Prefix::cty_data($_[0]);
+       my @b = Prefix::cty_data($_[4]);
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
-                                                                        $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+                                                                        @a[0..2],
+                                                                        @b[0..2], $a[3], $b[3]);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1997,7 +1995,8 @@ sub send_chat
                        }
                }
                
-               $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], 
+                                         $text, @_, $self->{call}, @a[0..2], @b[0..2]);
        }
 }
 
@@ -2033,31 +2032,27 @@ sub send_local_config
        my @remotenodes;
 
        dbg('DXProt::send_local_config') if isdbg('trace');
-       
-       # send our nodes
-       if ($self->{isolate}) {
-               @localnodes = ( $main::routeroot );
-               $self->send_route($main::mycall, \&pc19, 1, $main::routeroot, $main::routeroot);
+
+       if ($self->{newroute}) {
+               my @nodes = $self->{isolate} ? ($main::routeroot) : grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
+               my @users = DXChannel::get_all_users();
+               $self->send_route($main::mycall, \&pc59c, @nodes+@users+1, (grep { Route::get($_) } $main::routeroot, @nodes, @users));
        } 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;
-               $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
-
-               my $node;
-               if ($self->user->wantpc90) {
-                       for $node (@localnodes) {
-                               my @nodes = map {my $r = Route::Node::get($_); $r ? $r : ()} $node->nodes;
-                               $self->send_route($node->call, \&pc19, scalar(@nodes)+1, @nodes);
-                               for my $r (@nodes) {
-                                       push @remotenodes, $r unless grep $r eq $_, @remotenodes;
-                               }
-                       }
+               # 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;
+                       $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) {
@@ -2070,17 +2065,15 @@ sub send_local_config
                        }
                        $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
                }
-       }
-       
-
-       
-       # get all the users connected on the above nodes and send them out
-       foreach $node ($main::routeroot, @localnodes, @remotenodes) {
-               if ($node) {
-                       my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
-                       $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
-               } else {
-                       dbg("sent a null value") if isdbg('chanerr');
+               
+               # get all the users connected on the above nodes and send them out
+               foreach $node ($main::routeroot, @localnodes, @remotenodes) {
+                       if ($node) {
+                               my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
+                               $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+                       } else {
+                               dbg("sent a null value") if isdbg('chanerr');
+                       }
                }
        }
 }
@@ -2406,7 +2399,6 @@ sub send_route
                                next unless $routeit;
                        }
                        
-                       $routeit = mungepc91($origin, $routeit) if $self->user->wantpc90;
                        $self->send($routeit);
                }
        }
@@ -2428,11 +2420,7 @@ sub broadcast_route
                        next unless $dxchan->isa('DXProt');
                        next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
  
-                       if ($self->user->wantpc90 && $line) {
-                               $dxchan->send(mungepc91($origin, $line));
-                       } else {
-                               $dxchan->send_route($origin, $generate, @_);
-                       }
+                       $dxchan->send_route($origin, $generate, @_);
                }
        }
 }
@@ -2516,7 +2504,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;