perl/DXProtHandle.pm

   1 #
   2 #
   3 # This module impliments the handlers for the protocal mode for a dx cluster
   4 #
   5 # Copyright (c) 1998-2007 Dirk Koopman G1TLH
   6 #
   7 #
   8 #
   9
  10 package DXProt;
  11
  12 @ISA = qw(DXChannel);
  13
  14 use DXUtil;
  15 use DXChannel;
  16 use DXUser;
  17 use DXM;
  18 use DXProtVars;
  19 use DXCommandmode;
  20 use DXLog;
  21 use Spot;
  22 use DXProtout;
  23 use DXDebug;
  24 use Filter;
  25 use Local;
  26 use DXDb;
  27 use AnnTalk;
  28 use Geomag;
  29 use WCY;
  30 use BadWords;
  31 use DXHash;
  32 use Route;
  33 use Route::Node;
  34 use Script;
  35 use DXCIDR;
  36
  37 use strict;
  38 use warnings qw(all);
  39 no warnings qw(uninitialized);
  40
  41
  42
  43 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
  44                         $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
  45                         $pingint $obscount %pc19list $chatdupeage $chatimportfn
  46                         $investigation_int $pc19_version $myprot_version
  47                         %nodehops $baddx $badspotter $badnode $censorpc
  48                         $allowzero $decode_dk0wcy $send_opernam @checklist
  49                         $eph_pc15_restime $pc9x_past_age $pc9x_dupe_age
  50                         $pc10_dupe_age $pc92_slug_changes $last_pc92_slug
  51                         $pc92Ain $pc92Cin $pc92Din $pc92Kin $pc9x_time_tolerance
  52                         $pc92filterdef $senderverify $pc11_dwell_time $pc61_extract_route $pc92_ad_enabled $pc92c_ipaddr_enabled
  53                    );
  54
  55 $pc9x_dupe_age = 60;                    # catch loops of circular (usually) D records
  56 $pc10_dupe_age = 45;                    # just something to catch duplicate PC10->PC93 conversions
  57 $pc92_slug_changes = 60*1;              # slug any changes going outward for this long
  58 $last_pc92_slug = 0;                    # the last time we sent out any delayed add or del PC92s
  59 $pc9x_time_tolerance = 15*60;   # the time on a pc9x is allowed to be out by this amount
  60 $pc9x_past_age = (122*60)+              # maximum age in the past of a px9x (a config record might be the only
  61 $pc9x_time_tolerance;           # thing a node might send - once an hour and we allow an extra hour for luck)
  62                                 # this is actually the partition between "yesterday" and "today" but old.
  63 $senderverify = 0;                              # 1 - check for forged PC11 or PC61.
  64                                 # 2 - if forged, dump them.
  65 $pc11_dwell_time = 2;                   # number of seconds to wait for a PC61 to come to substitute the PC11
  66 $pc61_extract_route = 0;                # generate missing  user route entry and IP address from passing PC61s
  67
  68
  69 $pc92filterdef = bless ([
  70                           # tag, sort, field, priv, special parser
  71                           ['call', 'c', 0],
  72                           ['by', 'c', 0],
  73                           ['dxcc', 'nc', 1],
  74                           ['itu', 'ni', 2],
  75                           ['zone', 'nz', 3],
  76                          ], 'Filter::Cmd');
  77
  78 our %pc11q;
  79 # this is a place to park an incoming PC11 in the sure and certain hope that
  80 # a PC61 will be along soon. This has the side benefit that it will delay a
  81 # a PC11 for one second - assuming that it is not removed by a PC61 version
  82
  83 # incoming talk commands
  84 sub handle_10
  85 {
  86         my $self = shift;
  87         my $pcno = shift;
  88         my $line = shift;
  89         my $origin = shift;
  90         my $pc = shift;
  91
  92         # this is to catch loops caused by bad software ...
  93         if (eph_dup($line, $pc10_dupe_age)) {
  94                 return;
  95         }
  96
  97
  98         # is it for me or one of mine?
  99         my ($from, $to, $via, $call, $dxchan);
 100         $from = $pc->[1];
 101         if ($pc->[5] gt ' ') {
 102                 $via = $pc->[2];
 103                 $to = $pc->[5];
 104         } else {
 105                 $to = $pc->[2];
 106         }
 107
 108         # if this is a 'nodx' node then ignore it
 109         if ($badnode->in($pc->[6]) || ($via && $badnode->in($via))) {
 110                 dbg($line) if isdbg('nologchan');
 111                 dbg("PCPROT: Bad Node, dropped");
 112                 return;
 113         }
 114
 115
 116         my $nossid = $from;
 117         $nossid =~ s/-\d+$//;
 118         if ($badspotter->in($nossid)) {
 119                 dbg($line) if isdbg('nologchan');
 120                 dbg("PCPROT: Bad Spotter, dropped");
 121                 return;
 122         }
 123
 124         # if we are converting announces to talk is it a dup?
 125         if ($ann_to_talk) {
 126                 if (AnnTalk::is_talk_candidate($from, $pc->[3]) && AnnTalk::dup($from, $to, $pc->[3])) {
 127                         dbg("PCPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
 128                         return;
 129                 }
 130         }
 131
 132         # will we allow it at all?
 133         if ($censorpc) {
 134                 my @bad;
 135                 if (@bad = BadWords::check($pc->[3])) {
 136                         my $bw = join ', ', @bad;
 137                         dbg($line) if isdbg('nologchan');
 138                         dbg("PCPROT: Badwords: '$bw', dropped");
 139                         return;
 140                 }
 141         }
 142
 143         # convert this to a PC93, coming from mycall with origin set and process it as such
 144         my $ref = Route::get($pc->[6]);
 145         my $ip = $ref->ip;
 146         $main::me->normal(pc93($to, $from, $via, $pc->[3], $pc->[6]), $ip);
 147 }
 148
 149 my %pc11_saved;                                 # delayed PC11s
 150 my $pc11_rx;                                    # no of pc11 rxed
 151 my $pc61_rx;                                    # no of pc61 rxed
 152 my $pc11_to_61;                                 # no of 'better' pc61, that replaced stored waiting pc11
 153 my $rpc11_to_61;                                # no of pc11s 'promoted' to pc61 by IP captured in routing table
 154
 155 # DX Spot handling
 156 sub handle_11
 157 {
 158         my $self = shift;
 159         my $pcno = shift;
 160         my $line = shift;
 161         my $origin = shift;
 162         my $pc = shift;
 163         my $recurse = shift || 0;
 164
 165         # route 'foreign' pc26s
 166         if ($pcno == 26) {
 167                 if ($pc->[7] ne $main::mycall) {
 168                         $self->route($pc->[7], $line);
 169                         return;
 170                 }
 171         }
 172
 173         dbg("---") if isdbg("pc11") || isdbg("pc61");
 174         dbg("INPUT $self->{call}: $line via: $origin recurse: $recurse") if isdbg("pc11") || isdbg("pc61");
 175
 176 #       my ($hops) = $pc->[8] =~ /^H(\d+)/;
 177
 178         # is the spotted callsign blank? This should really be trapped earlier but it
 179         # could break other protocol sentences. Also check for lower case characters.
 180         if ($pc->[2] =~ /^\s*$/) {
 181                 dbg($line) if isdbg('nologchan');
 182                 dbg("PCPROT: blank callsign, dropped");
 183                 return;
 184         }
 185         if ($pc->[2] =~ /[a-z]/) {
 186                 dbg($line) if isdbg('nologchan');
 187                 dbg("PCPROT: lowercase characters, dropped");
 188                 return;
 189         }
 190
 191
 192         # if this is a 'nodx' node then ignore it
 193         if ($badnode->in($pc->[7])) {
 194                 dbg($line) if isdbg('nologchan');
 195                 dbg("PCPROT: Bad Node $pc->[7], dropped");
 196                 return;
 197         }
 198
 199         # convert the date to a unix date
 200         my $d = cltounix($pc->[3], $pc->[4]);
 201         # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
 202         if (!$d || (($pcno == 11 || $pcno == 61) && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
 203                 dbg($line) if isdbg('nologchan');
 204                 dbg("PCPROT: Spot ignored, invalid date or out of range ($pc->[3] $pc->[4])\n");
 205                 return;
 206         }
 207
 208         # is it 'baddx'
 209         if ($baddx->in($pc->[2])) {
 210                 dbg("PCPROT: Bad DX spot '$pc->[2]', ignored");
 211                 dbg($line) if isdbg('nologchan');
 212                 return;
 213         }
 214
 215         # is it claiming to be BUST(ed)
 216         $pc->[5] =~ s/^\s+//;                   # take any leading blanks off
 217         $pc->[2] = unpad($pc->[2]);             # take off leading and trailing blanks from spotted callsign
 218         if ($pc->[2] =~ /BUST\w*$/) {
 219                 dbg($line) if isdbg('nologchan');
 220                 dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr');
 221                 return;
 222         }
 223
 224         my $nossid = $pc->[6];
 225     $nossid =~ s/-\d+$//;
 226
 227         my @spot = Spot::prepare($pc->[1], $pc->[2], $d, $pc->[5], $nossid, $pc->[7], $pc->[8]);
 228
 229         #   $f0 = frequency
 230         #   $f1 = call
 231         #   $f2 = date in unix format
 232         #   $f3 = comment
 233         #   $f4 = spotter
 234         #   $f5 = spotted dxcc country
 235         #   $f6 = spotter dxcc country
 236         #   $f7 = origin
 237         #   $f8 = spotted itu
 238         #   $f9 = spotted cq zone
 239         #   $f10 = spotter itu
 240         #   $f11 = spotter cq zone
 241         #   $f12 = spotted us state
 242         #   $f13 = spotter us state
 243         #   $f14 = ip address
 244
 245
 246         # is this is a 'bad spotter' or an unknown user then ignore it.
 247         if ($badspotter->in($nossid)) {
 248                 dbg($line) if isdbg('nologchan');
 249                 dbg("PCPROT: Bad Spotter $pc->[6], dropped");
 250                 return;
 251         }
 252
 253         # global spot filtering on INPUT
 254         if ($self->{inspotsfilter}) {
 255                 my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
 256                 unless ($filter) {
 257                         dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr');
 258                         return;
 259                 }
 260         }
 261
 262         my $rug = Route::User::get($pc->[6]);
 263         if ($pcno == 61) {
 264                 unless ($pc->[8] && is_ipaddr($pc->[8])) {
 265                         LogDbg('err', "PCPROT: ROUTE $self->{call} NO IP ADDRESS in '$line'!");
 266                         return;
 267                 }
 268                 if ($pc61_extract_route) {
 269                         $self->populate_routing_table($pc->[7], $pc->[6], $pc->[8]);
 270                 }
 271         }
 272
 273         # this is where we decide to delay PC11s in the hope that a PC61 will be along soon.
 274         my $key = join '|', @spot[0..2,4,7]; # not including text
 275
 276         unless ($recurse) {
 277
 278                 if ($pcno == 61) {
 279
 280                         if ($pc11_saved{$key}) {
 281                                 # before we promote  because it's a better pc61, check that it's not a dupe (but don't insert it).
 282                                 if (Spot::dup_find(@spot[0..4,7])) {
 283                                         dbg("PCPROT: Duplicate Spot  $self->{call}: $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11');
 284                                         delete $pc11_saved{$key};
 285                                         return;
 286                                 }
 287
 288                                 ++$pc11_to_61;
 289
 290                                 my $percent = $pc11_rx ? $pc11_to_61 * 100 / $pc11_rx : 0;
 291                                 dbg(sprintf("PROMOTED $self->{call}: BETTER $pc->[0] $key, using pc61, WAITING pc11 DUMPED: $pc61_rx pc11: $pc11_rx better pc61: $pc11_to_61 (%0.1f%%)", $percent)) if isdbg("pc11");
 292
 293                                 delete $pc11_saved{$key}; # because we have promoted it, no longer needed.
 294
 295                                 # so unlike the promotion by route, there is a stored, but uncounted PC11
 296                                 # which have discarded. But we have chosen to use better PC61 that's just come in
 297                                 # so we allow the PC61 to be counted later, but count the now discarded PC11
 298                                 # because it *did* come in.
 299                                 ++$pc11_rx;
 300                         }
 301                 }
 302
 303                 if ($pcno == 11) {
 304
 305                         # if this fires then we have already had one or more PC11s but no PC61 for this spot
 306                         if ($pc11_saved{$key}) {
 307                                 dbg("DUPE $self->{call} $pc->[0] key: $key is saved, ignored") if isdbg("pc11");
 308                                 return;         # because it's a dup
 309                         }
 310
 311                         # before we promote by route, check that it's not been preceded by a previous PC61
 312                         if (Spot::dup_find(@spot[0..4,7])) {
 313                                 my $s = exists $pc11_saved{$key} ? " stored $key removed" : "";
 314                                 dbg("PCPROT: Duplicate Spot $self->{call}: PC11$s, recurse: $recurse, ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11');
 315                                 delete $pc11_saved{$key};
 316                                 return;
 317                         }
 318
 319
 320                         # If we have an ip address we can promote by route
 321                         if ($rug && $rug->ip) {
 322                                 $pcno = 61;
 323                                 $pc->[0] = 'PC61';
 324                                 my $hops = $pc->[8];
 325                                 $pc->[8] = $spot[14] = $rug->ip;
 326                                 ++$rpc11_to_61;
 327                                 my $percent = $pc11_rx ? $rpc11_to_61 * 100 / $pc11_rx : 0;
 328                                 dbg(sprintf("PROMOTED $self->{call}: ROUTE pc11 $key PROMOTED to pc61 with IP $spot[14] pc61: $pc61_rx pc11: $pc11_rx route->pc61 $rpc11_to_61 (%0.1f%%)", $percent)) if isdbg("pc11");
 329                                 $line = join '^', @$pc, $hops, '~';
 330
 331                                 # update the stats (NOTE, thie record was a PC11, it has now become a PC61
 332                                 # this is NOT the same choosing a better PC61, that is a separate record.
 333                                 ++$pc11_rx;             # 'cos we received as a PC11 it and it won't be a pc11 anymore
 334                                 --$pc61_rx;             # 'cos we'll increment it later as it's now a pc61, no double counting
 335
 336 #                               dbg("CHANGED saved key: $key PC11 line to $line") if isdbg('pc11');
 337                                 delete $pc11_saved{$key};
 338                         }
 339
 340                         # if it is STILL (despite all efforts to change it) a PC11
 341                         # save it and wait - it will be called from pc11_process
 342                         if ($pcno == 11) {
 343                                 $pc11_saved{$key} = [$main::systime, $self, $pcno, $line, $origin, $pc];
 344                                 dbg("WAITING $self->{call}: NEW $pc->[0] spot $key waiting for a better offer") if isdbg("pc11");
 345                                 return;
 346                         }
 347                 }
 348         }
 349
 350         # this goes after the input filtering, but before the add
 351         # so that if it is input filtered, it isn't added to the dup
 352         # list. This allows it to come in from a "legitimate" source
 353         #
 354         ## NOTE: this is where we insert the spot into the DXDupe cache
 355         #
 356         if (Spot::dup(@spot[0..4,7])) {
 357                 dbg("PCPROT: Duplicate Spot  $self->{call}: $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11');
 358                 return;
 359         }
 360
 361         dbg("PROCESSING $self->{call}: $pc->[0] key: $key") if isdbg('pc11');
 362
 363         if ($pcno == 11) {
 364                 ++$pc11_rx;
 365         } else {
 366                 ++$pc61_rx;
 367         }
 368
 369         # we check IP addresses for PC61 - this will also dedupe PC11 promotions
 370         if (@$pc > 8 && is_ipaddr($pc->[8])) {
 371                 my $ip = $pc->[8];
 372                 $ip =~ s/,/:/g;
 373                 $ip =~ s/^::ffff://;
 374                 if (DXCIDR::find($ip)) {
 375                         dbg($line) if isdbg('nologchan');
 376                         dbg("PCPROT: PC61 $ip in badip list, dropped");
 377                         return;
 378                 }
 379         }
 380
 381         # here we verify the spotter is currently connected to the node it says it is one. AKA email sender verify
 382         # but without the explicit probe to the node. We are relying on "historical" information, but it very likely
 383         # to be current once we have seen the first PC92C from that node.
 384         #
 385         # As for spots generated from non-PC92 nodes, we'll see after about  do_pc9x3h20m...
 386         #
 387         if ($senderverify || isdbg('suspicious')) {
 388                 my $sv = $senderverify;
 389                 $sv += 2 if isdbg('suspicious');
 390                 my $nroute = Route::Node::get($pc->[7]);
 391                 my $local = DXChannel::get($pc->[7]);
 392                 my $uref = DXUser::get_current($pc->[7]);
 393                 my $s = '';
 394                 my $ip = $pcno == 61 ?  $pc->[8] : '';
 395
 396                 if ($nroute && ($nroute->last_PC92C || ($local && !$local->do_pc9x))) {
 397 #                       $s .= "User $pc->[6] not logged in, " unless $uroute;
 398                         $s .= "User $pc->[6] not on node $pc->[7], " unless $nroute->is_user($pc->[6]);
 399 #                       $s .= "Node $pc->[7] at '$ip' not on Node's IP " . $nroute->ip if $ip && $nroute && $nroute->ip && $nroute->ip ne $ip;
 400                 }
 401                 # check for ip addresses on spots from non-pc9x nodes - if they have it's likely done by DXSpider nodes
 402                 #if ($ip && ($nroute  && !$nroute->do_pc9x || $uref && $uref->is_spider)) {
 403                 #       $s .= "PC$pcno has spurious ipaddr '$ip' from non-pc9x node $pc->[7]";
 404                 #}
 405                 if ($s) {
 406                         my $action = $sv > 1 ? ", DUMPED" : '';
 407                         $s =~ s/, $//;
 408                         dbg("PCPROT: Bad Spot $pc->[2] on $pc->[1] by $pc->[6]($ip)\@$pc->[7] $s$action");
 409                         return unless $sv < 2;
 410                 }
 411         }
 412
 413         # we until here to do any censorship to try and reduce the amount of noise that repeated copies
 414         # from other connected nodes cause
 415         if ($censorpc) {
 416                 my @bad;
 417                 if (@bad = BadWords::check($pc->[5])) {
 418                         my $bw = join ', ', @bad;
 419                         dbg($line) if isdbg('nologchan');
 420                         dbg("PCPROT: Badwords: '$bw', dropped");
 421                         return;
 422                 }
 423         }
 424
 425
 426         # add it
 427         Spot::add(@spot);
 428
 429         my $ip = '';
 430         $ip ||= $spot[14] if exists $spot[14];
 431         if (isdbg('progress')) {
 432                 my $sip = $ip ? sprintf "($ip)" : '' unless $ip =~ m|[\(\)\*]|;
 433                 $sip ||= '';
 434                 my $d = ztime($spot[2]);
 435                 my $s = "SPOT: $spot[1] on $spot[0] \@ $d by $spot[4]$sip\@$spot[7]";
 436                 $s .= $spot[3] ? " '$spot[3]'" : q{ ''};
 437                 $s .=  " route: $origin";
 438                 dbg($s);
 439         }
 440
 441         #
 442         # @spot at this point contains:-
 443         # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
 444         # then  spotted itu, spotted cq, spotters itu, spotters cq
 445         # you should be able to route on any of these
 446         #
 447
 448         # fix up qra locators of known users
 449         my $user = DXUser::get_current($spot[4]);
 450         if ($user) {
 451                 my $qra = $user->qra;
 452                 unless ($qra && is_qra($qra)) {
 453                         my $lat = $user->lat;
 454                         my $long = $user->long;
 455                         if (defined $lat && defined $long) {
 456                                 $user->qra(DXBearing::lltoqra($lat, $long));
 457                                 $user->put;
 458                         }
 459                 }
 460
 461                 # send a remote command to a distant cluster if it is visible and there is no
 462                 # qra locator and we havn't done it for a month.
 463
 464                 unless ($user->qra) {
 465                         my $node;
 466                         my $to = $user->homenode;
 467                         my $last = $user->lastoper || 0;
 468                         if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) {
 469                                 my $cmd = "forward/opernam $spot[4]";
 470                                 # send the rcmd but we aren't interested in the replies...
 471                                 my $dxchan = $node->dxchan;
 472                                 if ($dxchan && $dxchan->is_clx) {
 473                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 474                                 } else {
 475                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 476                                 }
 477                                 if ($to ne $origin) {
 478                                         $to = $origin;
 479                                         $node = Route::Node::get($to);
 480                                         if ($node) {
 481                                                 $dxchan = $node->dxchan;
 482                                                 if ($dxchan && $dxchan->is_clx) {
 483                                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 484                                                 } else {
 485                                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 486                                                 }
 487                                         }
 488                                 }
 489                                 $user->lastoper($main::systime);
 490                                 $user->put;
 491                         }
 492                 }
 493         }
 494
 495         # local processing
 496         if (defined &Local::spot) {
 497                 my $r;
 498                 eval {
 499                         $r = Local::spot($self, @spot);
 500                 };
 501                 return if $r;
 502         }
 503
 504         # DON'T be silly and send on PC26s!
 505         return if $pcno == 26;
 506
 507         # send out the filtered spots
 508         send_dx_spot($self, $line, @spot) if @spot;
 509
 510         # cancel any recursion as we have now processed it
 511         my $count =  $pc11_to_61+$rpc11_to_61;
 512         my $percent = ($pc11_rx + $pc61_rx) ? ($pc11_rx * 100) / ($pc11_rx + $pc61_rx) : 0;
 513         my $pc11_61 = $pc11_rx ? ($count * 100) / $pc11_rx : 0;
 514         my $data = "$pc->[0] key: $key";
 515         my $stats = sprintf "pc11: $pc11_rx pc61: $pc61_rx pc11%%: %0.1f%% pc11->pc61: $count(%0.1f%%)", $percent, $pc11_61;
 516         if ($recurse) {
 517                 if ($pc11_saved{$key}) {
 518                         dbg("END $self->{call}: RECURSED $data removed and finished $stats") if isdbg('pc11');
 519                         delete $pc11_saved{$key};
 520                 } else {
 521                         dbg("END $self->{call}: RECURSED NO KEY finished $stats") if isdbg('pc11');
 522                 }
 523                 $recurse = 0;
 524         } else {
 525                 dbg("END $self->{call}: NORMAL $data finished $stats") if isdbg('pc11');
 526         }
 527 }
 528
 529 # used to kick outstanding PC11 if required
 530 sub pc11_process
 531 {
 532         foreach my $key (keys %pc11_saved) {
 533                 my $r = $pc11_saved{$key};
 534                 if ($main::systime > $r->[0] + $pc11_dwell_time) {
 535                         dbg("---") if isdbg("pc11");
 536                         dbg("RECURSE $r->[1]->{call}: PC11 spot $key timed out waiting, resend") if isdbg("pc11");
 537                         my $self = $r->[1];
 538                         delete $pc11_saved{$key};
 539                         $self->handle_11(@$r[2..5], 1);
 540                 }
 541         }
 542 }
 543
 544 # return the pc11 / pc61 / promotions data
 545 sub get_pc11_61_stats
 546 {
 547         my $promotions =  $pc11_to_61+$rpc11_to_61;
 548         my $percent = ($pc11_rx + $pc61_rx) ? ($pc11_rx * 100) / ($pc11_rx + $pc61_rx) : 0;
 549         my $pc11_61p = $pc11_rx ? ($promotions * 100) / $pc11_rx : 0;
 550         return {
 551                         pc11_rx => $pc11_rx+0,
 552                         pc61_rx => $pc61_rx+0,
 553                         pc11_to_61 => $pc11_to_61+0,
 554                         rpc11_to_61 => $rpc11_to_61+0,
 555                         promotions => $promotions+0,
 556                         pc11_percent => $percent+0,
 557                         promotions_percent => $pc11_61p+0,
 558                    };
 559 }
 560
 561 # announces
 562 sub handle_12
 563 {
 564         my $self = shift;
 565         my $pcno = shift;
 566         my $line = shift;
 567         my $origin = shift;
 568         my $pc = shift;
 569
 570         # announce duplicate checking
 571         $pc->[3] =~ s/^\s+//;                   # remove leading blanks
 572
 573         # if this is a 'nodx' node then ignore it
 574         if ($badnode->in($pc->[5])) {
 575                 dbg($line) if isdbg('nologchan');
 576                 dbg("PCPROT: Bad Node, dropped");
 577                 return;
 578         }
 579
 580         # if this is a 'bad spotter' user then ignore it
 581         my $nossid = $pc->[1];
 582         $nossid =~ s/-\d+$//;
 583         if ($badspotter->in($nossid)) {
 584                 dbg($line) if isdbg('nologchan');
 585                 dbg("PCPROT: Bad Spotter, dropped");
 586                 return;
 587         }
 588
 589         # ignore PC12s from origins that use PCxx protocol
 590         my $oref = Route::get($origin);
 591         if ($oref->do_pc9x) {
 592                 dbg("PCPROT: PC12 rxed from PC9x node, ignored") if isdbg('chanerr');
 593                 return;
 594         }
 595
 596         if ($censorpc) {
 597                 my @bad;
 598                 if (@bad = BadWords::check($pc->[3])) {
 599                         my $bw = join ', ', @bad;
 600                         dbg($line) if isdbg('nologchan');
 601                         dbg("PCPROT: Badwords: '$bw', dropped");
 602                         return;
 603                 }
 604         }
 605
 606
 607         my $dxchan;
 608
 609         if ((($dxchan = DXChannel::get($pc->[2])) && $dxchan->is_user) || $pc->[4] =~ /^[\#\w.]+$/){
 610                 $self->send_chat(0, $line, @$pc[1..6]);
 611         } elsif ($pc->[2] eq '*' || $pc->[2] eq $main::mycall) {
 612
 613                 # ignore something that looks like a chat line coming in with sysop
 614                 # flag - this is a kludge...
 615                 if ($pc->[3] =~ /^\#\d+ / && $pc->[4] eq '*') {
 616                         dbg('PCPROT: Probable chat rewrite, dropped') if isdbg('chanerr');
 617                         return;
 618                 }
 619
 620                 # here's a bit of fun, convert incoming ann with a callsign in the first word
 621                 # or one saying 'to <call>' to a talk if we can route to the recipient
 622                 if ($ann_to_talk) {
 623                         my $call = AnnTalk::is_talk_candidate($pc->[1], $pc->[3]);
 624                         if ($call) {
 625                                 my $ref = Route::get($call);
 626                                 if ($ref) {
 627                                         $dxchan = $ref->dxchan;
 628                                         $dxchan->talk($pc->[1], $call, undef, $pc->[3], $pc->[5]) if $dxchan != $self;
 629                                         return;
 630                                 }
 631                         }
 632                 }
 633
 634                 # send it
 635                 $self->send_announce(0, $line, @$pc[1..6]);
 636         } else {
 637                 $self->route($pc->[2], $line);
 638         }
 639
 640         # local processing
 641         if (defined &Local::ann) {
 642                 my $r;
 643                 eval {
 644                         $r = Local::ann($self, $line, @$pc[1..6]);
 645                 };
 646                 return if $r;
 647         }
 648 }
 649
 650 sub handle_15
 651 {
 652         my $self = shift;
 653         my $pcno = shift;
 654         my $line = shift;
 655         my $origin = shift;
 656         my $pc = shift;
 657
 658         if (eph_dup($line, $eph_pc15_restime)) {
 659                 return;
 660         } else {
 661                 unless ($self->{isolate}) {
 662                         DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me
 663                 }
 664         }
 665 }
 666
 667 # incoming user
 668 sub handle_16
 669 {
 670         my $self = shift;
 671         my $pcno = shift;
 672         my $line = shift;
 673         my $origin = shift;
 674         my $pc = shift;
 675
 676         # general checks
 677         my $dxchan;
 678         my $ncall = $pc->[1];
 679         my $newline = "PC16^";
 680
 681         # dos I want users from this channel?
 682         unless ($self->user->wantpc16) {
 683                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 684                 return;
 685         }
 686
 687         # is it me?
 688         if ($ncall eq $main::mycall) {
 689                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 690                 return;
 691         }
 692
 693         my $h;
 694         $h = 1 if DXChannel::get($ncall);
 695         if ($h && $self->{call} ne $ncall) {
 696                 dbg("PCPROT: trying to update a local node, ignored") if isdbg('chanerr');
 697                 return;
 698         }
 699
 700         if (eph_dup($line)) {
 701                 return;
 702         }
 703
 704         # isolate now means only accept stuff from this call only
 705         if ($self->{isolate} && $ncall ne $self->{call}) {
 706                 dbg("PCPROT: $self->{call} isolated, $ncall ignored") if isdbg('chanerr');
 707                 return;
 708         }
 709
 710         my $parent = Route::Node::get($ncall);
 711
 712         if ($parent) {
 713                 $dxchan = $parent->dxchan;
 714                 if ($dxchan && $dxchan ne $self) {
 715                         dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 716                         return;
 717                 }
 718
 719                 # input filter if required
 720                 return unless $self->in_filter_route($parent);
 721         } else {
 722                 $parent = Route::Node->new($ncall);
 723         }
 724
 725         unless ($h) {
 726                 if ($parent->via_pc92) {
 727                         dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
 728                         return;
 729                 }
 730         }
 731
 732         my $i;
 733         my @rout;
 734         for ($i = 2; $i < $#$pc; $i++) {
 735                 my ($call, $conf, $here) = $pc->[$i] =~ /^(\S+) (\S) (\d)/o;
 736                 next unless $call && $conf && defined $here && is_callsign($call);
 737                 next if $call eq $main::mycall;
 738
 739                 eph_del_regex("^PC17\\^$call\\^$ncall");
 740
 741                 $conf = $conf eq '*';
 742
 743                 # reject this if we think it is a node already
 744                 my $rng = Route::Node::get($call);
 745                 my $u = DXUser::get_current($call) unless $rng;
 746                 if ($rng || ($u && $u->is_node)) {
 747                         dbg("PCPROT: $call is a node") if isdbg('chanerr');
 748                         next;
 749                 }
 750
 751                 my $rug = Route::User::get($call);
 752                 my $flags = Route::here($here)|Route::conf($conf);
 753
 754                 if ($rug) {
 755                         my $au = $rug->addparent($parent);
 756                         if ($rug->flags != $flags) {
 757                                 $rug->flags($flags);
 758                                 $au = $rug;
 759                         }
 760                         push @rout, $rug if $h && $au;
 761                 } else {
 762                         my @ans = $parent->add_user($call, $flags);
 763                         push @rout, @ans if $h && @ans;
 764                 }
 765
 766                 # add this station to the user database, if required
 767                 my $user = DXUser::get_current($ncall);
 768                 $user = DXUser->new($call) unless $user;
 769                 $user->homenode($parent->call) if !$user->homenode;
 770                 $user->node($parent->call);
 771                 $user->lastin($main::systime) unless DXChannel::get($call);
 772                 $user->put;
 773
 774                 # send info to all logged in thingies
 775                 $self->tell_login('loginu', "$ncall: $call") if $user->is_local_node;
 776                 $self->tell_buddies('loginb', $call, $ncall);
 777         }
 778         if (@rout) {
 779                 $self->route_pc16($origin, $line, $parent, @rout) if @rout;
 780 #               $self->route_pc92a($main::mycall, undef, $parent, @rout) if $h && $self->{state} eq 'normal';
 781         }
 782 }
 783
 784 # remove a user
 785 sub handle_17
 786 {
 787         my $self = shift;
 788         my $pcno = shift;
 789         my $line = shift;
 790         my $origin = shift;
 791         my $pc = shift;
 792
 793         my $dxchan;
 794         my $ncall = $pc->[2];
 795         my $ucall = $pc->[1];
 796
 797         eph_del_regex("^PC16\\^$ncall.*$ucall");
 798
 799         # do I want users from this channel?
 800         unless ($self->user->wantpc16) {
 801                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 802                 return;
 803         }
 804
 805         if ($ncall eq $main::mycall) {
 806                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 807                 return;
 808         }
 809
 810         # isolate now means only accept stuff from this call only
 811         if ($self->{isolate} && $ncall ne $self->{call}) {
 812                 dbg("PCPROT: $self->{call} isolated, $ncall ignored") if isdbg('chanerr');
 813                 return;
 814         }
 815
 816         my $uref = Route::User::get($ucall);
 817         unless ($uref) {
 818                 dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
 819                 return;
 820         }
 821         my $parent = Route::Node::get($ncall);
 822         unless ($parent) {
 823                 dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
 824                 return;
 825         }
 826
 827         $dxchan = DXChannel::get($ncall);
 828         if ($dxchan && $dxchan ne $self) {
 829                 dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 830                 return;
 831         }
 832
 833         unless ($dxchan) {
 834                 if ($parent->via_pc92) {
 835                         dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
 836                         return;
 837                 }
 838         }
 839
 840         if (DXChannel::get($ucall)) {
 841                 dbg("PCPROT: trying do disconnect local user, ignored") if isdbg('chanerr');
 842                 return;
 843         }
 844
 845         # input filter if required and then remove user if present
 846 #               return unless $self->in_filter_route($parent);
 847         $parent->del_user($uref);
 848
 849         # send info to all logged in thingies
 850         my $user = DXUser::get_current($ncall);
 851         $self->tell_login('logoutu', "$ncall: $ucall") if $user && $user->is_local_node;
 852         $self->tell_buddies('logoutb', $ucall, $ncall);
 853
 854         if (eph_dup($line)) {
 855                 return;
 856         }
 857
 858         $self->route_pc17($origin, $line, $parent, $uref);
 859 #       $self->route_pc92d($main::mycall, undef, $parent, $uref) if $dxchan;
 860 }
 861
 862 # link request
 863 sub handle_18
 864 {
 865         my $self = shift;
 866         my $pcno = shift;
 867         my $line = shift;
 868         my $origin = shift;
 869         my $pc = shift;
 870
 871         $self->state('init');
 872
 873         my $parent = Route::Node::get($self->{call});
 874
 875         my ($software, $version, $build) = (undef, 0, 0);
 876
 877         # record the type and version offered
 878         if (($software, $version) = $pc->[1] =~ /(DXSpider|CC\s*Cluster)\s+Version: (\d+(?:\.\d+)?)/i) {
 879                 $version += 0;
 880                 $version += 53 if $version < 6;
 881                 $self->{version} = $version;
 882                 $self->user->version($version);
 883                 $parent->version($version);
 884                 my ($build) = $pc->[1] =~ /Build: (\d+(?:\.\d+)?)/;
 885                 $build += 0;
 886                 $build = 0 unless $build > 1;
 887                 $self->{build} = $build;
 888                 $self->user->build($build);
 889                 $parent->build($build);
 890                 dbg("$self->{call} = $software version $version build $build");
 891                 unless ($self->is_spider) {
 892                         dbg("Change U " . $self->user->sort . " C $self->{sort} -> S");
 893                         $self->user->sort('S');
 894                         $self->user->put;
 895                         $self->sort('S');
 896                 }
 897 #               $self->{handle_xml}++ if DXXml::available() && $pc->[1] =~ /\bxml/;
 898         } elsif (($software, $version, $build) = $pc->[1] =~ /(AR-Cluster)\s+Version:\s+(\d+\.\d+).?(\d+\.\d+)?/) {
 899                 dbg("$self->{call} = $software version $version build $build");
 900                 $self->{version} = $version;
 901                 $self->user->version($version);
 902                 $parent->version($version);
 903                 $self->{build} = $build;
 904                 $self->user->build($build);
 905                 $parent->build($build);
 906                 unless ($self->is_arcluster) {
 907                         dbg("Change U " . $self->user->sort . " C $self->{sort} -> R");
 908                         $self->user->sort('R');
 909                         $self->user->put;
 910                         $self->sort('R');
 911                 }
 912         } else {
 913                 dbg("$self->{call} = Unknown software ($pc->[1] $pc->[2])");
 914                 $self->version(50.0);
 915                 $self->version($pc->[2] / 100) if $pc->[2] && $pc->[2] =~ /^\d+$/;
 916                 $self->user->version($self->version);
 917         }
 918
 919         if ($pc->[1] =~ /CC\s*Cluster/i || $pc->[1] =~ /\bpc9x/i) {
 920                 if ($self->{isolate}) {
 921                         dbg("$self->{call} pc9x recognised, but node is isolated, using old protocol");
 922                 } elsif (!$self->user->wantpc9x) {
 923                         dbg("$self->{call} pc9x explicitly switched off, using old protocol");
 924                 } else {
 925                         $self->{do_pc9x} = 1;
 926                         dbg("$self->{call} Set do PC9x");
 927                 }
 928         }
 929
 930         # first clear out any nodes on this dxchannel
 931         my @rout = $parent->del_nodes;
 932         $self->route_pc21($origin, $line, @rout, $parent) if @rout;
 933         $self->send_local_config();
 934         $self->send(pc20());
 935 }
 936
 937 sub check_add_user
 938 {
 939         my $call = shift;
 940         my $type = shift;
 941         my $homenode = shift;
 942
 943         # add this station to the user database, if required (don't remove SSID from nodes)
 944         my $user = DXUser::get_current($call);
 945         unless ($user) {
 946                 $user = DXUser->new($call);
 947                 $user->sort($type || 'U');
 948                 if ($user->is_node) {
 949                         $user->priv(1);         # I have relented and defaulted nodes
 950                         $user->lockout(1) if $user->is_node;
 951                 } else {
 952                         $user->homenode($homenode) if $homenode;
 953                         $user->node($homenode);
 954                         $user->priv(0);
 955                 }
 956                 $user->lastin($main::systime); # this makes it last longer than just this invocation
 957                 $user->put;                             # just to make sure it gets written away!!!
 958                 dbg("DXProt: PC92 new user record for $call created");
 959         }
 960
 961         # this is to fix a problem I introduced some build ago by using this function for users
 962         # whereas it was only being used for nodes.
 963         if ($user->is_user && $user->lockout && ($user->priv // 0) == 1) {
 964                 $user->priv(0);
 965                 $user->lockout(0);
 966                 dbg("DXProt: PC92 user record for $call depriv'd and unlocked");
 967                 $user->put;
 968         }
 969         return $user;
 970 }
 971
 972 # incoming cluster list
 973 sub handle_19
 974 {
 975         my $self = shift;
 976         my $pcno = shift;
 977         my $line = shift;
 978         my $origin = shift;
 979         my $pc = shift;
 980
 981         my $i;
 982         my $newline = "PC19^";
 983
 984         # new routing list
 985         my (@rout, @pc92out);
 986
 987         # first get the INTERFACE node
 988         my $parent = Route::Node::get($self->{call});
 989         unless ($parent) {
 990                 dbg("PCPROT: my parent $self->{call} has disappeared");
 991                 $self->disconnect;
 992                 return;
 993         }
 994
 995         my $h;
 996
 997         # parse the PC19
 998         #
 999         # We are making a major change from now on. We are only going to accept
1000         # PC19s from directly connected nodes.  This means that we are probably
1001         # going to throw away most of the data that we are being sent.
1002         #
1003         # The justification for this is that most of it is wrong or out of date
1004         # anyway.
1005         #
1006         # From now on we are only going to believe PC92 data and locally connected
1007         # non-pc92 nodes.
1008         #
1009         for ($i = 1; $i < $#$pc-1; $i += 4) {
1010                 my $here = $pc->[$i];
1011                 my $call = uc $pc->[$i+1];
1012                 my $conf = $pc->[$i+2];
1013                 my $ver = $pc->[$i+3];
1014                 next unless defined $here && defined $conf && is_callsign($call);
1015
1016                 eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)");
1017
1018                 # check for sane parameters
1019                 #                               $ver = 5000 if $ver eq '0000';
1020                 next unless $ver && $ver =~ /^\d+$/;
1021                 next if $ver < 5000;    # only works with version 5 software
1022                 next if length $call < 3; # min 3 letter callsigns
1023                 next if $call eq $main::mycall || $call eq $main::myalias;
1024
1025                 # check that this PC19 isn't trying to alter the wrong dxchan
1026                 $h = 0;
1027                 my $dxchan = DXChannel::get($call);
1028                 if ($dxchan) {
1029                         if ($dxchan == $self) {
1030                                 $h = 1;
1031                         } else {
1032                                 dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
1033                                 next;
1034                         }
1035                 }
1036
1037                 # isolate now means only accept stuff from this call only
1038                 if ($self->{isolate} && $call ne $self->{call}) {
1039                         dbg("PCPROT: $self->{call} isolated, $call ignored") if isdbg('chanerr');
1040                         next;
1041                 }
1042
1043                 if ($call eq $main::myalias) {
1044                         LogDbg('err', "ROUTE: $call eq \$myalias from $self->{call}, ignored!!!");
1045                         dbgprintring(3) if isdbg('nologchan');
1046                         next;
1047                 }
1048
1049                 my $user = check_add_user($call, 'A');
1050
1051 #               if (eph_dup($genline)) {
1052 #                       dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr');
1053 #                       next;
1054 #               }
1055
1056
1057                 unless ($h) {
1058                         if ($parent->via_pc92) {
1059                                 dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
1060                                 next;
1061                         }
1062                 }
1063
1064                 my $r = Route::Node::get($call);
1065                 my $flags = Route::here($here)|Route::conf($conf);
1066
1067                 # modify the routing table if it is in it, otherwise store it in the pc19list for now
1068                 if ($r) {
1069                         my $ar;
1070                         if ($call ne $parent->call) {
1071                                 if ($self->in_filter_route($r)) {
1072                                         $ar = $parent->add($call, $ver, $flags);
1073 #                                       push @rout, $ar if $ar;
1074                                 } else {
1075                                         next;
1076                                 }
1077                         }
1078                         if ($r->version ne $ver || $r->flags != $flags) {
1079                                 $r->version($ver);
1080                                 $r->flags($flags);
1081                         }
1082                         push @rout, $r;
1083                 } else {
1084                         if ($call eq $self->{call} || $user->wantroutepc19) {
1085                                 my $new = Route->new($call); # throw away
1086                                 if ($self->in_filter_route($new)) {
1087                                         my $ar = $parent->add($call, $ver, $flags);
1088                                         $user->wantroutepc19(1) unless defined $user->wantroutepc19;
1089                                         push @rout, $ar if $ar;
1090                                         push @pc92out, $r if $h;
1091                                 } else {
1092                                         next;
1093                                 }
1094                         }
1095                 }
1096
1097                 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
1098                 my $mref = DXMsg::get_busy($call);
1099                 $mref->stop_msg($call) if $mref;
1100
1101                 $user->lastin($main::systime) unless DXChannel::get($call);
1102                 $user->put;
1103         }
1104
1105         # we are not automatically sending out PC19s, we send out a composite PC21,PC19 instead
1106         # but remember there will only be one (pair) these because any extras will be
1107         # thrown away.
1108         if (@rout) {
1109 #               $self->route_pc21($self->{call}, $line, @rout);
1110                 $self->route_pc19($self->{call}, $line, @rout);
1111         }
1112         if (@pc92out && !$pc92_slug_changes) {
1113                 $self->route_pc92a($main::mycall, $line, $main::routeroot, @pc92out) if $self->{state} eq 'normal';
1114         }
1115 }
1116
1117 # send local configuration
1118 sub handle_20
1119 {
1120         my $self = shift;
1121         my $pcno = shift;
1122         my $line = shift;
1123         my $origin = shift;
1124         my $pc = shift;
1125
1126         if ($self->{do_pc9x} && $self->{state} ne 'init92' && $self->{state} ne 'normal') {
1127                 $self->send("Reseting to oldstyle routing because login call not sent in any pc92");
1128                 $self->{do_pc9x} = 0;
1129         }
1130         $self->send_local_config;
1131         $self->send(pc22());
1132         $self->state('normal');
1133         $self->{lastping} = 0;
1134         $self->route_pc92a($main::mycall, undef, $main::routeroot, Route::Node::get($self->{call}));
1135 }
1136
1137 # delete a cluster from the list
1138 #
1139 # This should never occur for directly connected nodes.
1140 #
1141 sub handle_21
1142 {
1143         my $self = shift;
1144         my $pcno = shift;
1145         my $line = shift;
1146         my $origin = shift;
1147         my $pc = shift;
1148
1149         my $call = uc $pc->[1];
1150
1151         eph_del_regex("^PC1[679].*$call");
1152
1153         # if I get a PC21 from the same callsign as self then ignore it
1154         if ($call eq $self->{call}) {
1155                 dbg("PCPROT: self referencing PC21 from $self->{call}");
1156                 return;
1157         }
1158
1159         # for the above reason and also because of the check for PC21s coming
1160         # in for self->call from outside being ignored further down
1161         # we don't need any isolation code here, because we will never
1162         # act on a PC21 with self->call in it.
1163
1164         my $parent = Route::Node::get($self->{call});
1165         unless ($parent) {
1166                 dbg("PCPROT: my parent $self->{call} has disappeared");
1167                 $self->disconnect;
1168                 return;
1169         }
1170
1171         my @rout;
1172
1173         if ($call ne $main::mycall && $call ne $main::myalias) { # don't allow malicious buggers to disconnect me!
1174                 my $node = Route::Node::get($call);
1175                 if ($node) {
1176
1177                         if ($node->via_pc92) {
1178                                 dbg("PCPROT: controlled by PC92, ignored") if isdbg('chanerr');
1179                                 return;
1180                         }
1181
1182                         my $dxchan = DXChannel::get($call);
1183                         if ($dxchan && $dxchan != $self) {
1184                                 dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chan');
1185                                 return;
1186                         }
1187
1188                         # input filter it
1189                         return unless $self->in_filter_route($node);
1190
1191                         # routing objects, force a PC21 if it is local
1192                         push @rout, $node->del($parent);
1193                         push @rout, $call if $dxchan && @rout == 0;
1194                 }
1195         } else {
1196                 dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chan');
1197                 return;
1198         }
1199
1200         if (eph_dup($line)) {
1201                 return;
1202         }
1203
1204         if (@rout) {
1205                 $self->route_pc21($origin, $line, @rout);
1206 #               $self->route_pc92d($main::mycall, $line, $main::routeroot, @rout);
1207         }
1208 }
1209
1210
1211 sub handle_22
1212 {
1213         my $self = shift;
1214         my $pcno = shift;
1215         my $line = shift;
1216         my $origin = shift;
1217         my $pc = shift;
1218
1219         if ($self->{do_pc9x}) {
1220                 if ($self->{state} ne 'init92' && $self->{state} ne 'normal') {
1221                         $self->send("Reseting to oldstyle routing because login call not sent in any pc92");
1222                         $self->{do_pc9x} = 0;
1223                 }
1224         }
1225         $self->{lastping} = 0;
1226         $self->state('normal');
1227         $self->route_pc92a($main::mycall, undef, $main::routeroot, Route::Node::get($self->{call}));
1228 }
1229
1230 # WWV info
1231 sub handle_23
1232 {
1233         my $self = shift;
1234         my $pcno = shift;
1235         my $line = shift;
1236         my $origin = shift;
1237         my $pc = shift;
1238
1239         # route foreign' pc27s
1240         if ($pcno == 27) {
1241                 if ($pc->[8] ne $main::mycall) {
1242                         $self->route($pc->[8], $line);
1243                         return;
1244                 }
1245         }
1246
1247
1248         # do some de-duping
1249         my $d = cltounix($pc->[1], sprintf("%02d18Z", $pc->[2]));
1250         my $sfi = unpad($pc->[3]);
1251         my $k = unpad($pc->[4]);
1252         my $i = unpad($pc->[5]);
1253         my ($r) = $pc->[6] =~ /R=(\d+)/;
1254         $r = 0 unless $r;
1255         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $pc->[2] < 0 || $pc->[2] > 23) {
1256                 dbg("PCPROT: WWV Date ($pc->[1] $pc->[2]) out of range") if isdbg('chanerr');
1257                 return;
1258         }
1259
1260         # global wwv filtering on INPUT
1261         my @dxcc = ((Prefix::cty_data($pc->[7]))[0..2], (Prefix::cty_data($pc->[8]))[0..2]);
1262         if ($self->{inwwvfilter}) {
1263                 my ($filter, $hops) = $self->{inwwvfilter}->it(@$pc[7,8], $origin, @dxcc);
1264                 unless ($filter) {
1265                         dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
1266                         return;
1267                 }
1268         }
1269         $pc->[7] =~ s/-\d+$//o;         # remove spotter's ssid
1270         if (Geomag::dup($d,$sfi,$k,$i,$pc->[6],$pc->[7])) {
1271                 dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
1272                 return;
1273         }
1274
1275         # note this only takes the first one it gets
1276         Geomag::update($d, $pc->[2], $sfi, $k, $i, @$pc[6..8], $r);
1277         dbg("WWV: <$pc->[2]>, sfi=$sfi k=$k info=$i '$pc->[6]' $pc->[7]\@$pc->[8] $r route: $origin") if isdbg('progress');
1278
1279         if (defined &Local::wwv) {
1280                 my $rep;
1281                 eval {
1282                         $rep = Local::wwv($self, $pc->[1], $pc->[2], $sfi, $k, $i, @$pc[6..8], $r);
1283                 };
1284                 return if $rep;
1285         }
1286
1287         # DON'T be silly and send on PC27s!
1288         return if $pcno == 27;
1289
1290         # broadcast to the eager world
1291         send_wwv_spot($self, $line, $d, $pc->[2], $sfi, $k, $i, @$pc[6..8]);
1292 }
1293
1294 # set here status
1295 sub handle_24
1296 {
1297         my $self = shift;
1298         my $pcno = shift;
1299         my $line = shift;
1300         my $origin = shift;
1301         my $pc = shift;
1302
1303         my $call = uc $pc->[1];
1304         my ($nref, $uref);
1305         $nref = Route::Node::get($call);
1306         $uref = Route::User::get($call);
1307         return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on
1308
1309         if (eph_dup($line)) {
1310                 return;
1311         }
1312
1313         $nref->here($pc->[2]) if $nref;
1314         $uref->here($pc->[2]) if $uref;
1315         my $ref = $nref || $uref;
1316         return unless $self->in_filter_route($ref);
1317
1318         $self->route_pc24($origin, $line, $ref, $pc->[3]);
1319 }
1320
1321 # merge request
1322 sub handle_25
1323 {
1324         my $self = shift;
1325         my $pcno = shift;
1326         my $line = shift;
1327         my $origin = shift;
1328         my $pc = shift;
1329
1330         if ($pc->[1] ne $main::mycall) {
1331                 $self->route($pc->[1], $line);
1332                 return;
1333         }
1334         if ($pc->[2] eq $main::mycall) {
1335                 dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chan');
1336                 return;
1337         }
1338
1339         Log('DXProt', "Merge request for $pc->[3] spots and $pc->[4] WWV from $pc->[2]");
1340
1341         # spots
1342         if ($pc->[3] > 0) {
1343                 my @in = reverse Spot::search(1, undef, undef, 0, $pc->[3]);
1344                 my $in;
1345                 foreach $in (@in) {
1346                         $self->send(pc26(@{$in}[0..4], $pc->[2]));
1347                 }
1348         }
1349
1350         # wwv
1351         if ($pc->[4] > 0) {
1352                 my @in = reverse Geomag::search(0, $pc->[4], time, 1);
1353                 my $in;
1354                 foreach $in (@in) {
1355                         $self->send(pc27(@{$in}[0..5], $pc->[2]));
1356                 }
1357         }
1358 }
1359
1360 sub handle_26 {goto &handle_11}
1361 sub handle_27 {goto &handle_23}
1362
1363 # mail/file handling
1364 sub handle_28
1365 {
1366         my $self = shift;
1367         my $pcno = shift;
1368         my $line = shift;
1369         my $origin = shift;
1370         my $pc = shift;
1371
1372         if ($pc->[1] eq $main::mycall) {
1373                 no strict 'refs';
1374                 my $sub = "DXMsg::handle_$pcno";
1375                 &$sub($self, @$pc);
1376         } else {
1377                 $self->route($pc->[1], $line) unless $self->is_clx;
1378         }
1379 }
1380
1381 sub handle_29 {goto &handle_28}
1382 sub handle_30 {goto &handle_28}
1383 sub handle_31 {goto &handle_28}
1384 sub handle_32 {goto &handle_28}
1385 sub handle_33 {goto &handle_28}
1386
1387 sub handle_34
1388 {
1389         my $self = shift;
1390         my $pcno = shift;
1391         my $line = shift;
1392         my $origin = shift;
1393         my $pc = shift;
1394
1395         if (eph_dup($line, $eph_pc34_restime)) {
1396                 return;
1397         } else {
1398                 $self->process_rcmd($pc->[1], $pc->[2], $pc->[2], $pc->[3]);
1399         }
1400 }
1401
1402 # remote command replies
1403 sub handle_35
1404 {
1405         my $self = shift;
1406         my $pcno = shift;
1407         my $line = shift;
1408         my $origin = shift;
1409         my $pc = shift;
1410
1411         eph_del_regex("^PC35\\^$pc->[2]\\^$pc->[1]\\^");
1412         $self->process_rcmd_reply($pc->[1], $pc->[2], $pc->[1], $pc->[3]);
1413 }
1414
1415 sub handle_36 {goto &handle_34}
1416
1417 # database stuff
1418 sub handle_37
1419 {
1420         my $self = shift;
1421         my $pcno = shift;
1422         my $line = shift;
1423         my $origin = shift;
1424         my $pc = shift;
1425
1426         if ($pc->[1] eq $main::mycall) {
1427                 no strict 'refs';
1428                 my $sub = "DXDb::handle_$pcno";
1429                 &$sub($self, @$pc);
1430         } else {
1431                 $self->route($pc->[1], $line) unless $self->is_clx;
1432         }
1433 }
1434
1435 # node connected list from neighbour
1436 sub handle_38
1437 {
1438         my $self = shift;
1439         my $pcno = shift;
1440         my $line = shift;
1441         my $origin = shift;
1442         my $pc = shift;
1443 }
1444
1445 # incoming disconnect
1446 sub handle_39
1447 {
1448         my $self = shift;
1449         my $pcno = shift;
1450         my $line = shift;
1451         my $origin = shift;
1452         my $pc = shift;
1453
1454         if ($pc->[1] eq $self->{call}) {
1455                 $self->disconnect(1);
1456         } else {
1457                 dbg("PCPROT: came in on wrong channel") if isdbg('chanerr');
1458         }
1459 }
1460
1461 sub handle_40 {goto &handle_28}
1462
1463 # user info
1464 sub handle_41
1465 {
1466         my $self = shift;
1467         my $pcno = shift;
1468         my $line = shift;
1469         my $origin = shift;
1470         my $pc = shift;
1471
1472         my $call = $pc->[1];
1473         my $sort = $pc->[2];
1474         my $val = $pc->[3];
1475
1476         my $l = "PC41^$call^$sort";
1477         if (eph_dup($l, $eph_info_restime)) {
1478                 return;
1479         }
1480
1481         # input filter if required
1482         #                       my $ref = Route::get($call) || Route->new($call);
1483         #                       return unless $self->in_filter_route($ref);
1484
1485         if ($val eq $sort || $val =~ /^\s*$/) {
1486                 dbg('PCPROT: invalid value') if isdbg('chanerr');
1487                 return;
1488         }
1489
1490         if ($call eq $main::mycall || $call eq $main::myalias) {
1491                 dbg "DXPROT: PC41 trying to update $call from outside via $origin, ignored";
1492                 return;
1493         }
1494         my $chan = DXChannel::get($call);
1495         if ($chan) {
1496                 dbg "DXPROT: PC41 trying to update online $call from outside via $origin, ignored";
1497                 return;
1498         }
1499
1500         # add this station to the user database, if required
1501         my $user = DXUser::get_current($call);
1502         $user = DXUser->new($call) unless $user;
1503
1504         if ($sort == 1) {
1505                 if (($val =~ /spotter/i || $val =~ /self/i) && $user->name && $user->name ne $val) {
1506                         dbg("PCPROT: invalid name") if isdbg('chanerr');
1507                         return;
1508                 }
1509                 $user->name($val);
1510         } elsif ($sort == 2) {
1511                 $user->qth($val);
1512         } elsif ($sort == 3) {
1513                 if (is_latlong($val)) {
1514                         my ($lat, $long) = DXBearing::stoll($val);
1515                         $user->lat($lat) if $lat;
1516                         $user->long($long) if $long;
1517                         $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra;
1518                 } else {
1519                         dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
1520                         return;
1521                 }
1522         } elsif ($sort == 4) {
1523                 $user->homenode($val);
1524         } elsif ($sort == 5) {
1525                 if (is_qra(uc $val)) {
1526                         my ($lat, $long) = DXBearing::qratoll(uc $val);
1527                         $user->lat($lat) if $lat && !$user->lat;
1528                         $user->long($long) if $long && !$user->long;
1529                         $user->qra(uc $val);
1530                 } else {
1531                         dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
1532                         return;
1533                 }
1534         }
1535         $user->lastoper($main::systime); # to cut down on excessive for/opers being generated
1536         $user->put;
1537
1538         unless ($self->{isolate}) {
1539                 DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
1540         }
1541
1542         #  perhaps this IS what we want after all
1543         #                       $self->route_pc41($ref, $call, $sort, $val, $pc->[4]);
1544 }
1545
1546 sub handle_42 {goto &handle_28}
1547
1548
1549 # database
1550 sub handle_44 {goto &handle_37}
1551 sub handle_45 {goto &handle_37}
1552 sub handle_46 {goto &handle_37}
1553 sub handle_47 {goto &handle_37}
1554 sub handle_48 {goto &handle_37}
1555
1556 # message and database
1557 sub handle_49
1558 {
1559         my $self = shift;
1560         my $pcno = shift;
1561         my $line = shift;
1562         my $origin = shift;
1563         my $pc = shift;
1564
1565         if (eph_dup($line)) {
1566                 return;
1567         }
1568
1569         if ($pc->[1] eq $main::mycall) {
1570                 DXMsg::handle_49($self, @$pc);
1571         } else {
1572                 $self->route($pc->[1], $line) unless $self->is_clx;
1573         }
1574 }
1575
1576 # keep alive/user list
1577 sub handle_50
1578 {
1579         my $self = shift;
1580         my $pcno = shift;
1581         my $line = shift;
1582         my $origin = shift;
1583         my $pc = shift;
1584
1585         return if (eph_dup($line));
1586
1587         my $call = $pc->[1];
1588
1589         my $node = Route::Node::get($call);
1590         if ($node) {
1591                 return unless $node->call eq $self->{call};
1592                 $node->usercount($pc->[2]) unless $node->users;
1593                 $node->reset_obs;
1594                 $node->PC92C_dxchan($self->call, $pc->[-1]);
1595
1596                 # input filter if required
1597 #               return unless $self->in_filter_route($node);
1598
1599                 unless ($self->{isolate}) {
1600                         DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
1601                 }
1602 #               $self->route_pc50($origin, $line, $node, $pc->[2], $pc->[3]) unless eph_dup($line);
1603         }
1604 }
1605
1606 # incoming ping requests/answers
1607 sub handle_51
1608 {
1609         my $self = shift;
1610         my $pcno = shift;
1611         my $line = shift;
1612         my $origin = shift;
1613         my $pc = shift;
1614
1615         my $to = $pc->[1];
1616         my $from = $pc->[2];
1617         my $flag = $pc->[3];
1618
1619         if ($to eq $main::myalias) {
1620                 dbg("DXPROT: Ping addressed to \$myalias ($main::myalias), ignored") if isdbg('chan');
1621                 return;
1622         }
1623
1624         # is it for us?
1625         if ($to eq $main::mycall) {
1626                 if ($flag == 1) {
1627                         $self->send(pc51($from, $to, '0'));
1628                 } else {
1629                         DXXml::Ping::handle_ping_reply($self, $from);
1630                 }
1631         } else {
1632                 if (eph_dup($line)) {
1633                         return;
1634                 }
1635                 # route down an appropriate thingy
1636                 $self->route($to, $line);
1637         }
1638 }
1639
1640 sub handle_61 { goto &handle_11; }
1641
1642 # dunno but route it
1643 sub handle_75
1644 {
1645         my $self = shift;
1646         my $pcno = shift;
1647         my $line = shift;
1648         my $origin = shift;
1649         my $pc = shift;
1650
1651         my $call = $pc->[1];
1652         if ($call ne $main::mycall) {
1653                 $self->route($call, $line);
1654         }
1655 }
1656
1657 # WCY broadcasts
1658 sub handle_73
1659 {
1660         my $self = shift;
1661         my $pcno = shift;
1662         my $line = shift;
1663         my $origin = shift;
1664         my $pc = shift;
1665
1666         my $call = $pc->[1];
1667
1668         # do some de-duping
1669         my $d = cltounix($call, sprintf("%02d18Z", $pc->[2]));
1670         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $pc->[2] < 0 || $pc->[2] > 23) {
1671                 dbg("PCPROT: WCY Date ($call $pc->[2]) out of range") if isdbg('chanerr');
1672                 return;
1673         }
1674         $pc = [ map { unpad($_) } @$pc ];
1675         if (WCY::dup($d)) {
1676                 dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr');
1677                 return;
1678         }
1679
1680         my $wcy = WCY::update($d, @$pc[2..12]);
1681         dbg("WCY: <$pc->[2]> K=$pc->[5] expK=$pc->[6] A=$pc->[4] R=$pc->[7] SFI=$pc->[3] SA=$pc->[8] GMF=$pc->[9] Au=$pc->[10] $pc->[11]\@$pc->[12] route: $origin") if isdbg('progress');
1682
1683         if (defined &Local::wcy) {
1684                 my $rep;
1685                 eval {
1686                         $rep = Local::wcy($self, @$pc[1..12]);
1687                 };
1688                 return if $rep;
1689         }
1690
1691         # broadcast to the eager world
1692         send_wcy_spot($self, $line, $d, @$pc[2..12]);
1693 }
1694
1695 # remote commands (incoming)
1696 sub handle_84
1697 {
1698         my $self = shift;
1699         my $pcno = shift;
1700         my $line = shift;
1701         my $origin = shift;
1702         my $pc = shift;
1703
1704         $self->process_rcmd($pc->[1], $pc->[2], $pc->[3], $pc->[4]);
1705 }
1706
1707 # remote command replies
1708 sub handle_85
1709 {
1710         my $self = shift;
1711         my $pcno = shift;
1712         my $line = shift;
1713         my $origin = shift;
1714         my $pc = shift;
1715
1716         $self->process_rcmd_reply($pc->[1], $pc->[2], $pc->[3], $pc->[4]);
1717 }
1718
1719 # decode a pc92 call: flag call : version : build
1720 sub _decode_pc92_call
1721 {
1722         my $icall = shift;
1723         my @part = split /:/, $icall;
1724         my ($flag, $call) = unpack "A A*", $part[0];
1725         unless (defined $flag && $flag ge '0' && $flag le '7') {
1726                 dbg("PCPROT: $icall no flag byte (0-7) at front of call, ignored") if isdbg('chanerr');
1727                 return ();
1728         }
1729         unless ($call && is_callsign($call)) {
1730                 dbg("PCPROT: $icall no recognisable callsign, ignored") if isdbg('chanerr');
1731                 return ();
1732         }
1733         my $is_node = $flag & 4;
1734         my $is_extnode = $flag & 2;
1735         my $here = $flag & 1;
1736         my $version = $part[1] || 0;
1737         my $build = $part[2] || 0;
1738         my $ip = $part[3] || '';
1739
1740         # remember that, at this stage, IPV6 addresses have : replaced by ,
1741         if (length $version > 4 && $version =~ /[,\.][\da-f]{1,4}/i) {
1742                 $ip = $version;
1743                 $version = 0;
1744         }
1745         $version =~ s/\D//g;
1746         $version = 0 unless $version && $version =~ /^[0-9]+$/;
1747         $build =~ s/^0\.//;
1748         $build =~ s/\D//g;
1749         $build = 0 unless $build &&  $build =~ /^[0-9]+$/;
1750         if ($ip) {
1751         $ip =~ s/,/:/g;
1752         $ip =~ s/^::ffff://i;
1753                 $ip = '' unless is_ipaddr($ip);
1754     }
1755         dbg("'$icall' = '" . join("', '", $call, $is_node, $is_extnode, $here, $version, $build, $ip) . "'") if isdbg('pc92');
1756         return ($call, $is_node, $is_extnode, $here, $version+0, $build+0, $ip);
1757 }
1758
1759 # decode a pc92 call: flag call : version : build
1760 sub _encode_pc92_call
1761 {
1762         my $ref = shift;
1763
1764         # plain call or value
1765         return $ref unless ref $ref;
1766
1767         my $ext = shift || 0;
1768         my $flag = 0;
1769         my $call = $ref->call;
1770         my $extra = '';
1771         $flag |= $ref->here ? 1 : 0;
1772         if ($ref->isa('Route::Node') || $ref->isa('DXProt')) {
1773                 $flag |= 4;
1774                 my $dxchan = DXChannel::get($call);
1775                 $flag |= 2 if $call ne $main::mycall && $dxchan && !$dxchan->{do_pc9x};
1776                 if (($ext & 1) && $ref->version) {
1777                         my $version = $ref->version || 1.0;
1778                         $version =  $version * 100 + 5300 if $version < 50;
1779                         $extra .= ":" . $version;
1780                 }
1781         }
1782         if (($ext & 2) && $ref->ip) {
1783                 my $ip = $ref->ip;
1784                 $ip =~ s/:/,/g;
1785                 $extra .= ':' . $ip;
1786         }
1787
1788         return "$flag$call$extra";
1789 }
1790
1791 my %things_add;
1792 my %things_del;
1793
1794 sub _add_thingy
1795 {
1796         my $parent = shift;
1797         my $s = shift;
1798         my $dxchan = shift;
1799         my $hops = shift;
1800
1801         my ($call, $is_node, $is_extnode, $here, $version, $build, $ip) = @$s;
1802         my @rout;
1803
1804         # remove spurious IPV6 prefix on IPV4 addresses
1805         $build ||= 0;
1806         $version ||= 0;
1807
1808         if ($call) {
1809                 my $ncall = $parent->call;
1810                 if ($ncall ne $call) {
1811                         my $user;
1812                         my $r;
1813
1814                         # normalise call, delete any unnormalised calls in the users file.
1815                         # then ignore this thingy
1816                         my $normcall = normalise_call($call);
1817                         if ($normcall ne $call) {
1818                                 next if DXChannel::get($call);
1819                                 $user = DXUser::get($call);
1820                                 dbg("DXProt::_add_thingy call $call normalised to $normcall, deleting spurious user $call");
1821                                 $user->del if $user;
1822                             $call = $normcall; # this is safe because a route add will ignore duplicates
1823                         }
1824
1825                         if ($call eq $main::myalias && $is_node) {
1826                                 LogDbg('err', "ROUTE: $call eq \$myalias from $ncall - downgraded to user!!!");
1827                                 dbgprintring(3) if isdbg('nologchan');
1828                                 $is_node = 0;
1829                         }
1830                         if ($is_node) {
1831                                 dbg("ROUTE: added node $call to $ncall") if isdbg('routelow');
1832                                 $user = check_add_user($call, 'A');
1833                                 @rout = $parent->add($call, $version, Route::here($here), $ip);
1834                                 $r = Route::Node::get($call);
1835                                 $r->PC92C_dxchan($dxchan->call, $hops) if $r;
1836                                 if ($version && is_numeric($version) && !$r->K && !$user->K) {
1837                                         my $old = $user->sort;
1838                                         if ($user->is_ak1a && (($version >= 5455 &&  $build > 0) || ($version >= 3000 && $version <= 3500)) ) {
1839                                                 $user->sort('S');
1840                                                 dbg("PCPROT::_add_thingy node $call v: $version b: $build sort ($old) updated to " . $user->sort);
1841                                         } elsif ($user->is_spider && ($version < 3000 || ($version > 4000 && $version < 5455))) {
1842                                                 unless ($version > 0  && $build == 0) {
1843                                                         $user->sort('A');
1844                                                         $build ||= 0;
1845                                                         dbg("PCPROT::_add_thingy node $call v: $version b: $build sort ($old) downgraded to " . $user->sort);
1846                                                 }
1847                                         }
1848                                 }
1849                                 $r->version($user->version) if $user->version;
1850                                 $r->build($user->build) if $user->build;
1851                                 $r->K(1) if $user->K;
1852                         } else {
1853                                 dbg("ROUTE: added user $call to $ncall") if isdbg('routelow');
1854                                 $user = check_add_user($call, 'U', $parent->call);
1855                                 @rout = $parent->add_user($call, Route::here($here), $ip);
1856                                 $dxchan->tell_buddies('loginb', $call, $ncall) if $dxchan;
1857                                 $r = Route::User::get($call);
1858                         }
1859                         if ($ip) {
1860                                 $r->ip($ip);
1861                                 Log('DXProt', "PC92A $call -> $ip on $ncall");
1862                         }
1863                         if ($pc92_slug_changes && $parent == $main::routeroot) {
1864                                 $things_add{$call} = Route::get($call);
1865                                 delete $things_del{$call};
1866                         }
1867                         $user->close($main::systime, $ip) if $user;             # this just updates lastseen and the connlist list containing the IP address
1868                 } else {
1869                         dbgprintring(10) if isdbg('nologchan');
1870                         dbg("DXProt::add_thingy: Trying to add parent $call to itself $ncall, ignored");
1871                 }
1872         }
1873
1874         return @rout;
1875 }
1876
1877 sub _del_thingy
1878 {
1879         my $parent = shift;
1880         my $s = shift;
1881         my $dxchan = shift;
1882         my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s;
1883         my @rout;
1884         if ($call) {
1885                 my $ref;
1886                 if ($is_node) {
1887                         $ref = Route::Node::get($call);
1888                         dbg("ROUTE: deleting node $call from " . $parent->call) if isdbg('routelow');
1889                         @rout = $ref->del($parent) if $ref;
1890                 } else {
1891                         dbg("ROUTE: deleting user $call from " . $parent->call) if isdbg('routelow');
1892                         $ref = Route::User::get($call);
1893                         if ($ref) {
1894                                 $dxchan->tell_buddies('logoutb', $call, $parent->call) if $dxchan;
1895                                 @rout = $parent->del_user($ref);
1896                         }
1897                 }
1898                 if ($pc92_slug_changes && $parent == $main::routeroot) {
1899                         $things_del{$call} = $ref unless exists $things_add{$call};
1900                         delete $things_add{$call};
1901                 }
1902         }
1903         return @rout;
1904 }
1905
1906 # this will only happen if we are slugging changes and
1907 # there are some changes to be sent, it will create an add or a delete
1908 # or both
1909 sub gen_pc92_changes
1910 {
1911         my @add = values %things_add;
1912         my @del = values %things_del;
1913         return (\@add, \@del);
1914 }
1915
1916 sub clear_pc92_changes
1917 {
1918         %things_add = %things_del = ();
1919         $last_pc92_slug = $main::systime;
1920 }
1921
1922 my $_last_time;
1923 my $_last_occurs;
1924 my $_last_pc9x_id;
1925
1926 sub last_pc9x_id
1927 {
1928         return $_last_pc9x_id;
1929 }
1930
1931 sub gen_pc9x_t
1932 {
1933         if (!$_last_time || $_last_time != $main::systime) {
1934                 $_last_time = $main::systime;
1935                 $_last_occurs = 0;
1936                 return $_last_pc9x_id = $_last_time - $main::systime_daystart;
1937         } else {
1938                 $_last_occurs++;
1939                 return $_last_pc9x_id = sprintf "%d.%02d", $_last_time - $main::systime_daystart, $_last_occurs;
1940         }
1941 }
1942
1943 sub check_pc9x_t
1944 {
1945         my $call = shift;
1946         my $t = shift;
1947         my $pc = shift;
1948         my $create = shift;
1949
1950         # check that the time is between 0 >= $t < 86400
1951         unless ($t >= 0 && $t < 86400) {
1952                 dbg("PCPROT: time invalid t: $t, ignored") if isdbg('chanerr');
1953                 return undef;
1954         }
1955
1956         # check that the time of this pc9x is within tolerance (default 15 mins either way)
1957         my $now = $main::systime - $main::systime_daystart ;
1958         my $diff = abs($now - $t);
1959         unless ($diff < $pc9x_time_tolerance || 86400 - $diff < $pc9x_time_tolerance) {
1960                 my $c = ref $call ? $call->call : $call;
1961                 dbg("PC9XERR: $c time out of range t: $t now: $now diff: $diff > $pc9x_time_tolerance, ignored") if isdbg('chan');
1962                 return undef;
1963         }
1964
1965         my $parent = ref $call ? $call : Route::Node::get($call);
1966         if ($parent) {
1967                 # we only do this for external calls whose routing table
1968                 # record come and go. The reference for mycall is permanent
1969                 # and not that frequently used, it also never times out, so
1970                 # the id on it is completely unreliable. Besides, only commands
1971                 # originating on this box will go through this code...
1972                 if ($parent->call ne $main::mycall) {
1973                         my $lastid = $parent->lastid;
1974                         if (defined $lastid) {
1975                                 if ($t < $lastid) {
1976                                         # note that this is where we determine whether this pc9x has come in yesterday
1977                                         # but is still greater (modulo 86400) than the lastid or is simply an old
1978                                         # duplicate sentence. To determine this we need to do some module 86400
1979                                         # arithmetic. High numbers mean that this is an old duplicate sentence,
1980                                         # low numbers that it is a new sentence.
1981                                         #
1982                                         # Typically you will see yesterday being taken on $t = 84, $lastid = 86235
1983                                         # and old dupes with $t = 234, $lastid = 256 (which give answers 249 and
1984                                         # 86378 respectively in the calculation below).
1985                                         #
1986                                         if ($t+86400-$lastid > $pc9x_past_age) {
1987                                                 dbg("PCPROT: dup id on $t <= lastid $lastid, ignored") if isdbg('chanerr') || isdbg('pc92dedupe');
1988                                                 return undef;
1989                                         }
1990                                 } elsif ($t == $lastid) {
1991                                         dbg("PCPROT: dup id on $t == lastid $lastid, ignored") if isdbg('chanerr') || isdbg('pc92dedupe');
1992                                         return undef;
1993                                 } else {
1994                                         # check that if we have a low number in lastid that yesterday's numbers
1995                                         # (likely in the 85000+ area) don't override them, thus causing flip flopping
1996                                         if ($lastid+86400-$t < $pc9x_past_age) {
1997                                                 dbg("PCPROT: dup id on $t in yesterday, lastid $lastid, ignored") if isdbg('chanerr') || isdbg('pc92dedupe');
1998                                                 return undef;
1999                                         }
2000                                 }
2001                         }
2002                 }
2003         } elsif ($create) {
2004                 $parent = Route::Node->new($call);
2005         } else {
2006                 dbg("PCPROT: $call does not exist, ignored") if isdbg('pc92dedupe');
2007                 return undef;
2008         }
2009         if (isdbg('pc92dedupe')) {
2010                 my $exists = exists $parent->{lastid}; # naughty, naughty :-)
2011                 my $val = $parent->{lastid};
2012                 my $s = $exists ? (defined $val ? $val : 'exists/undef') : 'undef';
2013                 dbg("PCPROT: $call pc92 id lastid $s -> $t");
2014         }
2015         $parent->lastid($t);
2016
2017         return $parent;
2018 }
2019
2020 sub pc92_handle_first_slot
2021 {
2022         my $self = shift;
2023         my $slot = shift;
2024         my $parent = shift;
2025         my $t = shift;
2026         my $hops = shift;
2027         my $oparent = $parent;
2028
2029         my @radd;
2030
2031         my ($call, $is_node, $is_extnode, $here, $version, $build) = @$slot;
2032         if ($call && $is_node) {
2033                 if ($call eq $main::mycall) {
2034                         LogDbg('err', "PCPROT: $self->{call} : $call looped back onto \$main::mycall ($main::mycall), ignored");
2035                         return;
2036                 }
2037                 if ($call eq $main::myalias) {
2038                         LogDbg('err', "PCPROT: $self->{call} : $call looped back onto \$main::myalias ($main::myalias), ignored");
2039                         return;
2040                 }
2041                 # this is only accepted from my "self".
2042                 # this also kills configs from PC92 nodes with external PC19 nodes that are also
2043                 # locally connected. Local nodes always take precedence. But we remember the lastid
2044                 # to try to reduce the number of dupe PC92s for this external node.
2045                 if (DXChannel::get($call) && $call ne $self->{call}) {
2046                         $parent = check_pc9x_t($call, $t, 92); # this will update the lastid time
2047                         dbg("PCPROT: locally connected node $call from other another node $self->{call}, ignored") if isdbg('chanerr');
2048                         return;
2049                 }
2050                 if ($is_extnode) {
2051                         # reparent to external node (note that we must have received a 'C' or 'A' record
2052                         # from the true parent node for this external before we get one for the this node
2053                         unless ($parent = Route::Node::get($call)) {
2054                                 if ($is_extnode && $oparent) {
2055                                         @radd = _add_thingy($oparent, $slot, $self, $hops);
2056                                         $parent = $radd[0];
2057                                 } else {
2058                                         dbg("PCPROT: no previous C or A for this external node received, ignored") if isdbg('chanerr');
2059                                         return;
2060                                 }
2061                         }
2062                         $parent = check_pc9x_t($call, $t, 92) || return;
2063                         $parent->via_pc92(1);
2064                         $parent->PC92C_dxchan($self->{call}, $hops);
2065                 }
2066         } else {
2067                 dbg("PCPROT: must be \$mycall or external node as first entry, ignored") if isdbg('chanerr');
2068                 return;
2069         }
2070         $parent->here(Route::here($here));
2071         $parent->version($version || $pc19_version) if $version;
2072     $parent->build($build) if $build;
2073         $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
2074         return ($parent, @radd);
2075 }
2076
2077 # DXSpider routing entries
2078 sub handle_92
2079 {
2080         my $self = shift;
2081         my $pcno = shift;
2082         my $line = shift;
2083         my $origin = shift;
2084         my $pc = shift;
2085
2086         my (@radd, @rdel);
2087
2088         my $pcall = $pc->[1];
2089         my $t = $pc->[2];
2090         my $sort = $pc->[3];
2091         my $hops = $pc->[-1];
2092
2093         # this catches loops of A/Ds
2094 #       if (eph_dup($line, $pc9x_dupe_age)) {
2095 #               return;
2096 #       }
2097
2098         if ($pcall eq $main::mycall) {
2099                 LogDbg('err', "PCPROT: looped back, ignored");
2100                 return;
2101         }
2102
2103         if ($pcall eq $main::myalias) {
2104                 LogDbg('err', "PCPROT: looped back to \$myalias ($main::myalias), misconfiguration ignored");
2105                 return;
2106         }
2107
2108         if ($pcall eq $self->{call} && $self->{state} eq 'init') {
2109                 if ($self->{isolate}) {
2110                         dbg("DXPROT: PC9x received, but $pcall is isolated, ignored");
2111                         return;
2112                 } elsif (!$self->user->wantpc9x) {
2113                         dbg("DXPROT: PC9x explicitly switched off on $pcall, ignored");
2114                         return;
2115                 } else {
2116                         $self->state('init92');
2117                         $self->{do_pc9x} = 1;
2118                         dbg("DXPROT: Do pc9x set on $pcall");
2119                 }
2120         }
2121         unless ($self->{do_pc9x}) {
2122                 dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
2123                 return;
2124         }
2125
2126         # don't create routing entries for D records that don't already exist
2127         # this is what causes all those PC92 loops!
2128         my $parent = check_pc9x_t($pcall, $t, 92, $sort ne 'D') || return;
2129         my $oparent = $parent;
2130
2131         $parent->do_pc9x(1);
2132         $parent->via_pc92(1);
2133
2134         if ($sort eq 'F' || $sort eq 'R') {
2135
2136                 # this is the route finding section
2137                 # here is where the consequences of the 'find' command
2138                 # are dealt with
2139
2140                 my $from = $pc->[4];
2141                 my $target = $pc->[5];
2142
2143                 if ($sort eq 'F') {
2144                         my $flag;
2145                         my $ref;
2146                         my $dxchan;
2147                         if ($ref = DXChannel::get($target)) {
2148                                 $flag = 1;              # we are directly connected
2149                         } else {
2150                                 $ref = Route::get($target);
2151                                 $dxchan = $ref->dxchan;
2152                                 $flag = 2;
2153                         }
2154                         if ($ref && $flag && $dxchan) {
2155                                 $self->send(pc92r($from, $target, $flag, int($dxchan->{pingave}*1000)));
2156                                 return;
2157                         }
2158                 } elsif ($sort eq 'R') {
2159                         if (my $dxchan = DXChannel::get($from)) {
2160                                 handle_pc92_find_reply($dxchan, $pcall, $from, $target, @$pc[6,7]);
2161                         } else {
2162                                 my $ref = Route::get($from);
2163                                 if ($ref) {
2164                                         my @dxchan = grep {$_->do_pc9x} $ref->alldxchan;
2165                                         if (@dxchan) {
2166                                                 $_->send($line) for @dxchan;
2167                                         } else {
2168                                                 dbg("PCPROT: $self->{call} : type R no return route, ignored") if isdbg('chanerr') || isdbg('route');
2169                                         }
2170                                 } else {
2171                                         dbg("PCPROT: $self->{call} : type R no return route, ignored") if isdbg('chanerr') || isdbg('route');
2172                                 }
2173                         }
2174                         return;
2175                 }
2176
2177         } elsif ($sort eq 'K') {
2178                 $pc92Kin += length $line;
2179
2180                 # remember the last channel we arrived on
2181                 $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
2182
2183                 my @ent = _decode_pc92_call($pc->[4]);
2184
2185                 if (@ent) {
2186                         my $add;
2187
2188                         ($parent, $add) = $self->pc92_handle_first_slot(\@ent, $parent, $t, $hops);
2189                         return unless $parent; # dupe
2190
2191                         push @radd, $add if $add;
2192                         $parent->reset_obs;
2193                         my $call = $parent->call;
2194                         my $version = $ent[4] || 0;
2195                         my $build = $ent[5] ||  0;
2196                         $build =~ s/^0\.//;
2197                         my $oldbuild = $parent->build || 0;
2198                         my $oldversion = $parent->version || 0;
2199                         my $user = check_add_user($parent->call, 'S');
2200                         my $oldsort = $user->sort // '';
2201
2202                         dbg("PCPROT: PC92 K v: $version ov: $oldversion b: $build ob: $oldbuild pk: " . ($parent->K || '0') . " uk: " . ($user->K || 0)) if isdbg('pc92k');
2203
2204                         if (is_numeric($version) || is_numeric($build)) {
2205                                 my $changed = 0;
2206                                 if (($oldversion ne $version || $build ne $oldbuild)) {
2207                                         dbg("PCPROT: PC92 K node $call updated version: $version (was $oldversion) build: $build (was $oldbuild)");
2208                                         $user->version($parent->version($version));
2209                                         $user->build($parent->build($build));
2210                                         ++$changed;
2211                                 }
2212                                 if ($oldsort ne 'S') {
2213                                         dbg("PCPROT: PC92 K node $call updated sort: $sort (was $oldsort)");
2214                                         $user->sort('S');
2215                                         ++$changed;
2216                                 }
2217                                 unless ($user->K) {
2218                                         dbg("PCPROT: PC92 K node $call updated - marked as PC92 K user");
2219                                         $user->K(1);
2220                                         ++$changed;
2221                                 }
2222                                 $user->put if $changed;
2223                                 $parent->K(1); # mark this as come in on a K
2224                         } else {
2225                                 dbg("DXProt PC92 K version call $call: invalid version: '$version' or build: '$version', ignored");
2226                         }
2227                         dbg("ROUTE: reset obscount on $call now " . $parent->obscount) if isdbg('obscount');
2228                 }
2229         } elsif ($sort eq 'A' || $sort eq 'D' || $sort eq 'C') {
2230
2231                 $pc92Ain += length $line if $sort eq 'A';
2232                 $pc92Cin += length $line if $sort eq 'C';
2233                 $pc92Din += length $line if $sort eq 'D';
2234
2235                 # remember the last channel we arrived on
2236                 $parent->PC92C_dxchan($self->{call}, $hops) unless $self->{call} eq $parent->call;
2237
2238                 # this is the main route section
2239                 # here is where all the routes are created and destroyed
2240
2241                 # cope with missing duplicate node calls in the first slot
2242                 my $me = $pc->[4] || '';
2243                 $me ||= _encode_pc92_call($parent) unless $me ;
2244
2245                 my @ent = map {my @a = _decode_pc92_call($_); @a ? \@a : ()} grep {$_ && /^[0-7]/} $me, @$pc[5 .. $#$pc];
2246
2247                 if (@ent) {
2248
2249                         # look at the first one which will always be a node of some sort
2250                         # except in the case of 'A' or 'D' in which the $pcall is used
2251                         # otherwise use the node call and update any information
2252                         # that needs to be done.
2253                         my $add;
2254
2255                         ($parent, $add) = $self->pc92_handle_first_slot($ent[0], $parent, $t, $hops);
2256                         return unless $parent; # dupe
2257
2258                         shift @ent;
2259                         push @radd, $add if $add;
2260                 }
2261
2262                 # do a pass through removing any references to either mycall
2263                 my @nent;
2264                 for (@ent) {
2265                         my $dxc;
2266                         next unless $_ && @$_;
2267                         if ($_->[0] eq $main::mycall) {
2268                                 dbg("PCPROT: $self->{call} : type $sort $_->[0] refers to me, ignored") if isdbg('route');
2269                                 next;
2270                         }
2271
2272                         my $isnode = ($_->[1] | $_->[2]);
2273                         if (($_->[0] eq $main::myalias && $isnode) || ($_->[0] eq $main::mycall && !$isnode)) {
2274                                 LogDbg('err',"PCPROT: $self->{call} : type $sort $_->[0] trying to change type to " . $_->[1]?"Node":"User" . ", ignored");
2275                                 next;
2276                         }
2277
2278                         push @nent, $_;
2279                 }
2280
2281                 if ($sort eq 'A') {
2282                         for (@nent) {
2283                                 push @radd, _add_thingy($parent, $_, $self, $hops);
2284                         }
2285                 } elsif ($sort eq 'D') {
2286                         for (@nent) {
2287                                 push @rdel, _del_thingy($parent, $_, $self);
2288                         }
2289                 } elsif ($sort eq 'C') {
2290                         my (@nodes, @users);
2291
2292                         # we reset obscounts on config records as well as K records
2293                         $parent->reset_obs;
2294                         dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('obscount');
2295
2296                         #
2297                         foreach my $r (@nent) {
2298                                 #                       my ($call, $is_node, $is_extnode, $here, $version, $build) = _decode_pc92_call($_);
2299                                 if ($r->[0]) {
2300                                         if ($r->[1]) {
2301                                                 push @nodes, $r->[0];
2302                                         } else {
2303                                                 push @users, $r->[0];
2304                                         }
2305                                 } else {
2306                                         dbg("PCPROT: $self->{call} :  pc92 call entry '$_' not decoded, ignored") if isdbg('chanerr') || isdbg('route');
2307                                 }
2308                         }
2309
2310                         my ($dnodes, $dusers, $nnodes, $nusers) = $parent->calc_config_changes(\@nodes, \@users);
2311
2312                         # add users here
2313                         foreach my $r (@nent) {
2314                                 my $call = $r->[0];
2315                                 if ($call) {
2316                                         push @radd,_add_thingy($parent, $r, $self, $hops) if grep $call eq $_, (@$nnodes, @$nusers);
2317                                 }
2318                         }
2319                         # del users here
2320                         foreach my $r (@$dnodes) {
2321                                 push @rdel,_del_thingy($parent, [$r, 1], $self);
2322                         }
2323                         foreach my $r (@$dusers) {
2324                                 push @rdel,_del_thingy($parent, [$r, 0], $self);
2325                         }
2326
2327                         # remember this last PC92C for rebroadcast on demand
2328                         $parent->last_PC92C($line);
2329                 } else {
2330                         dbg("PCPROT: unknown action '$sort', ignored") if isdbg('chanerr');
2331                         return;
2332                 }
2333
2334                 foreach my $r (@rdel) {
2335                         next unless $r;
2336
2337                         $self->route_pc21($pcall, undef, $r) if $r->isa('Route::Node');
2338                         $self->route_pc17($pcall, undef, $parent, $r) if $r->isa('Route::User');
2339                 }
2340                 my @pc19 = grep { $_ && $_->isa('Route::Node') } @radd;
2341                 my @pc16 = grep { $_ && $_->isa('Route::User') } @radd;
2342                 unshift @pc19, $parent if $self->{state} eq 'init92' && $oparent == $parent;
2343                 $self->route_pc19($pcall, undef, @pc19) if @pc19;
2344                 $self->route_pc16($pcall, undef, $parent, @pc16) if @pc16;
2345         }
2346
2347         # broadcast it if we get here (but not if it's an A or D record and pc92_ad_enabled isn't set;
2348         if ($sort eq 'A' || $sort eq 'D') {
2349                 return unless $pc92_ad_enabled;
2350         }
2351         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
2352 }
2353
2354 # get all the routes for a thing, bearing in mind that the thing (e.g. a user)
2355 # might be on two or more nodes at the same time or that there may be more than
2356 # one equal distance neighbour to a node.
2357 #
2358 # What this means that if sh/route g1tlh shows that he is on (say) two nodes, then
2359 # a Route::findroutes is done on each of those two nodes, the best route(s) taken from
2360 # each and then combined to give a set of dxchans to send the PC9x record down
2361 #
2362 sub find_pc9x_routes
2363 {
2364         my $to = shift;
2365         my $ref = Route::get($to);
2366         my @parent;
2367         my %cand;
2368
2369         if ($ref->isa('Route::User')) {
2370                 my $dxchan = DXChannel::get($to);
2371                 push @parent, $to if $dxchan;
2372                 push @parent, $ref->parents;
2373         } else {
2374                 @parent = $to;
2375         }
2376         foreach my $p (@parent) {
2377                 my $lasthops;
2378                 my @routes = Route::findroutes($p);
2379                 foreach my $r (@routes) {
2380                         $lasthops = $r->[0] unless defined $lasthops;
2381                         if ($r->[0] == $lasthops) {
2382                                 $cand{$r->[1]->call} = $r->[1];
2383                         } else {
2384                                 last;
2385                         }
2386                 }
2387         }
2388         return values %cand;
2389 }
2390
2391 sub handle_93
2392 {
2393         my $self = shift;
2394         my $pcno = shift;
2395         my $line = shift;
2396         my $origin = shift;
2397         my $pc = shift;
2398
2399 #       $self->{do_pc9x} ||= 1;
2400
2401         my $pcall = $pc->[1];                   # this is now checked earlier
2402
2403         # remember that we are converting PC10->PC93 and self will be $main::me if it
2404         # comes from us
2405         unless ($self->{do_pc9x}) {
2406                 dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
2407                 return;
2408         }
2409
2410         my $t = $pc->[2];
2411         my $parent = check_pc9x_t($pcall, $t, 93, 1) || return;
2412
2413         my $to = uc $pc->[3];
2414         my $from = uc $pc->[4];
2415         my $via = uc $pc->[5];
2416         my $text = $pc->[6];
2417         my $onode = uc $pc->[7];
2418         my $ipaddr = $pc->[8];
2419
2420         $onode = undef unless $onode && is_callsign($onode);
2421         $onode //= $pcall;
2422         $ipaddr = undef unless $ipaddr && is_ipaddr($ipaddr);
2423
2424         # this is catch loops caused by bad software ...
2425         if (eph_dup("PC93|$from|$text|$onode", $pc10_dupe_age)) {
2426                 return;
2427         }
2428
2429         if (isdbg('progress')) {
2430                 my $vs = $via ne '*' ? " via $via" : '';
2431                 my $s = "ANNTALK: $from\@$onode$vs -> $to '$text' route: $origin";
2432                 dbg($s);
2433         }
2434
2435         # if this is a 'bad spotter' user then ignore it
2436         my $nossid = $from;
2437         $nossid =~ s/-\d+$//;
2438         if ($badspotter->in($nossid)) {
2439                 dbg($line) if isdbg('nologchan');
2440                 dbg("PCPROT: Bad Spotter, dropped");
2441                 return;
2442         }
2443
2444         # ignore PC93 coming in from outside this node with a target of local
2445         if ($to eq 'LOCAL' && $self != $main::me) {
2446                 dbg("PCPROT: incoming LOCAL chat not from local node, ignored") if isdbg('chanerr');
2447                 return;
2448         }
2449
2450         # will we allow it at all?
2451         if ($censorpc) {
2452                 my @bad;
2453                 if (@bad = BadWords::check($text)) {
2454                         my $bw = join ', ', @bad;
2455                         dbg($line) if isdbg('nologchan');
2456                         dbg("PCPROT: Badwords: '$bw', dropped");
2457                         return;
2458                 }
2459         }
2460
2461         $self->populate_routing_table($onode, $from, $ipaddr) if $pc61_extract_route;
2462
2463         # if it is routeable then then treat it like a talk
2464         my $ref = Route::get($to);
2465         if ($ref) {
2466                 my $dxchan;
2467
2468                 # convert to PC10 or local talks where appropriate
2469                 # PC93 capable nodes of the same hop count all get a copy
2470                 # if there is a PC10 node then it will get a copy and that
2471                 # will be it. Hopefully such a node will not figure highly
2472                 # in the route list, unless it is local, 'cos it don't issue PC92s!
2473                 # note that both local and PC93s at the same time are possible if the
2474                 # user on more than one node.
2475                 my @routes = find_pc9x_routes($to);
2476                 my $lasthops;
2477                 foreach $dxchan (@routes) {
2478                         if (ref $dxchan && $dxchan->isa('DXChannel')) {
2479                                 if ($dxchan->{do_pc9x}) {
2480                                         $dxchan->send($line);
2481                                 } else {
2482                                         $dxchan->talk($from, $to, $via, $text, $onode);
2483                                 }
2484                         } else {
2485                                 dbg("ERROR: $to -> $dxchan is not a DXChannel! (convert to pc10)");
2486                         }
2487                 }
2488                 return;
2489
2490         } elsif ($to eq '*' || $to eq 'SYSOP' || $to eq 'WX') {
2491                 # announces
2492                 my $sysop = $to eq 'SYSOP' ? '*' : ' ';
2493                 my $wx = $to eq 'WX' ? '1' : '0';
2494                 my $local = $via eq 'LOCAL' ? '*' : $via;
2495
2496                 $self->send_announce(1, pc12($from, $text, $local, $sysop, $wx, $pcall), $from, $local, $text, $sysop, $pcall, $wx, $via eq 'LOCAL' ? $via : undef);
2497                 return if $via eq 'LOCAL';
2498         } elsif (!is_callsign($to) && $text =~ /^#\d+ /) {
2499                 # chat messages really only locally connected users
2500                 $self->send_chat(1, $line, $from, '*', $text, $to, $pcall, '0');
2501         }
2502
2503         # broadcast this chat sentence everywhere unless it is targetted to 'LOCAL'
2504         $self->broadcast_route_pc9x($pcall, undef, $line, 0) unless $to eq 'LOCAL' || $via eq 'LOCAL';
2505 }
2506
2507 # if get here then rebroadcast the thing with its Hop count decremented (if
2508 # there is one). If it has a hop count and it decrements to zero then don't
2509 # rebroadcast it.
2510 #
2511 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
2512 #        REBROADCAST!!!!
2513 #
2514
2515 sub handle_default
2516 {
2517         my $self = shift;
2518         my $pcno = shift;
2519         my $line = shift;
2520         my $origin = shift;
2521         my $pc = shift;
2522
2523         unless (eph_dup($line)) {
2524                 if ($pcno >= 90) {
2525                         my $pcall = $pc->[1];
2526                         unless (is_callsign($pcall)) {
2527                                 dbg("PCPROT: invalid callsign string '$pc->[1]', ignored") if isdbg('chanerr');
2528                                 return;
2529                         }
2530                         my $t = $pc->[2];
2531                         my $parent = check_pc9x_t($pcall, $t, $pcno, 1) || return;
2532                         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
2533                 } else {
2534                         unless ($self->{isolate}) {
2535                                 DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me
2536                         }
2537                 }
2538         }
2539 }
2540
2541 # does what it says on the tin..
2542 sub populate_routing_table
2543 {
2544         my ($self, $node, $user, $ip) = @_;
2545
2546         my $rn = Route::Node::get($node);
2547         unless ($rn) {
2548                 $rn = Route::Node->new($node);
2549                 dbg("ROUTE $self->{call}: ADD NEW node: $node") if isdbg('pc11');
2550         }
2551
2552         my $ru;
2553         if ($user ne $node) {
2554                 $ru = Route::User::get($user);
2555                 unless ($ru) {
2556                         $rn->add_user($user, 0, undef);
2557                         dbg("ROUTE $self->{call}: ADD NEW user: $user -> $node") if isdbg('pc11');
2558                 }
2559                 $ru = Route::User::get($user);
2560         }
2561
2562         # Add/Change any IP address info
2563
2564         # as we have a route to a user, if it (or the node) does not exist then create them
2565         # link the user to the node if not already done.
2566         # then add or alter the IP address
2567         if ($ip && is_ipaddr($ip)) {
2568                 my $new = $ip;
2569                 if ($ru) {
2570                         if ($ru->ip ne $new) {
2571                                 if ($ru->ip) {
2572                                         my $old = $ru->ip;
2573                                         $ru->ip($new);
2574                                         dbg("ROUTE $self->{call}: ALTER IP node: $node user: $user old IP: '$old'-> new IP: '$new'") if isdbg('pc11');
2575                                 } else{
2576                                         $ru->ip($new);
2577                                         dbg("ROUTE $self->{call}: NEW IP node: $node user: $user IP: '$new'") if isdbg('pc11');
2578                                 }
2579                         }
2580                 } else {
2581                         dbg("ROUTE $self->{call}: ADD Failed for node $node user $user") if isdbg('pc11');
2582                 }
2583         }
2584 }
2585
2586 1;