check for lower case letters in spotted calls
[spider.git] / perl / DXProt.pm
index 5028e2f93d049fad78f22f958364d7f62b347f7e..5c6ca1fb928abd18426cce68525fedbcb3e20cf6 100644 (file)
@@ -27,12 +27,14 @@ use DXDb;
 use AnnTalk;
 use Geomag;
 use WCY;
-use Time::HiRes qw(gettimeofday tv_interval);
 use BadWords;
 use DXHash;
 use Route;
 use Route::Node;
 use Script;
+use Investigate;
+use RouteDB;
+
 
 use strict;
 
@@ -44,15 +46,16 @@ $main::branch += $BRANCH;
 
 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
                        $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
-                       $pingint $obscount %pc19list $chatdupeage
+                       $pingint $obscount %pc19list $chatdupeage $chatimportfn
+                       $investigation_int $pc19_version $myprot_version
                        %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
-                       $allowzero $decode_dk0wcy $send_opernam @checklist);
+                       $allowzero $decode_dk0wcy $send_opernam @checklist
+                       $handle_xml);
 
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc23
 
 $last_hour = time;                             # last time I did an hourly periodic update
-%pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
 %nodehops = ();                 # node specific hop control
 %pc19list = ();                                        # list of outstanding PC19s that haven't had PC16s on them
@@ -71,6 +74,10 @@ $eph_pc34_restime = 30;
 $pingint = 5*60;
 $obscount = 2;
 $chatdupeage = 20 * 60 * 60;
+$chatimportfn = "$main::root/chat_import";
+$investigation_int = 12*60*60; # time between checks to see if we can see this node
+$pc19_version = 5466;                  # the visible version no for outgoing PC19s generated from pc59
+$handle_xml = 0;                               # handle XML sentences
 
 @checklist = 
 (
@@ -199,6 +206,21 @@ sub init
 {
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
+
+       my $user = DXUser->get($main::mycall);
+       die "User $main::mycall not setup or disappeared RTFM" unless $user;
+       
+       $myprot_version += $main::version*100;
+       $main::me = DXProt->new($main::mycall, 0, $user); 
+       $main::me->{here} = 1;
+       $main::me->{state} = "indifferent";
+       $main::me->{sort} = 'S';    # S for spider
+       $main::me->{priv} = 9;
+       $main::me->{metric} = 0;
+       $main::me->{pingave} = 0;
+       $main::me->{registered} = 1;
+       $main::me->{version} = $main::version;
+       $main::me->{build} = $main::build;
 }
 
 #
@@ -227,7 +249,10 @@ sub start
        my $user = $self->{user};
 
        # log it
-       my $host = $self->{conn}->{peerhost} || "unknown";
+       my $host = $self->{conn}->{peerhost};
+       $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
+       $host ||= "unknown";
+
        Log('DXProt', "$call connected from $host");
        
        # remember type of connection
@@ -274,7 +299,7 @@ sub start
        $self->{pingave} = 999;
        $self->{metric} ||= 100;
        $self->{lastping} = $main::systime;
-
+       
        # send initialisation string
        unless ($self->{outbound}) {
                $self->sendinit;
@@ -301,46 +326,18 @@ sub sendinit
        $self->send(pc18());
 }
 
-sub removepc90
-{
-       $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
-}
-
-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];
-}
-
 #
 # This is the normal pcxx despatcher
 #
 sub normal
 {
        my ($self, $line) = @_;
+
+       if ($line =~ '^<\w+\s') {
+               DXXml::normal($self, $line);
+               return;
+       }
+
        my @field = split /\^/, $line;
        return unless @field;
        
@@ -351,8 +348,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 +360,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 {
@@ -486,9 +423,13 @@ sub handle_10
                }
        }
 
+       # remember a route to this node and also the node on which this user is
+       RouteDB::update($_[6], $self->{call});
+#      RouteDB::update($to, $_[6]);
+
        # it is here and logged on
-       $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
-       $dxchan = DXChannel->get($to) unless $dxchan;
+       $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall;
+       $dxchan = DXChannel::get($to) unless $dxchan;
        if ($dxchan && $dxchan->is_user) {
                $_[3] =~ s/\%5E/^/g;
                $dxchan->talk($from, $to, $via, $_[3]);
@@ -506,6 +447,8 @@ sub handle_10
                return;
        }
 
+       # can we see an interface to send it down?
+       
        # not visible here, send a message of condolence
        $vref = undef;
        $ref = Route::get($from);
@@ -534,6 +477,18 @@ sub handle_11
                        
        # rsfp check
        #                       return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]);
+       
+       # is the spotted callsign blank? This should really be trapped earlier but it
+       # could break other protocol sentences. Also check for lower case characters.
+       if ($_[2] =~ /^\s*$/) {
+               dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr');
+               return;
+       }
+       if ($_[2] =~ /[a-z]/) {
+               dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr');
+               return;
+       }
+
 
        # if this is a 'nodx' node then ignore it
        if ($badnode->in($_[7])) {
@@ -578,8 +533,11 @@ sub handle_11
                }
        }
 
-
-       my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]);
+       # remember a route
+#      RouteDB::update($_[7], $self->{call});
+#      RouteDB::update($_[6], $_[7]);
+       
+       my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]);
        # global spot filtering on INPUT
        if ($self->{inspotsfilter}) {
                my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
@@ -592,7 +550,7 @@ sub handle_11
        # this goes after the input filtering, but before the add
        # so that if it is input filtered, it isn't added to the dup
        # list. This allows it to come in from a "legitimate" source
-       if (Spot::dup($_[1], $_[2], $d, $_[5], $_[6])) {
+       if (Spot::dup(@spot[0..4,5])) {
                dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
                return;
        }
@@ -704,12 +662,17 @@ sub handle_12
                return;
        }
 
+
        my $dxchan;
        
-       if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
+       if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
                $self->send_chat($line, @_[1..6]);
        } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
+               # remember a route
+#              RouteDB::update($_[5], $self->{call});
+#              RouteDB::update($_[1], $_[5]);
+
                # ignore something that looks like a chat line coming in with sysop
                # flag - this is a kludge...
                if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') {
@@ -746,17 +709,12 @@ sub handle_16
        my $line = shift;
        my $origin = shift;
 
-       if (eph_dup($line)) {
-               dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
-               return;
-       }
-
        # general checks
        my $dxchan;
        my $ncall = $_[1];
        my $newline = "PC16^";
                        
-       # do I want users from this channel?
+       # dos I want users from this channel?
        unless ($self->user->wantpc16) {
                dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
                return;
@@ -766,6 +724,24 @@ sub handle_16
                dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
                return;
        }
+
+       RouteDB::update($ncall, $self->{call});
+
+       # do we believe this call? 
+       unless ($ncall eq $self->{call} || $self->is_believed($ncall)) {
+               if (my $ivp = Investigate::get($ncall, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
+       if (eph_dup($line)) {
+               dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
+               return;
+       }
+
        my $parent = Route::Node::get($ncall); 
 
        # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, 
@@ -805,11 +781,11 @@ sub handle_16
                                                }
                                        }
                                        $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route 
-                                       $user->lastin($main::systime) unless DXChannel->get($ncall);
+                                       $user->lastin($main::systime) unless DXChannel::get($ncall);
                                        $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?");
@@ -876,11 +852,10 @@ sub handle_16
                $user = DXUser->new($call) if !$user;
                $user->homenode($parent->call) if !$user->homenode;
                $user->node($parent->call);
-               $user->lastin($main::systime) unless DXChannel->get($call);
+               $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
@@ -906,34 +881,48 @@ sub handle_17
                return;
        }
 
+       RouteDB::delete($ncall, $self->{call});
+
+       # do we believe this call? 
+       unless ($ncall eq $self->{call} || $self->is_believed($ncall)) {
+               if (my $ivp = Investigate::get($ncall, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
        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;
        }
 
-       $self->route_pc17($parent, $uref);
+       $uref = Route->new($ucall) unless $uref; # throw away
+       $self->route_pc17($origin, $line, $parent, $uref);
 }
                
 # link request
@@ -956,6 +945,7 @@ sub handle_18
                        $self->user->put;
                        $self->sort('S');
                }
+               $self->{handle_xml}++ if $main::do_xml && $_[1] =~ /\bxml\b/;
        } else {
                $self->version(50.0);
                $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
@@ -965,7 +955,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());
 }
@@ -981,13 +971,10 @@ sub handle_19
        my $i;
        my $newline = "PC19^";
 
-       if (eph_dup($line)) {
-               dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
-               return;
-       }
-
        # 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 +982,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->priv(1);         # I have relented and defaulted nodes
+                               $user->lockout(1);
+                               $user->homenode($origin);
+                               $user->node($origin);
+                               $user->wantroutepc19(1);
+                       }
+                       $user->sort('A') unless $user->is_node;
+                       $user->put;
+               }
+               $parent = $op;
+       }
+
        # parse the PC19
        for ($i = 1; $i < $#_-1; $i += 4) {
                my $here = $_[$i];
@@ -1012,7 +1019,7 @@ sub handle_19
                next if $call eq $main::mycall;
 
                # check that this PC19 isn't trying to alter the wrong dxchan
-               my $dxchan = DXChannel->get($call);
+               my $dxchan = DXChannel::get($call);
                if ($dxchan && $dxchan != $self) {
                        dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
                        next;
@@ -1022,12 +1029,35 @@ sub handle_19
                my $user = DXUser->get_current($call);
                if (!$user) {
                        $user = DXUser->new($call);
-                       $user->sort('A');
                        $user->priv(1);         # I have relented and defaulted nodes
                        $user->lockout(1);
                        $user->homenode($call);
                        $user->node($call);
                }
+               $user->sort('A') unless $user->is_node;
+
+               RouteDB::update($call, $self->{call});
+
+               # do we believe this call?
+               my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; 
+               unless ($call eq $self->{call} || $self->is_believed($call)) {
+                       my $pt = $user->lastping($self->{call}) || 0;
+                       if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) {
+                               my $ivp  = Investigate->new($call, $self->{call});
+                               $ivp->version($ver);
+                               $ivp->here($here);
+                               $ivp->store_pcxx($pcno,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]);
+                       } else {
+                               dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr');
+                       }
+                       $user->put;
+                       next;
+               }
+
+               if (eph_dup($genline)) {
+                       dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr');
+                       next;
+               }
 
                my $r = Route::Node::get($call);
                my $flags = Route::here($here)|Route::conf($conf);
@@ -1071,12 +1101,12 @@ sub handle_19
                my $mref = DXMsg::get_busy($call);
                $mref->stop_msg($call) if $mref;
                                
-               $user->lastin($main::systime) unless DXChannel->get($call);
+               $user->lastin($main::systime) unless DXChannel::get($call);
                $user->put;
        }
 
 
-       $self->route_pc19(@rout) if @rout;
+       $self->route_pc19($origin, $line, @rout) if @rout;
 }
                
 # send local configuration
@@ -1110,6 +1140,18 @@ sub handle_21
                return;
        }
 
+       RouteDB::delete($call, $self->{call});
+
+       # check if we believe this
+       unless ($call eq $self->{call} || $self->is_believed($call)) {
+               if (my $ivp = Investigate::get($call, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
        # check to see if we are in the pc19list, if we are then don't bother with any of
        # this routing table manipulation, just remove it from the list and dump it
        my @rout;
@@ -1128,7 +1170,7 @@ sub handle_21
                        my $node = Route::Node::get($call);
                        if ($node) {
                                                
-                               my $dxchan = DXChannel->get($call);
+                               my $dxchan = DXChannel::get($call);
                                if ($dxchan && $dxchan != $self) {
                                        dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
                                        return;
@@ -1146,7 +1188,7 @@ sub handle_21
                }
        }
 
-       $self->route_pc21(@rout) if @rout;
+       $self->route_pc21($origin, $line, @rout) if @rout;
 }
                
 
@@ -1176,7 +1218,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]));
@@ -1189,13 +1234,24 @@ sub handle_23
                dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr');
                return;
        }
-       if (Geomag::dup($d,$sfi,$k,$i,$_[6])) {
+
+       # global wwv filtering on INPUT
+       my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]);
+       if ($self->{inwwvfilter}) {
+               my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc);
+               unless ($filter) {
+                       dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
+                       return;
+               }
+       }
+       $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
+       if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) {
                dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
                return;
        }
-       $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
                
-       my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
+       # note this only takes the first one it gets
+       Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
 
        my $rep;
        eval {
@@ -1234,7 +1290,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 +1388,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
@@ -1466,6 +1528,9 @@ sub handle_50
        my $origin = shift;
 
        my $call = $_[1];
+
+       RouteDB::update($call, $self->{call});
+
        my $node = Route::Node::get($call);
        if ($node) {
                return unless $node->call eq $self->{call};
@@ -1474,7 +1539,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);
        }
 }
                
@@ -1495,43 +1560,12 @@ sub handle_51
                if ($flag == 1) {
                        $self->send(pc51($from, $to, '0'));
                } else {
-                       # it's a reply, look in the ping list for this one
-                       my $ref = $pings{$from};
-                       if ($ref) {
-                               my $tochan =  DXChannel->get($from);
-                               while (@$ref) {
-                                       my $r = shift @$ref;
-                                       my $dxchan = DXChannel->get($r->{call});
-                                       next unless $dxchan;
-                                       my $t = tv_interval($r->{t}, [ gettimeofday ]);
-                                       if ($dxchan->is_user) {
-                                               my $s = sprintf "%.2f", $t; 
-                                               my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
-                                               $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
-                                       } elsif ($dxchan->is_node) {
-                                               if ($tochan) {
-                                                       my $nopings = $tochan->user->nopings || $obscount;
-                                                       push @{$tochan->{pingtime}}, $t;
-                                                       shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-
-                                                               # cope with a missed ping, this means you must set the pingint large enough
-                                                       if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
-                                                               $t -= $tochan->{pingint};
-                                                       }
-
-                                                               # calc smoothed RTT a la TCP
-                                                       if (@{$tochan->{pingtime}} == 1) {
-                                                               $tochan->{pingave} = $t;
-                                                       } else {
-                                                               $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
-                                                       }
-                                                       $tochan->{nopings} = $nopings; # pump up the timer
-                                               }
-                                       } 
-                               }
-                       }
+                       DXXml::Ping::handle_ping_reply($self, $from);
                }
        } else {
+
+               RouteDB::update($from, $self->{call});
+
                if (eph_dup($line)) {
                        dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
                        return;
@@ -1639,7 +1673,7 @@ sub handle_default
 sub process
 {
        my $t = time;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $pc50s;
        
@@ -1651,7 +1685,8 @@ sub process
        }
 
        foreach $dxchan (@dxchan) {
-               next unless $dxchan->is_node();
+               next unless $dxchan->is_node;
+               next if $dxchan->handle_xml;
                next if $dxchan == $main::me;
 
                # send the pc50
@@ -1662,18 +1697,23 @@ sub process
                        if ($dxchan->{nopings} <= 0) {
                                $dxchan->disconnect;
                        } else {
-                               addping($main::mycall, $dxchan->call);
+                               DXXml::Ping::add($main::me, $dxchan->call);
                                $dxchan->{nopings} -= 1;
                                $dxchan->{lastping} = $t;
+                               $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
                        }
                }
        }
 
+       Investigate::process();
+
        # every ten seconds
        if ($t - $last10 >= 10) {       
                # clean out ephemera 
 
                eph_clean();
+               import_chat();
+               
 
                $last10 = $t;
        }
@@ -1696,7 +1736,7 @@ sub send_dx_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -1747,22 +1787,10 @@ sub send_wwv_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       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) {
@@ -1771,9 +1799,8 @@ 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);
        }
-       
 }
 
 sub wwv
@@ -1784,7 +1811,7 @@ sub wwv
        my ($filter, $hops);
        
        if ($self->{wwvfilter}) {
-               ($filter, $hops) = $self->{wwvfilter}->it(@_);
+               ($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_]);
                return unless $filter;
        }
        send_prot_line($self, $filter, $hops, $isolate, $line)
@@ -1794,21 +1821,9 @@ sub send_wcy_spot
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       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
@@ -1816,7 +1831,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);
        }
 }
 
@@ -1839,7 +1854,7 @@ sub send_announce
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $target;
        my $to = 'To ';
@@ -1860,28 +1875,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;
@@ -1900,7 +1900,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]);
        }
 }
 
@@ -1918,7 +1919,7 @@ sub send_chat
 {
        my $self = shift;
        my $line = shift;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        my $target = $_[3];
        my $text = unpad($_[2]);
@@ -1930,28 +1931,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;
@@ -1981,7 +1967,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]);
        }
 }
 
@@ -2021,29 +2008,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');
                }
@@ -2055,6 +2049,7 @@ sub send_local_config
 #
 # is called route(to, pcline);
 #
+
 sub route
 {
        my ($self, $call, $line) = @_;
@@ -2065,8 +2060,10 @@ sub route
        }
 
        # always send it down the local interface if available
-       my $dxchan = DXChannel->get($call);
-       unless ($dxchan) {
+       my $dxchan = DXChannel::get($call);
+       if ($dxchan) {
+               dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route');
+       } else {
                my $cl = Route::get($call);
                $dxchan = $cl->dxchan if $cl;
                if (ref $dxchan) {
@@ -2074,8 +2071,23 @@ sub route
                                dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
                                return;
                        }
+                       dbg("route: $call -> $dxchan->{call} using normal route" ) if isdbg('route');
+               }
+       }
+
+       # try the backstop method
+       unless ($dxchan) {
+               my $rcall = RouteDB::get($call);
+               if ($rcall) {
+                       if ($self && $rcall eq $self->{call}) {
+                               dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
+                               return;
+                       }
+                       $dxchan = DXChannel::get($rcall);
+                       dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
                }
        }
+
        if ($dxchan) {
                my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
                if ($routeit) {
@@ -2143,20 +2155,6 @@ sub load_hops
        return ();
 }
 
-
-# add a ping request to the ping queues
-sub addping
-{
-       my ($from, $to) = @_;
-       my $ref = $pings{$to} || [];
-       my $r = {};
-       $r->{call} = $from;
-       $r->{t} = [ gettimeofday ];
-       route(undef, $to, pc51($to, $main::mycall, 1));
-       push @$ref, $r;
-       $pings{$to} = $ref;
-}
-
 sub process_rcmd
 {
        my ($self, $tonode, $fromnode, $user, $cmd) = @_;
@@ -2195,13 +2193,13 @@ sub process_rcmd_reply
        if ($tonode eq $main::mycall) {
                my $s = $rcmds{$fromnode};
                if ($s) {
-                       my $dxchan = DXChannel->get($s->{call});
-                       my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
+                       my $dxchan = DXChannel::get($s->{call});
+                       my $ref = $user eq $tonode ? $dxchan : (DXChannel::get($user) || $dxchan);
                        $ref->send($line) if $ref;
                        delete $rcmds{$fromnode} if !$dxchan;
                } else {
                        # send unsolicited ones to the sysop
-                       my $dxchan = DXChannel->get($main::myalias);
+                       my $dxchan = DXChannel::get($main::myalias);
                        $dxchan->send($line) if $dxchan;
                }
        } else {
@@ -2279,6 +2277,8 @@ sub disconnect
                        eph_del_regex("^PC1[679].*$c");
                }
        }
+
+       RouteDB::delete_interface($call);
        
        # remove them from the pc19list as well
        while (my ($k,$v) = each %pc19list) {
@@ -2299,7 +2299,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 +2331,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 +2370,7 @@ sub send_route
                                $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
                                next unless $routeit;
                        }
+                       
                        $self->send($routeit);
                }
        }
@@ -2376,10 +2379,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 +2392,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 +2401,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,9 +2476,9 @@ 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;
+       dbg("PCPROT: emphemeral duplicate") if $r && isdbg('chanerr'); 
        return $r;
 }
 
@@ -2501,5 +2519,69 @@ sub run_cmd
 {
        goto &DXCommandmode::run_cmd;
 }
+
+
+# import any msgs in the chat directory
+# the messages are sent to the chat group which forms the
+# the first part of the name (eg: solar.1243.txt would be
+# sent to chat group SOLAR)
+# 
+# Each message found is sent: one non-blank line to one chat
+# message. So 4 lines = 4 chat messages.
+# 
+# The special name LOCAL is for local users ANN
+# The special name ALL is for ANN/FULL
+# The special name SYSOP is for ANN/SYSOP
+#
+sub import_chat
+{
+       # are there any to do in this directory?
+       return unless -d $chatimportfn;
+       unless (opendir(DIR, $chatimportfn)) {
+               dbg("can\'t open $chatimportfn $!") if isdbg('msg');
+               Log('msg', "can\'t open $chatimportfn $!");
+               return;
+       } 
+
+       my @names = readdir(DIR);
+       closedir(DIR);
+       my $name;
+       foreach $name (@names) {
+               next if $name =~ /^\./;
+               my $splitit = $name =~ /^split/;
+               my $fn = "$chatimportfn/$name";
+               next unless -f $fn;
+               unless (open(MSG, $fn)) {
+                       dbg("can\'t open import file $fn $!") if isdbg('msg');
+                       Log('msg', "can\'t open import file $fn $!");
+                       unlink($fn);
+                       next;
+               }
+               my @msg = map { s/\r?\n$//; $_ } <MSG>;
+               close(MSG);
+               unlink($fn);
+
+               my @cat = split /\./, $name;
+               my $target = uc $cat[0];
+
+               foreach my $text (@msg) {
+                       next unless $text && $text !~ /^\s*#/;
+                       if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP') {
+                               my $sysopflag = $target eq 'SYSOP' ? '*' : ' ';
+                               if ($target ne 'LOCAL') {
+                                       send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0');
+                               } else {
+                                       Log('ann', 'LOCAL', $main::mycall, $text);
+                                       DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all());
+                               }
+                       } else {
+                               my $msgid = nextchatmsgid();
+                               $text = "#$msgid $text";
+                               send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0');
+                       }
+               }
+       }
+}
+
 1;
 __END__