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