perl/DXProtHandle.pm

   1 #
   2 #
   3 # This module impliments the handlers for the protocal mode for a dx cluster
   4 #
   5 # Copyright (c) 1998-2006 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 RouteDB;
  36
  37
  38 use strict;
  39
  40 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
  41                         $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
  42                         $pingint $obscount %pc19list $chatdupeage $chatimportfn
  43                         $investigation_int $pc19_version $myprot_version
  44                         %nodehops $baddx $badspotter $badnode $censorpc
  45                         $allowzero $decode_dk0wcy $send_opernam @checklist
  46                         $eph_pc15_restime $pc9x_past_age $pc9x_future_age
  47                         $pc10_dupe_age
  48                    );
  49
  50 $pc9x_past_age = 62*60;                 # maximum age in the past of a px9x (a config record might be the only
  51                                                                 # thing a node might send - once an hour)
  52 $pc9x_future_age = 5*60;                # maximum age in the future ditto
  53 $pc10_dupe_age = 45;                    # just something to catch duplicate PC10->PC93 conversions
  54
  55
  56 # incoming talk commands
  57 sub handle_10
  58 {
  59         my $self = shift;
  60         my $pcno = shift;
  61         my $line = shift;
  62         my $origin = shift;
  63
  64         # this is to catch loops caused by bad software ...
  65         if (eph_dup($line, $pc10_dupe_age)) {
  66                 return;
  67         }
  68
  69         # will we allow it at all?
  70         if ($censorpc) {
  71                 my @bad;
  72                 if (@bad = BadWords::check($_[3])) {
  73                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
  74                         return;
  75                 }
  76         }
  77
  78         # is it for me or one of mine?
  79         my ($from, $to, $via, $call, $dxchan);
  80         $from = $_[1];
  81         if ($_[5] gt ' ') {
  82                 $via = $_[2];
  83                 $to = $_[5];
  84         } else {
  85                 $to = $_[2];
  86         }
  87
  88         # if this is a 'nodx' node then ignore it
  89         if ($badnode->in($_[6]) || ($via && $badnode->in($via))) {
  90                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
  91                 return;
  92         }
  93
  94         # if this is a 'bad spotter' user then ignore it
  95         my $nossid = $from;
  96         $nossid =~ s/-\d+$//;
  97         if ($badspotter->in($nossid)) {
  98                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
  99                 return;
 100         }
 101
 102         # if we are converting announces to talk is it a dup?
 103         if ($ann_to_talk) {
 104                 if (AnnTalk::is_talk_candidate($from, $_[3]) && AnnTalk::dup($from, $to, $_[3])) {
 105                         dbg("PCPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
 106                         return;
 107                 }
 108         }
 109
 110         # remember a route to this node and also the node on which this user is
 111         RouteDB::update($_[6], $self->{call});
 112 #       RouteDB::update($to, $_[6]);
 113
 114         # convert this to a PC93, coming from mycall with origin set and process it as such
 115         $main::me->normal(pc93($to, $from, $via, $_[3], $_[6]));
 116 }
 117
 118 # DX Spot handling
 119 sub handle_11
 120 {
 121         my $self = shift;
 122         my $pcno = shift;
 123         my $line = shift;
 124         my $origin = shift;
 125
 126         # route 'foreign' pc26s
 127         if ($pcno == 26) {
 128                 if ($_[7] ne $main::mycall) {
 129                         $self->route($_[7], $line);
 130                         return;
 131                 }
 132         }
 133
 134         # is the spotted callsign blank? This should really be trapped earlier but it
 135         # could break other protocol sentences. Also check for lower case characters.
 136         if ($_[2] =~ /^\s*$/) {
 137                 dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr');
 138                 return;
 139         }
 140         if ($_[2] =~ /[a-z]/) {
 141                 dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr');
 142                 return;
 143         }
 144
 145
 146         # if this is a 'nodx' node then ignore it
 147         if ($badnode->in($_[7])) {
 148                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
 149                 return;
 150         }
 151
 152         # if this is a 'bad spotter' user then ignore it
 153         my $nossid = $_[6];
 154         $nossid =~ s/-\d+$//;
 155         if ($badspotter->in($nossid)) {
 156                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
 157                 return;
 158         }
 159
 160         # convert the date to a unix date
 161         my $d = cltounix($_[3], $_[4]);
 162         # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
 163         if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
 164                 dbg("PCPROT: Spot ignored, invalid date or out of range ($_[3] $_[4])\n") if isdbg('chanerr');
 165                 return;
 166         }
 167
 168         # is it 'baddx'
 169         if ($baddx->in($_[2]) || BadWords::check($_[2]) || $_[2] =~ /COCK/) {
 170                 dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr');
 171                 return;
 172         }
 173
 174         # do some de-duping
 175         $_[5] =~ s/^\s+//;                      # take any leading blanks off
 176         $_[2] = unpad($_[2]);           # take off leading and trailing blanks from spotted callsign
 177         if ($_[2] =~ /BUST\w*$/) {
 178                 dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr');
 179                 return;
 180         }
 181         if ($censorpc) {
 182                 my @bad;
 183                 if (@bad = BadWords::check($_[5])) {
 184                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
 185                         return;
 186                 }
 187         }
 188
 189         # remember a route
 190 #       RouteDB::update($_[7], $self->{call});
 191 #       RouteDB::update($_[6], $_[7]);
 192
 193         my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]);
 194         # global spot filtering on INPUT
 195         if ($self->{inspotsfilter}) {
 196                 my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
 197                 unless ($filter) {
 198                         dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr');
 199                         return;
 200                 }
 201         }
 202
 203         # this goes after the input filtering, but before the add
 204         # so that if it is input filtered, it isn't added to the dup
 205         # list. This allows it to come in from a "legitimate" source
 206         if (Spot::dup(@spot[0..4,5])) {
 207                 dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
 208                 return;
 209         }
 210
 211         # add it
 212         Spot::add(@spot);
 213
 214         #
 215         # @spot at this point contains:-
 216         # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
 217         # then  spotted itu, spotted cq, spotters itu, spotters cq
 218         # you should be able to route on any of these
 219         #
 220
 221         # fix up qra locators of known users
 222         my $user = DXUser->get_current($spot[4]);
 223         if ($user) {
 224                 my $qra = $user->qra;
 225                 unless ($qra && is_qra($qra)) {
 226                         my $lat = $user->lat;
 227                         my $long = $user->long;
 228                         if (defined $lat && defined $long) {
 229                                 $user->qra(DXBearing::lltoqra($lat, $long));
 230                                 $user->put;
 231                         }
 232                 }
 233
 234                 # send a remote command to a distant cluster if it is visible and there is no
 235                 # qra locator and we havn't done it for a month.
 236
 237                 unless ($user->qra) {
 238                         my $node;
 239                         my $to = $user->homenode;
 240                         my $last = $user->lastoper || 0;
 241                         if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) {
 242                                 my $cmd = "forward/opernam $spot[4]";
 243                                 # send the rcmd but we aren't interested in the replies...
 244                                 my $dxchan = $node->dxchan;
 245                                 if ($dxchan && $dxchan->is_clx) {
 246                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 247                                 } else {
 248                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 249                                 }
 250                                 if ($to ne $_[7]) {
 251                                         $to = $_[7];
 252                                         $node = Route::Node::get($to);
 253                                         if ($node) {
 254                                                 $dxchan = $node->dxchan;
 255                                                 if ($dxchan && $dxchan->is_clx) {
 256                                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 257                                                 } else {
 258                                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 259                                                 }
 260                                         }
 261                                 }
 262                                 $user->lastoper($main::systime);
 263                                 $user->put;
 264                         }
 265                 }
 266         }
 267
 268         # local processing
 269         my $r;
 270         eval {
 271                 $r = Local::spot($self, @spot);
 272         };
 273         #                       dbg("Local::spot1 error $@") if isdbg('local') if $@;
 274         return if $r;
 275
 276         # DON'T be silly and send on PC26s!
 277         return if $pcno == 26;
 278
 279         # send out the filtered spots
 280         send_dx_spot($self, $line, @spot) if @spot;
 281 }
 282
 283 # announces
 284 sub handle_12
 285 {
 286         my $self = shift;
 287         my $pcno = shift;
 288         my $line = shift;
 289         my $origin = shift;
 290
 291         # announce duplicate checking
 292         $_[3] =~ s/^\s+//;                      # remove leading blanks
 293
 294         if ($censorpc) {
 295                 my @bad;
 296                 if (@bad = BadWords::check($_[3])) {
 297                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
 298                         return;
 299                 }
 300         }
 301
 302         # if this is a 'nodx' node then ignore it
 303         if ($badnode->in($_[5])) {
 304                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
 305                 return;
 306         }
 307
 308         # if this is a 'bad spotter' user then ignore it
 309         my $nossid = $_[1];
 310         $nossid =~ s/-\d+$//;
 311         if ($badspotter->in($nossid)) {
 312                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
 313                 return;
 314         }
 315
 316
 317         my $dxchan;
 318
 319         if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
 320                 $self->send_chat(0, $line, @_[1..6]);
 321         } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
 322
 323                 # remember a route
 324 #               RouteDB::update($_[5], $self->{call});
 325 #               RouteDB::update($_[1], $_[5]);
 326
 327                 # ignore something that looks like a chat line coming in with sysop
 328                 # flag - this is a kludge...
 329                 if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') {
 330                         dbg('PCPROT: Probable chat rewrite, dropped') if isdbg('chanerr');
 331                         return;
 332                 }
 333
 334                 # here's a bit of fun, convert incoming ann with a callsign in the first word
 335                 # or one saying 'to <call>' to a talk if we can route to the recipient
 336                 if ($ann_to_talk) {
 337                         my $call = AnnTalk::is_talk_candidate($_[1], $_[3]);
 338                         if ($call) {
 339                                 my $ref = Route::get($call);
 340                                 if ($ref) {
 341                                         $dxchan = $ref->dxchan;
 342                                         $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self;
 343                                         return;
 344                                 }
 345                         }
 346                 }
 347
 348                 # send it
 349                 $self->send_announce(0, $line, @_[1..6]);
 350         } else {
 351                 $self->route($_[2], $line);
 352         }
 353 }
 354
 355 sub handle_15
 356 {
 357         my $self = shift;
 358         my $pcno = shift;
 359         my $line = shift;
 360         my $origin = shift;
 361
 362         if (eph_dup($line, $eph_pc15_restime)) {
 363                 return;
 364         } else {
 365                 unless ($self->{isolate}) {
 366                         DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me
 367                 }
 368         }
 369 }
 370
 371 # incoming user
 372 sub handle_16
 373 {
 374         my $self = shift;
 375         my $pcno = shift;
 376         my $line = shift;
 377         my $origin = shift;
 378
 379         # general checks
 380         my $dxchan;
 381         my $ncall = $_[1];
 382         my $newline = "PC16^";
 383
 384         # dos I want users from this channel?
 385         unless ($self->user->wantpc16) {
 386                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 387                 return;
 388         }
 389
 390         # is it me?
 391         if ($ncall eq $main::mycall) {
 392                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 393                 return;
 394         }
 395
 396         my $h;
 397         $h = 1 if DXChannel::get($ncall);
 398         RouteDB::update($ncall, $self->{call}, $h);
 399         if ($h && $self->{call} ne $ncall) {
 400                 dbg("PCPROT: trying to update a local node, ignored") if isdbg('chanerr');
 401                 return;
 402         }
 403
 404         if (eph_dup($line)) {
 405                 return;
 406         }
 407
 408         # isolate now means only accept stuff from this call only
 409         if ($self->{isolate} && $ncall ne $self->{call}) {
 410                 dbg("PCPROT: $self->{call} isolated, $ncall ignored") if isdbg('chanerr');
 411                 return;
 412         }
 413
 414         my $parent = Route::Node::get($ncall);
 415
 416         if ($parent) {
 417                 $dxchan = $parent->dxchan;
 418                 if ($dxchan && $dxchan ne $self) {
 419                         dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 420                         return;
 421                 }
 422
 423                 # input filter if required
 424                 return unless $self->in_filter_route($parent);
 425         } else {
 426                 $parent = Route::Node->new($ncall);
 427         }
 428
 429         unless ($h) {
 430                 if ($parent->via_pc92) {
 431                         dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
 432                         return;
 433                 }
 434         }
 435
 436         my $i;
 437         my @rout;
 438         for ($i = 2; $i < $#_; $i++) {
 439                 my ($call, $conf, $here) = $_[$i] =~ /^(\S+) (\S) (\d)/o;
 440                 next unless $call && $conf && defined $here && is_callsign($call);
 441                 next if $call eq $main::mycall;
 442
 443                 eph_del_regex("^PC17\\^$call\\^$ncall");
 444
 445                 $conf = $conf eq '*';
 446
 447                 # reject this if we think it is a node already
 448                 my $r = Route::Node::get($call);
 449                 my $u = DXUser->get_current($call) unless $r;
 450                 if ($r || ($u && $u->is_node)) {
 451                         dbg("PCPROT: $call is a node") if isdbg('chanerr');
 452                         next;
 453                 }
 454
 455                 $r = Route::User::get($call);
 456                 my $flags = Route::here($here)|Route::conf($conf);
 457
 458                 if ($r) {
 459                         my $au = $r->addparent($parent);
 460                         if ($r->flags != $flags) {
 461                                 $r->flags($flags);
 462                                 $au = $r;
 463                         }
 464                         push @rout, $r if $h && $au;
 465                 } else {
 466                         my @ans = $parent->add_user($call, $flags);
 467                         push @rout, @ans if $h && @ans;
 468                 }
 469
 470                 # add this station to the user database, if required
 471                 my $user = DXUser->get_current($ncall);
 472                 $user = DXUser->new($call) unless $user;
 473                 $user->homenode($parent->call) if !$user->homenode;
 474                 $user->node($parent->call);
 475                 $user->lastin($main::systime) unless DXChannel::get($call);
 476                 $user->put;
 477
 478                 # send info to all logged in thingies
 479                 $self->tell_login('loginu', "$ncall: $call") if $user->is_local_node;
 480                 $self->tell_buddies('loginb', $call, $ncall);
 481         }
 482         if (@rout) {
 483                 $self->route_pc16($origin, $line, $parent, @rout) if @rout;
 484 #               $self->route_pc92a($main::mycall, undef, $parent, @rout) if $h && $self->{state} eq 'normal';
 485         }
 486 }
 487
 488 # remove a user
 489 sub handle_17
 490 {
 491         my $self = shift;
 492         my $pcno = shift;
 493         my $line = shift;
 494         my $origin = shift;
 495         my $dxchan;
 496         my $ncall = $_[2];
 497         my $ucall = $_[1];
 498
 499         eph_del_regex("^PC16\\^$ncall.*$ucall");
 500
 501         # do I want users from this channel?
 502         unless ($self->user->wantpc16) {
 503                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 504                 return;
 505         }
 506
 507         if ($ncall eq $main::mycall) {
 508                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 509                 return;
 510         }
 511
 512         # isolate now means only accept stuff from this call only
 513         if ($self->{isolate} && $ncall ne $self->{call}) {
 514                 dbg("PCPROT: $self->{call} isolated, $ncall ignored") if isdbg('chanerr');
 515                 return;
 516         }
 517
 518         RouteDB::delete($ncall, $self->{call});
 519
 520         my $uref = Route::User::get($ucall);
 521         unless ($uref) {
 522                 dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
 523                 return;
 524         }
 525         my $parent = Route::Node::get($ncall);
 526         unless ($parent) {
 527                 dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
 528                 return;
 529         }
 530
 531         $dxchan = DXChannel::get($ncall);
 532         if ($dxchan && $dxchan ne $self) {
 533                 dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 534                 return;
 535         }
 536
 537         unless ($dxchan) {
 538                 if ($parent->via_pc92) {
 539                         dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
 540                         return;
 541                 }
 542         }
 543
 544         if (DXChannel::get($ucall)) {
 545                 dbg("PCPROT: trying do disconnect local user, ignored") if isdbg('chanerr');
 546                 return;
 547         }
 548
 549         # input filter if required and then remove user if present
 550 #               return unless $self->in_filter_route($parent);
 551         $parent->del_user($uref);
 552
 553         # send info to all logged in thingies
 554         my $user = DXUser->get_current($ncall);
 555         $self->tell_login('logoutu', "$ncall: $ucall") if $user && $user->is_local_node;
 556         $self->tell_buddies('logoutb', $ucall, $ncall);
 557
 558         if (eph_dup($line)) {
 559                 return;
 560         }
 561
 562         $self->route_pc17($origin, $line, $parent, $uref);
 563 #       $self->route_pc92d($main::mycall, undef, $parent, $uref) if $dxchan;
 564 }
 565
 566 # link request
 567 sub handle_18
 568 {
 569         my $self = shift;
 570         my $pcno = shift;
 571         my $line = shift;
 572         my $origin = shift;
 573         $self->state('init');
 574
 575         my $parent = Route::Node::get($self->{call});
 576
 577         # record the type and version offered
 578         if (my ($version) = $_[1] =~ /DXSpider Version: (\d+\.\d+)/) {
 579                 $self->{version} = 53 + $version;
 580                 $self->user->version(53 + $version);
 581                 $parent->version(0 + $version);
 582                 my ($build) = $_[1] =~ /Build: (\d+(?:\.\d+)?)/;
 583                 $self->{build} = 0 + $build;
 584                 $self->user->build(0 + $build);
 585                 $parent->build(0 + $build);
 586                 dbg("DXSpider version $version build $build");
 587                 unless ($self->is_spider) {
 588                         dbg("Change U " . $self->user->sort . " C $self->{sort} -> S");
 589                         $self->user->sort('S');
 590                         $self->user->put;
 591                         $self->sort('S');
 592                 }
 593 #               $self->{handle_xml}++ if DXXml::available() && $_[1] =~ /\bxml/;
 594                 if ($_[1] =~ /\bpc9x/) {
 595                         if ($self->{isolate}) {
 596                                 dbg("pc9x recognised, but $self->{call} is isolated, using old protocol");
 597                         } elsif (!$self->user->wantpc9x) {
 598                                 dbg("pc9x explicitly switched off on $self->{call}, using old protocol");
 599                         } else {
 600                                 $self->{do_pc9x} = 1;
 601                                 dbg("Do px9x set on $self->{call}");
 602                         }
 603                 }
 604         } else {
 605                 dbg("Unknown software");
 606                 $self->version(50.0);
 607                 $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
 608                 $self->user->version($self->version);
 609         }
 610
 611         # first clear out any nodes on this dxchannel
 612         my @rout = $parent->del_nodes;
 613         $self->route_pc21($origin, $line, @rout, $parent) if @rout;
 614         $self->send_local_config();
 615         $self->send(pc20());
 616 }
 617
 618 sub check_add_node
 619 {
 620         my $call = shift;
 621
 622         # add this station to the user database, if required (don't remove SSID from nodes)
 623         my $user = DXUser->get_current($call);
 624         if (!$user) {
 625                 $user = DXUser->new($call);
 626                 $user->priv(1);         # I have relented and defaulted nodes
 627                 $user->lockout(1);
 628                 $user->homenode($call);
 629                 $user->node($call);
 630         }
 631         $user->sort('A') unless $user->is_node;
 632         return $user;
 633 }
 634
 635 # incoming cluster list
 636 sub handle_19
 637 {
 638         my $self = shift;
 639         my $pcno = shift;
 640         my $line = shift;
 641         my $origin = shift;
 642
 643         my $i;
 644         my $newline = "PC19^";
 645
 646         # new routing list
 647         my (@rout, @pc92out);
 648
 649         # first get the INTERFACE node
 650         my $parent = Route::Node::get($self->{call});
 651         unless ($parent) {
 652                 dbg("PCPROT: my parent $self->{call} has disappeared");
 653                 $self->disconnect;
 654                 return;
 655         }
 656
 657         my $h;
 658
 659         # parse the PC19
 660         #
 661         # We are making a major change from now on. We are only going to accept
 662         # PC19s from directly connected nodes.  This means that we are probably
 663         # going to throw away most of the data that we are being sent.
 664         #
 665         # The justification for this is that most of it is wrong or out of date
 666         # anyway.
 667         #
 668         # From now on we are only going to believe PC92 data and locally connected
 669         # non-pc92 nodes.
 670         #
 671         for ($i = 1; $i < $#_-1; $i += 4) {
 672                 my $here = $_[$i];
 673                 my $call = uc $_[$i+1];
 674                 my $conf = $_[$i+2];
 675                 my $ver = $_[$i+3];
 676                 next unless defined $here && defined $conf && is_callsign($call);
 677
 678                 eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)");
 679
 680                 # check for sane parameters
 681                 #                               $ver = 5000 if $ver eq '0000';
 682                 next unless $ver && $ver =~ /^\d+$/;
 683                 next if $ver < 5000;    # only works with version 5 software
 684                 next if length $call < 3; # min 3 letter callsigns
 685                 next if $call eq $main::mycall;
 686
 687                 # check that this PC19 isn't trying to alter the wrong dxchan
 688                 $h = 0;
 689                 my $dxchan = DXChannel::get($call);
 690                 if ($dxchan) {
 691                         if ($dxchan == $self) {
 692                                 $h = 1;
 693                         } else {
 694                                 dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
 695                                 next;
 696                         }
 697                 }
 698
 699                 # isolate now means only accept stuff from this call only
 700                 if ($self->{isolate} && $call ne $self->{call}) {
 701                         dbg("PCPROT: $self->{call} isolated, $call ignored") if isdbg('chanerr');
 702                         next;
 703                 }
 704
 705                 my $user = check_add_node($call);
 706
 707 #               if (eph_dup($genline)) {
 708 #                       dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr');
 709 #                       next;
 710 #               }
 711
 712                 RouteDB::update($call, $self->{call}, $dxchan ? 1 : undef);
 713
 714                 unless ($h) {
 715                         if ($parent->via_pc92) {
 716                                 dbg("PCPROT: non-local node controlled by PC92, ignored") if isdbg('chanerr');
 717                                 next;
 718                         }
 719                 }
 720
 721                 my $r = Route::Node::get($call);
 722                 my $flags = Route::here($here)|Route::conf($conf);
 723
 724                 # modify the routing table if it is in it, otherwise store it in the pc19list for now
 725                 if ($r) {
 726                         my $ar;
 727                         if ($call ne $parent->call) {
 728                                 if ($self->in_filter_route($r)) {
 729                                         $ar = $parent->add($call, $ver, $flags);
 730 #                                       push @rout, $ar if $ar;
 731                                 } else {
 732                                         next;
 733                                 }
 734                         }
 735                         if ($r->version ne $ver || $r->flags != $flags) {
 736                                 $r->version($ver);
 737                                 $r->flags($flags);
 738                         }
 739                         push @rout, $r;
 740                 } else {
 741                         if ($call eq $self->{call} || $user->wantroutepc19) {
 742                                 my $new = Route->new($call); # throw away
 743                                 if ($self->in_filter_route($new)) {
 744                                         my $ar = $parent->add($call, $ver, $flags);
 745                                         $user->wantroutepc19(1) unless defined $user->wantroutepc19;
 746                                         push @rout, $ar if $ar;
 747                                         push @pc92out, $r if $h;
 748                                 } else {
 749                                         next;
 750                                 }
 751                         }
 752                 }
 753
 754                 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
 755                 my $mref = DXMsg::get_busy($call);
 756                 $mref->stop_msg($call) if $mref;
 757
 758                 $user->lastin($main::systime) unless DXChannel::get($call);
 759                 $user->put;
 760         }
 761
 762         # we are not automatically sending out PC19s, we send out a composite PC21,PC19 instead
 763         # but remember there will only be one (pair) these because any extras will be
 764         # thrown away.
 765         if (@rout) {
 766 #               $self->route_pc21($self->{call}, $line, @rout);
 767                 $self->route_pc19($self->{call}, $line, @rout);
 768         }
 769         if (@pc92out) {
 770                 $self->route_pc92a($main::mycall, $line, $main::routeroot, @pc92out) if $self->{state} eq 'normal';
 771         }
 772 }
 773
 774 # send local configuration
 775 sub handle_20
 776 {
 777         my $self = shift;
 778         my $pcno = shift;
 779         my $line = shift;
 780         my $origin = shift;
 781
 782         if ($self->{do_pc9x} && $self->{state} ne 'init92') {
 783                 $self->send("Reseting to oldstyle routing because login call not sent in any pc92");
 784                 $self->{do_pc9x} = 0;
 785         }
 786         $self->send_local_config;
 787         $self->send(pc22());
 788         $self->state('normal');
 789         $self->{lastping} = 0;
 790         $self->route_pc92a($main::mycall, undef, $main::routeroot, Route::Node::get($self->{call}));
 791 }
 792
 793 # delete a cluster from the list
 794 #
 795 # This should never occur for directly connected nodes.
 796 #
 797 sub handle_21
 798 {
 799         my $self = shift;
 800         my $pcno = shift;
 801         my $line = shift;
 802         my $origin = shift;
 803         my $call = uc $_[1];
 804
 805         eph_del_regex("^PC1[679].*$call");
 806
 807         # if I get a PC21 from the same callsign as self then ignore it
 808         if ($call eq $self->{call}) {
 809                 dbg("PCPROT: self referencing PC21 from $self->{call}");
 810                 return;
 811         }
 812
 813         # for the above reason and also because of the check for PC21s coming
 814         # in for self->call from outside being ignored further down
 815         # we don't need any isolation code here, because we will never
 816         # act on a PC21 with self->call in it.
 817
 818         RouteDB::delete($call, $self->{call});
 819
 820         my $parent = Route::Node::get($self->{call});
 821         unless ($parent) {
 822                 dbg("PCPROT: my parent $self->{call} has disappeared");
 823                 $self->disconnect;
 824                 return;
 825         }
 826
 827         my @rout;
 828
 829         if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
 830                 my $node = Route::Node::get($call);
 831                 if ($node) {
 832
 833                         if ($node->via_pc92) {
 834                                 dbg("PCPROT: controlled by PC92, ignored") if isdbg('chanerr');
 835                                 return;
 836                         }
 837
 838                         my $dxchan = DXChannel::get($call);
 839                         if ($dxchan && $dxchan != $self) {
 840                                 dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
 841                                 return;
 842                         }
 843
 844                         # input filter it
 845                         return unless $self->in_filter_route($node);
 846
 847                         # routing objects, force a PC21 if it is local
 848                         push @rout, $node->del($parent);
 849                         push @rout, $call if $dxchan && @rout == 0;
 850                 }
 851         } else {
 852                 dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr');
 853                 return;
 854         }
 855
 856         if (eph_dup($line)) {
 857                 return;
 858         }
 859
 860         if (@rout) {
 861                 $self->route_pc21($origin, $line, @rout);
 862 #               $self->route_pc92d($main::mycall, $line, $main::routeroot, @rout);
 863         }
 864 }
 865
 866
 867 sub handle_22
 868 {
 869         my $self = shift;
 870         my $pcno = shift;
 871         my $line = shift;
 872         my $origin = shift;
 873
 874         if ($self->{do_pc9x}) {
 875                 if ($self->{state} ne 'init92') {
 876                         $self->send("Reseting to oldstyle routing because login call not sent in any pc92");
 877                         $self->{do_pc9x} = 0;
 878                 }
 879         }
 880         $self->{lastping} = 0;
 881         $self->state('normal');
 882         $self->route_pc92a($main::mycall, undef, $main::routeroot, Route::Node::get($self->{call}));
 883 }
 884
 885 # WWV info
 886 sub handle_23
 887 {
 888         my $self = shift;
 889         my $pcno = shift;
 890         my $line = shift;
 891         my $origin = shift;
 892
 893         # route foreign' pc27s
 894         if ($pcno == 27) {
 895                 if ($_[8] ne $main::mycall) {
 896                         $self->route($_[8], $line);
 897                         return;
 898                 }
 899         }
 900
 901
 902         # do some de-duping
 903         my $d = cltounix($_[1], sprintf("%02d18Z", $_[2]));
 904         my $sfi = unpad($_[3]);
 905         my $k = unpad($_[4]);
 906         my $i = unpad($_[5]);
 907         my ($r) = $_[6] =~ /R=(\d+)/;
 908         $r = 0 unless $r;
 909         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) {
 910                 dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr');
 911                 return;
 912         }
 913
 914         # global wwv filtering on INPUT
 915         my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]);
 916         if ($self->{inwwvfilter}) {
 917                 my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc);
 918                 unless ($filter) {
 919                         dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
 920                         return;
 921                 }
 922         }
 923         $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
 924         if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) {
 925                 dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
 926                 return;
 927         }
 928
 929         # note this only takes the first one it gets
 930         Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
 931
 932         my $rep;
 933         eval {
 934                 $rep = Local::wwv($self, $_[1], $_[2], $sfi, $k, $i, @_[6..8], $r);
 935         };
 936         #                       dbg("Local::wwv2 error $@") if isdbg('local') if $@;
 937         return if $rep;
 938
 939         # DON'T be silly and send on PC27s!
 940         return if $pcno == 27;
 941
 942         # broadcast to the eager world
 943         send_wwv_spot($self, $line, $d, $_[2], $sfi, $k, $i, @_[6..8]);
 944 }
 945
 946 # set here status
 947 sub handle_24
 948 {
 949         my $self = shift;
 950         my $pcno = shift;
 951         my $line = shift;
 952         my $origin = shift;
 953         my $call = uc $_[1];
 954         my ($nref, $uref);
 955         $nref = Route::Node::get($call);
 956         $uref = Route::User::get($call);
 957         return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on
 958
 959         if (eph_dup($line)) {
 960                 return;
 961         }
 962
 963         $nref->here($_[2]) if $nref;
 964         $uref->here($_[2]) if $uref;
 965         my $ref = $nref || $uref;
 966         return unless $self->in_filter_route($ref);
 967
 968         $self->route_pc24($origin, $line, $ref, $_[3]);
 969 }
 970
 971 # merge request
 972 sub handle_25
 973 {
 974         my $self = shift;
 975         my $pcno = shift;
 976         my $line = shift;
 977         my $origin = shift;
 978         if ($_[1] ne $main::mycall) {
 979                 $self->route($_[1], $line);
 980                 return;
 981         }
 982         if ($_[2] eq $main::mycall) {
 983                 dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr');
 984                 return;
 985         }
 986
 987         Log('DXProt', "Merge request for $_[3] spots and $_[4] WWV from $_[2]");
 988
 989         # spots
 990         if ($_[3] > 0) {
 991                 my @in = reverse Spot::search(1, undef, undef, 0, $_[3]);
 992                 my $in;
 993                 foreach $in (@in) {
 994                         $self->send(pc26(@{$in}[0..4], $_[2]));
 995                 }
 996         }
 997
 998         # wwv
 999         if ($_[4] > 0) {
1000                 my @in = reverse Geomag::search(0, $_[4], time, 1);
1001                 my $in;
1002                 foreach $in (@in) {
1003                         $self->send(pc27(@{$in}[0..5], $_[2]));
1004                 }
1005         }
1006 }
1007
1008 sub handle_26 {goto &handle_11}
1009 sub handle_27 {goto &handle_23}
1010
1011 # mail/file handling
1012 sub handle_28
1013 {
1014         my $self = shift;
1015         my $pcno = shift;
1016         my $line = shift;
1017         my $origin = shift;
1018         if ($_[1] eq $main::mycall) {
1019                 no strict 'refs';
1020                 my $sub = "DXMsg::handle_$pcno";
1021                 &$sub($self, @_);
1022         } else {
1023                 $self->route($_[1], $line) unless $self->is_clx;
1024         }
1025 }
1026
1027 sub handle_29 {goto &handle_28}
1028 sub handle_30 {goto &handle_28}
1029 sub handle_31 {goto &handle_28}
1030 sub handle_32 {goto &handle_28}
1031 sub handle_33 {goto &handle_28}
1032
1033 sub handle_34
1034 {
1035         my $self = shift;
1036         my $pcno = shift;
1037         my $line = shift;
1038         my $origin = shift;
1039         if (eph_dup($line, $eph_pc34_restime)) {
1040                 return;
1041         } else {
1042                 $self->process_rcmd($_[1], $_[2], $_[2], $_[3]);
1043         }
1044 }
1045
1046 # remote command replies
1047 sub handle_35
1048 {
1049         my $self = shift;
1050         my $pcno = shift;
1051         my $line = shift;
1052         my $origin = shift;
1053         eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^");
1054         $self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]);
1055 }
1056
1057 sub handle_36 {goto &handle_34}
1058
1059 # database stuff
1060 sub handle_37
1061 {
1062         my $self = shift;
1063         my $pcno = shift;
1064         my $line = shift;
1065         my $origin = shift;
1066         if ($_[1] eq $main::mycall) {
1067                 no strict 'refs';
1068                 my $sub = "DXDb::handle_$pcno";
1069                 &$sub($self, @_);
1070         } else {
1071                 $self->route($_[1], $line) unless $self->is_clx;
1072         }
1073 }
1074
1075 # node connected list from neighbour
1076 sub handle_38
1077 {
1078         my $self = shift;
1079         my $pcno = shift;
1080         my $line = shift;
1081         my $origin = shift;
1082 }
1083
1084 # incoming disconnect
1085 sub handle_39
1086 {
1087         my $self = shift;
1088         my $pcno = shift;
1089         my $line = shift;
1090         my $origin = shift;
1091         if ($_[1] eq $self->{call}) {
1092                 $self->disconnect(1);
1093         } else {
1094                 dbg("PCPROT: came in on wrong channel") if isdbg('chanerr');
1095         }
1096 }
1097
1098 sub handle_40 {goto &handle_28}
1099
1100 # user info
1101 sub handle_41
1102 {
1103         my $self = shift;
1104         my $pcno = shift;
1105         my $line = shift;
1106         my $origin = shift;
1107         my $call = $_[1];
1108         my $sort = $_[2];
1109         my $val = $_[3];
1110
1111         my $l = "PC41^$call^$sort";
1112         if (eph_dup($l, $eph_info_restime)) {
1113                 return;
1114         }
1115
1116         # input filter if required
1117         #                       my $ref = Route::get($call) || Route->new($call);
1118         #                       return unless $self->in_filter_route($ref);
1119
1120         if ($val eq $sort || $val =~ /^\s*$/) {
1121                 dbg('PCPROT: invalid value') if isdbg('chanerr');
1122                 return;
1123         }
1124
1125         # add this station to the user database, if required
1126         my $user = DXUser->get_current($call);
1127         $user = DXUser->new($call) unless $user;
1128
1129         if ($sort == 1) {
1130                 if (($val =~ /spotter/i || $val =~ /self/i) && $user->name && $user->name ne $val) {
1131                         dbg("PCPROT: invalid name") if isdbg('chanerr');
1132                         if ($main::mycall eq 'GB7DJK' || $main::mycall eq 'GB7BAA' || $main::mycall eq 'WR3D') {
1133                                 DXChannel::broadcast_nodes(pc41($_[1], 1, $user->name)); # send it to everyone including me
1134                         }
1135                         return;
1136                 }
1137                 $user->name($val);
1138         } elsif ($sort == 2) {
1139                 $user->qth($val);
1140         } elsif ($sort == 3) {
1141                 if (is_latlong($val)) {
1142                         my ($lat, $long) = DXBearing::stoll($val);
1143                         $user->lat($lat) if $lat;
1144                         $user->long($long) if $long;
1145                         $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra;
1146                 } else {
1147                         dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
1148                         return;
1149                 }
1150         } elsif ($sort == 4) {
1151                 $user->homenode($val);
1152         } elsif ($sort == 5) {
1153                 if (is_qra(uc $val)) {
1154                         my ($lat, $long) = DXBearing::qratoll(uc $val);
1155                         $user->lat($lat) if $lat && !$user->lat;
1156                         $user->long($long) if $long && !$user->long;
1157                         $user->qra(uc $val);
1158                 } else {
1159                         dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
1160                         return;
1161                 }
1162         }
1163         $user->lastoper($main::systime); # to cut down on excessive for/opers being generated
1164         $user->put;
1165
1166         unless ($self->{isolate}) {
1167                 DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
1168         }
1169
1170         #  perhaps this IS what we want after all
1171         #                       $self->route_pc41($ref, $call, $sort, $val, $_[4]);
1172 }
1173
1174 sub handle_42 {goto &handle_28}
1175
1176
1177 # database
1178 sub handle_44 {goto &handle_37}
1179 sub handle_45 {goto &handle_37}
1180 sub handle_46 {goto &handle_37}
1181 sub handle_47 {goto &handle_37}
1182 sub handle_48 {goto &handle_37}
1183
1184 # message and database
1185 sub handle_49
1186 {
1187         my $self = shift;
1188         my $pcno = shift;
1189         my $line = shift;
1190         my $origin = shift;
1191
1192         if (eph_dup($line)) {
1193                 return;
1194         }
1195
1196         if ($_[1] eq $main::mycall) {
1197                 DXMsg::handle_49($self, @_);
1198         } else {
1199                 $self->route($_[1], $line) unless $self->is_clx;
1200         }
1201 }
1202
1203 # keep alive/user list
1204 sub handle_50
1205 {
1206         my $self = shift;
1207         my $pcno = shift;
1208         my $line = shift;
1209         my $origin = shift;
1210
1211         my $call = $_[1];
1212
1213         RouteDB::update($call, $self->{call});
1214
1215         my $node = Route::Node::get($call);
1216         if ($node) {
1217                 return unless $node->call eq $self->{call};
1218                 $node->usercount($_[2]);
1219
1220                 # input filter if required
1221                 return unless $self->in_filter_route($node);
1222
1223                 $self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line);
1224         }
1225 }
1226
1227 # incoming ping requests/answers
1228 sub handle_51
1229 {
1230         my $self = shift;
1231         my $pcno = shift;
1232         my $line = shift;
1233         my $origin = shift;
1234         my $to = $_[1];
1235         my $from = $_[2];
1236         my $flag = $_[3];
1237
1238
1239         # is it for us?
1240         if ($to eq $main::mycall) {
1241                 if ($flag == 1) {
1242                         $self->send(pc51($from, $to, '0'));
1243                 } else {
1244                         DXXml::Ping::handle_ping_reply($self, $from);
1245                 }
1246         } else {
1247
1248                 RouteDB::update($from, $self->{call});
1249
1250                 if (eph_dup($line)) {
1251                         return;
1252                 }
1253                 # route down an appropriate thingy
1254                 $self->route($to, $line);
1255         }
1256 }
1257
1258 # dunno but route it
1259 sub handle_75
1260 {
1261         my $self = shift;
1262         my $pcno = shift;
1263         my $line = shift;
1264         my $origin = shift;
1265         my $call = $_[1];
1266         if ($call ne $main::mycall) {
1267                 $self->route($call, $line);
1268         }
1269 }
1270
1271 # WCY broadcasts
1272 sub handle_73
1273 {
1274         my $self = shift;
1275         my $pcno = shift;
1276         my $line = shift;
1277         my $origin = shift;
1278         my $call = $_[1];
1279
1280         # do some de-duping
1281         my $d = cltounix($call, sprintf("%02d18Z", $_[2]));
1282         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) {
1283                 dbg("PCPROT: WCY Date ($call $_[2]) out of range") if isdbg('chanerr');
1284                 return;
1285         }
1286         @_ = map { unpad($_) } @_;
1287         if (WCY::dup($d)) {
1288                 dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr');
1289                 return;
1290         }
1291
1292         my $wcy = WCY::update($d, @_[2..12]);
1293
1294         my $rep;
1295         eval {
1296                 $rep = Local::wcy($self, @_[1..12]);
1297         };
1298         # dbg("Local::wcy error $@") if isdbg('local') if $@;
1299         return if $rep;
1300
1301         # broadcast to the eager world
1302         send_wcy_spot($self, $line, $d, @_[2..12]);
1303 }
1304
1305 # remote commands (incoming)
1306 sub handle_84
1307 {
1308         my $self = shift;
1309         my $pcno = shift;
1310         my $line = shift;
1311         my $origin = shift;
1312         $self->process_rcmd($_[1], $_[2], $_[3], $_[4]);
1313 }
1314
1315 # remote command replies
1316 sub handle_85
1317 {
1318         my $self = shift;
1319         my $pcno = shift;
1320         my $line = shift;
1321         my $origin = shift;
1322         $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]);
1323 }
1324
1325 # decode a pc92 call: flag call : version : build
1326 sub _decode_pc92_call
1327 {
1328         my $icall = shift;
1329         my @part = split /:/, $icall;
1330         my ($flag, $call) = unpack "A A*", $part[0];
1331         return () unless defined $flag && $flag ge '0' && $flag le '7';
1332         return () unless $call && is_callsign($call);
1333         my $is_node = $flag & 4;
1334         my $is_extnode = $flag & 2;
1335         my $here = $flag & 1;
1336         return ($call, $is_node, $is_extnode, $here, $part[1], $part[2]);
1337 }
1338
1339 # decode a pc92 call: flag call : version : build
1340 sub _encode_pc92_call
1341 {
1342         my $ref = shift;
1343
1344         # plain call or value
1345         return $ref unless ref $ref;
1346
1347         my $ext = shift;
1348         my $flag = 0;
1349         my $call = $ref->call;
1350         my $extra = '';
1351         $flag |= $ref->here ? 1 : 0;
1352         if ($ref->isa('Route::Node') || $ref->isa('DXProt')) {
1353                 $flag |= 4;
1354                 my $dxchan = DXChannel::get($call);
1355                 $flag |= 2 if $call ne $main::mycall && $dxchan && !$dxchan->{do_pc9x};
1356                 if ($ext) {
1357                         if ($ref->version) {
1358                                 my $version = $ref->version || 1.0;
1359                                 $version =  $version * 100 + 5300 if $version < 50;
1360                                 $extra .= ":" . $version;
1361                         }
1362                 }
1363         }
1364         return "$flag$call$extra";
1365 }
1366
1367 sub _add_thingy
1368 {
1369         my $parent = shift;
1370         my $s = shift;
1371         my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s;
1372         my @rout;
1373
1374         if ($call) {
1375                 if ($is_node) {
1376                         dbg("ROUTE: added node $call to " . $parent->call) if isdbg('routelow');
1377                         @rout = $parent->add($call, $version, Route::here($here));
1378                 } else {
1379                         dbg("ROUTE: added user $call to " . $parent->call) if isdbg('routelow');
1380                         @rout = $parent->add_user($call, Route::here($here));
1381                 }
1382         }
1383         return @rout;
1384 }
1385
1386 sub _del_thingy
1387 {
1388         my $parent = shift;
1389         my $s = shift;
1390         my ($call, $is_node, $is_extnode, $here, $version, $build) = @$s;
1391         my @rout;
1392         if ($call) {
1393                 if ($is_node) {
1394                         my $nref = Route::Node::get($call);
1395                         dbg("ROUTE: deleting node $call from " . $parent->call) if isdbg('routelow');
1396                         @rout = $nref->del($parent) if $nref;
1397                 } else {
1398                         my $uref = Route::User::get($call);
1399                         dbg("ROUTE: deleting user $call from " . $parent->call) if isdbg('routelow');
1400                         @rout = $parent->del_user($uref) if $uref;
1401                 }
1402         }
1403         return @rout;
1404 }
1405
1406 my $_last_time;
1407 my $_last_occurs;
1408
1409 sub gen_pc9x_t
1410 {
1411         if (!$_last_time || $_last_time != $main::systime) {
1412                 $_last_time = $main::systime;
1413                 $_last_occurs = 0;
1414                 return $_last_time - $main::systime_daystart;
1415         } else {
1416                 $_last_occurs++;
1417                 return sprintf "%d.%02d", $_last_time - $main::systime_daystart, $_last_occurs;
1418         }
1419 }
1420
1421 sub check_pc9x_t
1422 {
1423         my $call = shift;
1424         my $t = shift;
1425         my $pc = shift;
1426         my $create = shift;
1427
1428         my $parent = ref $call ? $call : Route::Node::get($call);
1429         if ($parent) {
1430                 # we only do this for external calls whose routing table
1431                 # record come and go. The reference for mycall is permanent
1432                 # and not that frequently used, it also never times out, so
1433                 # the id on it is completely unreliable. Besides, only commands
1434                 # originating on this box will go through this code...
1435                 if ($parent->call ne $main::mycall) {
1436                         my $lastid = $parent->lastid->{$pc} || 0;
1437                         if ($t < $lastid) {
1438                                 if ($t+86400-$lastid > $pc9x_past_age) {
1439                                         dbg("PCPROT: dup id on $t <= $lastid, ignored") if isdbg('chanerr');
1440                                         return;
1441                                 }
1442                         } elsif ($t == $lastid) {
1443                                 dbg("PCPROT: dup id on $t == $lastid, ignored") if isdbg('chanerr');
1444                                 return;
1445                         } else {
1446                                 # $t > $lastid, check that the timestamp offered isn't too far away from 'now'
1447                                 if ($t+$main::systime_daystart-$main::systime > $pc9x_future_age ) {
1448                                         dbg("PCPROT: id $t too far in the future, ignored") if isdbg('chanerr');
1449                                         return;
1450                                 }
1451                         }
1452                 }
1453         } elsif ($create) {
1454                 $parent = Route::Node->new($call);
1455         }
1456         $parent->lastid->{$pc} = $t if $parent;
1457
1458         return $parent;
1459 }
1460
1461 # DXSpider routing entries
1462 sub handle_92
1463 {
1464         my $self = shift;
1465         my $pcno = shift;
1466         my $line = shift;
1467         my $origin = shift;
1468
1469         my (@radd, @rdel);
1470
1471         my $pcall = $_[1];
1472         unless ($pcall) {
1473                 dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr');
1474                 return;
1475         }
1476         my $t = $_[2];
1477         my $sort = $_[3];
1478
1479         if ($pcall eq $main::mycall) {
1480                 dbg("PCPROT: looped back, ignored") if isdbg('chanerr');
1481                 return;
1482         }
1483
1484         if ($pcall eq $self->{call} && $self->{state} eq 'init') {
1485                 if ($self->{isolate}) {
1486                         dbg("PC9x received, but $pcall is isolated, ignored");
1487                         return;
1488                 } elsif (!$self->user->wantpc9x) {
1489                         dbg("PC9x explicitly switched off on $pcall, ignored");
1490                         return;
1491                 } else {
1492                         $self->state('init92');
1493                         $self->{do_pc9x} = 1;
1494                         dbg("Do pc9x set on $pcall");
1495                 }
1496         }
1497         unless ($self->{do_pc9x}) {
1498                 dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
1499                 return;
1500         }
1501
1502         my $parent = check_pc9x_t($pcall, $t, 92, 1) || return;
1503         my $oparent = $parent;
1504
1505         $parent->do_pc9x(1);
1506         $parent->via_pc92(1);
1507
1508         if ($sort eq 'F' || $sort eq 'R') {
1509
1510                 # this is the route finding section
1511                 # here is where the consequences of the 'find' command
1512                 # are dealt with
1513
1514                 my $from = $_[4];
1515                 my $target = $_[5];
1516
1517                 if ($sort eq 'F') {
1518                         my $flag;
1519                         my $ref;
1520                         my $dxchan;
1521                         if ($ref = DXChannel::get($target)) {
1522                                 $flag = 1;              # we are directly connected
1523                         } else {
1524                                 $ref = Route::get($target);
1525                                 $dxchan = $ref->dxchan;
1526                                 $flag = 2;
1527                         }
1528                         if ($ref && $flag && $dxchan) {
1529                                 $self->send(pc92r($from, $target, $flag, int($dxchan->{pingave}*1000)));
1530                                 return;
1531                         }
1532                 } elsif ($sort eq 'R') {
1533                         if (my $dxchan = DXChannel::get($from)) {
1534                                 handle_pc92_find_reply($dxchan, $pcall, $from, $target, @_[6,7]);
1535                         } else {
1536                                 my $ref = Route::get($from);
1537                                 if ($ref) {
1538                                         my @dxchan = grep {$_->do_pc9x} $ref->alldxchan;
1539                                         if (@dxchan) {
1540                                                 $_->send($line) for @dxchan;
1541                                         } else {
1542                                                 dbg("PCPROT: no return route, ignored") if isdbg('chanerr')
1543                                         }
1544                                 } else {
1545                                         dbg("PCPROT: no return route, ignored") if isdbg('chanerr')
1546                                 }
1547                         }
1548                         return;
1549                 }
1550         } elsif ($sort eq 'A' || $sort eq 'D' || $sort eq 'C') {
1551
1552                 # remember the last channel we arrived on
1553                 $parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call;
1554
1555                 # this is the main route section
1556                 # here is where all the routes are created and destroyed
1557
1558                 my @ent = map {[ _decode_pc92_call($_) ]} grep {$_ && /^[0-7]/} @_[4 .. $#_];
1559
1560                 if (@ent) {
1561
1562                         # look at the first one which will always be a node of some sort
1563                         # except in the case of 'A' or 'D' in which the $pcall is used
1564                         # otherwise use the node call and update any information
1565                         # that needs to be done.
1566                         my ($call, $is_node, $is_extnode, $here, $version, $build) = @{$ent[0]};
1567                         if (($sort eq 'A' || $sort eq 'D') && !$is_node) {
1568                                 # parent is already set correctly
1569                                 # this is to allow shortcuts for A and D records
1570                                 # not repeating the origin call to no real purpose
1571                                 ;
1572                         } else {
1573                                 if ($call && $is_node) {
1574                                         if ($call eq $main::mycall) {
1575                                                 dbg("PCPROT: $call looped back onto $main::mycall, ignored") if isdbg('chanerr');
1576                                                 return;
1577                                         }
1578                                         # this is only accepted from my "self".
1579                                         # this also kills configs from PC92 nodes with external PC19 nodes that are also
1580                                         # locally connected. Local nodes always take precedence.
1581                                         if (DXChannel::get($call) && $call ne $self->{call}) {
1582                                                 dbg("PCPROT: locally connected node $call from other another node $self->{call}, ignored") if isdbg('chanerr');
1583                                                 return;
1584                                         }
1585                                         if ($is_extnode) {
1586                                                 # reparent to external node (note that we must have received a 'C' or 'A' record
1587                                                 # from the true parent node for this external before we get one for the this node
1588                                                 unless ($parent = Route::Node::get($call)) {
1589                                                         if ($is_extnode && $oparent) {
1590                                                                 @radd =  _add_thingy($oparent, $ent[0]);
1591                                                                 $parent = $radd[0];
1592                                                         } else {
1593                                                                 dbg("PCPROT: no previous C or A for this external node received, ignored") if isdbg('chanerr');
1594                                                                 return;
1595                                                         }
1596                                                 }
1597                                                 $parent = check_pc9x_t($call, $t, 92) || return;
1598                                                 $parent->via_pc92(1);
1599                                                 $parent->PC92C_dxchan($self->{call});
1600                                         }
1601                                 } else {
1602                                         dbg("PCPROT: must be mycall or external node as first entry, ignored") if isdbg('chanerr');
1603                                         return;
1604                                 }
1605                                 $parent->here(Route::here($here));
1606                                 $parent->version($version) if $version && $version > $parent->version;
1607                                 $parent->build($build) if $build && $build > $parent->build;
1608                                 $parent->PC92C_dxchan($self->{call}) unless $self->{call} eq $parent->call;
1609                                 shift @ent;
1610                         }
1611                 }
1612
1613                 # do a pass through removing any references to either locally connected nodes or mycall
1614                 my @nent;
1615                 for (@ent) {
1616                         next unless $_;
1617                         if ($_->[0] eq $main::mycall || DXChannel::get($_->[0])) {
1618                                 dbg("PCPROT: $_->[0] refers to locally connected node, ignored") if isdbg('chanerr');
1619                                 next;
1620                         }
1621                         push @nent, $_;
1622                 }
1623
1624                 if ($sort eq 'A') {
1625                         for (@nent) {
1626                                 push @radd, _add_thingy($parent, $_);
1627                         }
1628                 } elsif ($sort eq 'D') {
1629                         for (@nent) {
1630                                 push @rdel, _del_thingy($parent, $_);
1631                         }
1632                 } elsif ($sort eq 'C') {
1633                         my (@nodes, @users);
1634
1635                         # we only reset obscounts on config records
1636                         $oparent->reset_obs;
1637                         dbg("ROUTE: reset obscount on $pcall now " . $oparent->obscount) if isdbg('obscount');
1638                         if ($oparent != $parent) {
1639                                 $parent->reset_obs;
1640                                 dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('obscount');
1641                         }
1642
1643                         #
1644                         foreach my $r (@nent) {
1645                                 #                       my ($call, $is_node, $is_extnode, $here, $version, $build) = _decode_pc92_call($_);
1646                                 if ($r->[0]) {
1647                                         if ($r->[1]) {
1648                                                 push @nodes, $r->[0];
1649                                         } else {
1650                                                 push @users, $r->[0];
1651                                         }
1652                                 } else {
1653                                         dbg("PCPROT: pc92 call entry '$_' not decoded, ignored") if isdbg('chanerr');
1654                                 }
1655                         }
1656
1657                         my ($dnodes, $dusers, $nnodes, $nusers) = $parent->calc_config_changes(\@nodes, \@users);
1658
1659                         # add users here
1660                         foreach my $r (@nent) {
1661                                 my $call = $r->[0];
1662                                 if ($call) {
1663                                         push @radd,_add_thingy($parent, $r) if grep $call eq $_, (@$nnodes, @$nusers);
1664                                 }
1665                         }
1666                         # del users here
1667                         foreach my $r (@$dnodes) {
1668                                 push @rdel,_del_thingy($parent, [$r, 1]);
1669                         }
1670                         foreach my $r (@$dusers) {
1671                                 push @rdel,_del_thingy($parent, [$r, 0]);
1672                         }
1673
1674                         # remember this last PC92C for rebroadcast on demand
1675                         $parent->last_PC92C($line);
1676                 } else {
1677                         dbg("PCPROT: unknown action '$sort', ignored") if isdbg('chanerr');
1678                         return;
1679                 }
1680
1681                 foreach my $r (@rdel) {
1682                         next unless $r;
1683
1684                         $self->route_pc21($pcall, undef, $r) if $r->isa('Route::Node');
1685                         $self->route_pc17($pcall, undef, $parent, $r) if $r->isa('Route::User');
1686                 }
1687                 my @pc19 = grep { $_ && $_->isa('Route::Node') } @radd;
1688                 my @pc16 = grep { $_ && $_->isa('Route::User') } @radd;
1689                 unshift @pc19, $parent if $self->{state} eq 'init92' && $oparent == $parent;
1690                 $self->route_pc19($pcall, undef, @pc19) if @pc19;
1691                 $self->route_pc16($pcall, undef, $parent, @pc16) if @pc16;
1692         }
1693
1694         # broadcast it if we get here
1695         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
1696 }
1697
1698
1699 sub handle_93
1700 {
1701         my $self = shift;
1702         my $pcno = shift;
1703         my $line = shift;
1704         my $origin = shift;
1705
1706 #       $self->{do_pc9x} ||= 1;
1707
1708         my $pcall = $_[1];
1709         unless (is_callsign($pcall)) {
1710                 dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr');
1711                 return;
1712         }
1713
1714         # remember that we are converting PC10->PC93 and self will be $main::me if it
1715         # comes from us
1716         unless ($self->{do_pc9x}) {
1717                 dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
1718                 return;
1719         }
1720
1721         my $t = $_[2];
1722         my $parent = check_pc9x_t($pcall, $t, 93, 1) || return;
1723
1724         my $to = uc $_[3];
1725         my $from = uc $_[4];
1726         my $via = uc $_[5];
1727         my $text = $_[6];
1728         my $onode = uc $_[7];
1729         $onode = $pcall if @_ <= 8;
1730
1731         # this is catch loops caused by bad software ...
1732         if (eph_dup("PC93|$from|$text|$onode", $pc10_dupe_age)) {
1733                 return;
1734         }
1735
1736         # will we allow it at all?
1737         if ($censorpc) {
1738                 my @bad;
1739                 if (@bad = BadWords::check($text)) {
1740                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
1741                         return;
1742                 }
1743         }
1744
1745         # if this is a 'bad spotter' user then ignore it
1746         my $nossid = $from;
1747         $nossid =~ s/-\d+$//;
1748         if ($badspotter->in($nossid)) {
1749                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
1750                 return;
1751         }
1752
1753         # if it is routeable then then treat it like a talk
1754         my $ref = Route::get($to);
1755         if ($ref) {
1756                 # local talks
1757                 my $dxchan;
1758                 $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall;
1759                 $dxchan = DXChannel::get($to) unless $dxchan;
1760                 # check it...
1761                 if ($dxchan) {
1762                         if (ref $dxchan && $dxchan->isa('DXChannel')) {
1763                                 if ($dxchan->is_user) {
1764                                         $dxchan->talk($from, $to, $via, $text, $onode);
1765                                         return;
1766                                 }
1767                         } else {
1768                                 dbg("ERROR: $to -> $dxchan is not a DXChannel! (local talk)");
1769                         }
1770                 }
1771
1772                 # convert to PC10 talks where appropriate
1773                 if ($ref) {
1774                         # just go for the "best" one for now (rather than broadcast)
1775                         $dxchan = $ref->dxchan;
1776
1777                         # check it...
1778                         if (ref $dxchan && $dxchan->isa('DXChannel')) {
1779                                 if ($dxchan->{do_pc9x}) {
1780                                         $dxchan->send($line);
1781                                 } else {
1782                                         $dxchan->talk($from, $to, $via, $text, $onode);
1783                                 }
1784                         } else {
1785                                 dbg("ERROR: $to -> $dxchan is not a DXChannel! (convert to pc10)");
1786                         }
1787                         return;
1788                 }
1789
1790                 # otherwise, drop through and allow it to be broadcast
1791         } elsif ($to eq '*' || $to eq 'SYSOP' || $to eq 'WX') {
1792                 # announces
1793                 my $sysop = $to eq 'SYSOP' ? '*' : ' ';
1794                 my $wx = $to eq 'WX' ? '1' : '0';
1795                 my $local = $via eq 'LOCAL' ? '*' : $via;
1796
1797                 $self->send_announce(1, pc12($from, $text, $local, $sysop, $wx, $pcall), $from, $local, $text, $sysop, $pcall, $wx, $via eq 'LOCAL' ? $via : undef);
1798                 return if $via eq 'LOCAL';
1799         } elsif (!is_callsign($to) && $text =~ /^#\d+ /) {
1800                 # chat messages to non-pc9x nodes
1801                 $self->send_chat(1, pc12($from, $text, undef, $to, undef, $pcall), $from, '*', $text, $to, $pcall, '0');
1802         }
1803         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
1804 }
1805
1806 # if get here then rebroadcast the thing with its Hop count decremented (if
1807 # there is one). If it has a hop count and it decrements to zero then don't
1808 # rebroadcast it.
1809 #
1810 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
1811 #        REBROADCAST!!!!
1812 #
1813
1814 sub handle_default
1815 {
1816         my $self = shift;
1817         my $pcno = shift;
1818         my $line = shift;
1819         my $origin = shift;
1820
1821         unless (eph_dup($line)) {
1822                 if ($pcno >= 90) {
1823                         my $pcall = $_[1];
1824                         unless (is_callsign($pcall)) {
1825                                 dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr');
1826                                 return;
1827                         }
1828                         my $t = $_[2];
1829                         my $parent = check_pc9x_t($pcall, $t, $pcno, 1) || return;
1830                         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
1831                 } else {
1832                         unless ($self->{isolate}) {
1833                                 DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me
1834                         }
1835                 }
1836         }
1837 }
1838
1839 1;