perl/DXProt.pm

   1 #!/usr/bin/perl
   2 #
   3 # This module impliments the protocal mode for a dx cluster
   4 #
   5 # Copyright (c) 1998 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 Time::HiRes qw(gettimeofday tv_interval);
  31 use BadWords;
  32 use DXHash;
  33 use Route;
  34 use Route::Node;
  35 use Script;
  36
  37 use strict;
  38
  39 use vars qw($VERSION $BRANCH);
  40 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  41 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  42 $main::build += $VERSION;
  43 $main::branch += $BRANCH;
  44
  45 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
  46                         $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
  47                         $pingint $obscount %pc19list
  48                         %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
  49                         $allowzero $decode_dk0wcy $send_opernam @checklist);
  50
  51 $pc11_max_age = 1*3600;                 # the maximum age for an incoming 'real-time' pc11
  52 $pc23_max_age = 1*3600;                 # the maximum age for an incoming 'real-time' pc23
  53
  54 $last_hour = time;                              # last time I did an hourly periodic update
  55 %pings = ();                    # outstanding ping requests outbound
  56 %rcmds = ();                    # outstanding rcmd requests outbound
  57 %nodehops = ();                 # node specific hop control
  58 %pc19list = ();                                 # list of outstanding PC19s that haven't had PC16s on them
  59
  60 $censorpc = 1;                                  # Do a BadWords::check on text fields and reject things
  61                                                                 # loads of 'bad things'
  62 $baddx = new DXHash "baddx";
  63 $badspotter = new DXHash "badspotter";
  64 $badnode = new DXHash "badnode";
  65 $last10 = $last_pc50 = time;
  66 $ann_to_talk = 1;
  67 $rspfcheck = 1;
  68 $eph_restime = 180;
  69 $eph_info_restime = 60*60;
  70 $eph_pc34_restime = 30;
  71 $pingint = 5*60;
  72 $obscount = 2;
  73
  74 @checklist =
  75 (
  76  [ qw(c c m bp bc c) ],                 # pc10
  77  [ qw(f m d t m c c h) ],               # pc11
  78  [ qw(c bc m bp bm p h) ],              # pc12
  79  [ qw(c h) ],                                   #
  80  [ qw(c h) ],                                   #
  81  [ qw(c m h) ],                                 #
  82  undef ,                                                # pc16 has to be validated manually
  83  [ qw(c c h) ],                                 # pc17
  84  [ qw(m n) ],                                   # pc18
  85  undef ,                                                # pc19 has to be validated manually
  86  undef ,                                                # pc20 no validation
  87  [ qw(c m h) ],                                 # pc21
  88  undef ,                                                # pc22 no validation
  89  [ qw(d n n n n m c c h) ],             # pc23
  90  [ qw(c p h) ],                                 # pc24
  91  [ qw(c c n n) ],                               # pc25
  92  [ qw(f m d t m c c bc) ],              # pc26
  93  [ qw(d n n n n m c c bc) ],    # pc27
  94  [ qw(c c m c d t p m bp n p bp bc) ], # pc28
  95  [ qw(c c n m) ],                               # pc29
  96  [ qw(c c n) ],                                 # pc30
  97  [ qw(c c n) ],                                 # pc31
  98  [ qw(c c n) ],                                 # pc32
  99  [ qw(c c n) ],                                 # pc33
 100  [ qw(c c m) ],                                 # pc34
 101  [ qw(c c m) ],                                 # pc35
 102  [ qw(c c m) ],                                 # pc36
 103  [ qw(c c n m) ],                               # pc37
 104  undef,                                                 # pc38 not interested
 105  [ qw(c m) ],                                   # pc39
 106  [ qw(c c m p n) ],                             # pc40
 107  [ qw(c n m h) ],                               # pc41
 108  [ qw(c c n) ],                                 # pc42
 109  undef,                                                 # pc43 don't handle it
 110  [ qw(c c n m m c) ],                   # pc44
 111  [ qw(c c n m) ],                               # pc45
 112  [ qw(c c n) ],                                 # pc46
 113  undef,                                                 # pc47
 114  undef,                                                 # pc48
 115  [ qw(c m h) ],                                 # pc49
 116  [ qw(c n h) ],                                 # pc50
 117  [ qw(c c n) ],                                 # pc51
 118  undef,
 119  undef,
 120  undef,
 121  undef,
 122  undef,
 123  undef,
 124  undef,
 125  undef,
 126  undef,                                                 # pc60
 127  undef,
 128  undef,
 129  undef,
 130  undef,
 131  undef,
 132  undef,
 133  undef,
 134  undef,
 135  undef,
 136  undef,                                                 # pc70
 137  undef,
 138  undef,
 139  [ qw(d n n n n n n m m m c c h) ],     # pc73
 140  undef,
 141  undef,
 142  undef,
 143  undef,
 144  undef,
 145  undef,
 146  undef,                                                 # pc80
 147  undef,
 148  undef,
 149  undef,
 150  [ qw(c c c m) ],                               # pc84
 151  [ qw(c c c m) ],                               # pc85
 152 );
 153
 154 # use the entry in the check list to check the field list presented
 155 # return OK if line NOT in check list (for now)
 156 sub check
 157 {
 158         my $n = shift;
 159         $n -= 10;
 160         return 0 if $n < 0 || $n > @checklist;
 161         my $ref = $checklist[$n];
 162         return 0 unless ref $ref;
 163
 164         my $i;
 165         shift;    # not interested in the first field
 166         for ($i = 0; $i < @$ref; $i++) {
 167                 my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
 168                 return 0 unless $act;
 169                 next if $blank && $_[$i] =~ /^[ \*]$/;
 170                 if ($act eq 'c') {
 171                         return $i+1 unless is_callsign($_[$i]);
 172                 } elsif ($act eq 'm') {
 173                         return $i+1 unless is_pctext($_[$i]);
 174                 } elsif ($act eq 'p') {
 175                         return $i+1 unless is_pcflag($_[$i]);
 176                 } elsif ($act eq 'f') {
 177                         return $i+1 unless is_freq($_[$i]);
 178                 } elsif ($act eq 'n') {
 179                         return $i+1 unless $_[$i] =~ /^[\d ]+$/;
 180                 } elsif ($act eq 'h') {
 181                         return $i+1 unless $_[$i] =~ /^H\d\d?$/;
 182                 } elsif ($act eq 'd') {
 183                         return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
 184                 } elsif ($act eq 't') {
 185                         return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
 186                 }
 187         }
 188         return 0;
 189 }
 190
 191 sub init
 192 {
 193         do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
 194         confess $@ if $@;
 195 }
 196
 197 #
 198 # obtain a new connection this is derived from dxchannel
 199 #
 200
 201 sub new
 202 {
 203         my $self = DXChannel::alloc(@_);
 204
 205         # add this node to the table, the values get filled in later
 206         my $pkg = shift;
 207         my $call = shift;
 208         $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall;
 209
 210         return $self;
 211 }
 212
 213 # this is how a pc connection starts (for an incoming connection)
 214 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
 215 # all the crap that comes between).
 216 sub start
 217 {
 218         my ($self, $line, $sort) = @_;
 219         my $call = $self->{call};
 220         my $user = $self->{user};
 221
 222         # log it
 223         my $host = $self->{conn}->{peerhost} || "unknown";
 224         Log('DXProt', "$call connected from $host");
 225
 226         # remember type of connection
 227         $self->{consort} = $line;
 228         $self->{outbound} = $sort eq 'O';
 229         my $priv = $user->priv;
 230         $priv = $user->priv(1) unless $priv;
 231         $self->{priv} = $priv;     # other clusters can always be 'normal' users
 232         $self->{lang} = $user->lang || 'en';
 233         $self->{isolate} = $user->{isolate};
 234         $self->{consort} = $line;       # save the connection type
 235         $self->{here} = 1;
 236         $self->{width} = 80;
 237
 238         # sort out registration
 239         $self->{registered} = 1;
 240
 241         # get the output filters
 242         $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
 243         $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
 244         $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
 245         $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
 246         $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ;
 247
 248
 249         # get the INPUT filters (these only pertain to Clusters)
 250         $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1);
 251         $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
 252         $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
 253         $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
 254         $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
 255
 256         # set unbuffered and no echo
 257         $self->send_now('B',"0");
 258         $self->send_now('E',"0");
 259         $self->conn->echo(0) if $self->conn->can('echo');
 260
 261         # ping neighbour node stuff
 262         my $ping = $user->pingint;
 263         $ping = $pingint unless defined $ping;
 264         $self->{pingint} = $ping;
 265         $self->{nopings} = $user->nopings || $obscount;
 266         $self->{pingtime} = [ ];
 267         $self->{pingave} = 999;
 268         $self->{metric} ||= 100;
 269         $self->{lastping} = $main::systime;
 270
 271         # send initialisation string
 272         unless ($self->{outbound}) {
 273                 $self->sendinit;
 274         }
 275
 276         $self->state('init');
 277         $self->{pc50_t} = $main::systime;
 278
 279         # send info to all logged in thingies
 280         $self->tell_login('loginn');
 281
 282         # run a script send the output to the debug file
 283         my $script = new Script(lc $call) || new Script('node_default');
 284         $script->run($self) if $script;
 285 }
 286
 287 #
 288 # send outgoing 'challenge'
 289 #
 290
 291 sub sendinit
 292 {
 293         my $self = shift;
 294         $self->send(pc18());
 295 }
 296
 297 #
 298 # This is the normal pcxx despatcher
 299 #
 300 sub normal
 301 {
 302         my ($self, $line) = @_;
 303         my @field = split /\^/, $line;
 304         return unless @field;
 305
 306         pop @field if $field[-1] eq '~';
 307
 308 #       print join(',', @field), "\n";
 309
 310
 311         # process PC frames, this will fail unless the frame starts PCnn
 312         my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
 313         return unless $pcno;
 314         return if $pcno < 10 || $pcno > 99;
 315
 316         # check for and dump bad protocol messages
 317         my $n = check($pcno, @field);
 318         if ($n) {
 319                 dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
 320                 return;
 321         }
 322
 323         # local processing 1
 324         my $pcr;
 325         eval {
 326                 $pcr = Local::pcprot($self, $pcno, @field);
 327         };
 328 #       dbg("Local::pcprot error $@") if isdbg('local') if $@;
 329         return if $pcr;
 330
 331         no strict 'subs';
 332         my $sub = "handle_$pcno";
 333         if ($self->can($sub)) {
 334                 $self->$sub($pcno, $line, @field);
 335         } else {
 336                 $self->handle_default($pcno, $line, @field);
 337         }
 338 }
 339
 340 # incoming talk commands
 341 sub handle_10
 342 {
 343         my $self = shift;
 344         my $pcno = shift;
 345         my $line = shift;
 346
 347                         # rsfp check
 348         return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]);
 349
 350         # will we allow it at all?
 351         if ($censorpc) {
 352                 my @bad;
 353                 if (@bad = BadWords::check($_[3])) {
 354                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
 355                         return;
 356                 }
 357         }
 358
 359         # is it for me or one of mine?
 360         my ($from, $to, $via, $call, $dxchan);
 361         $from = $_[1];
 362         if ($_[5] gt ' ') {
 363                 $via = $_[2];
 364                 $to = $_[5];
 365         } else {
 366                 $to = $_[2];
 367         }
 368
 369         # if this is a 'nodx' node then ignore it
 370         if ($badnode->in($_[6]) || ($via && $badnode->in($via))) {
 371                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
 372                 return;
 373         }
 374
 375         # if this is a 'bad spotter' user then ignore it
 376         my $nossid = $from;
 377         $nossid =~ s/-\d+$//;
 378         if ($badspotter->in($nossid)) {
 379                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
 380                 return;
 381         }
 382
 383         # if we are converting announces to talk is it a dup?
 384         if ($ann_to_talk) {
 385                 if (AnnTalk::is_talk_candidate($from, $_[3]) && AnnTalk::dup($from, $to, $_[3])) {
 386                         dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
 387                         return;
 388                 }
 389         }
 390
 391         # it is here and logged on
 392         $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
 393         $dxchan = DXChannel->get($to) unless $dxchan;
 394         if ($dxchan && $dxchan->is_user) {
 395                 $_[3] =~ s/\%5E/^/g;
 396                 $dxchan->talk($from, $to, $via, $_[3]);
 397                 return;
 398         }
 399
 400         # is it elsewhere, visible on the cluster via the to address?
 401         # note: this discards the via unless the to address is on
 402         # the via address
 403         my ($ref, $vref);
 404         if ($ref = Route::get($to)) {
 405                 $vref = Route::Node::get($via) if $via;
 406                 $vref = undef unless $vref && grep $to eq $_, $vref->users;
 407                 $ref->dxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]);
 408                 return;
 409         }
 410
 411         # not visible here, send a message of condolence
 412         $vref = undef;
 413         $ref = Route::get($from);
 414         $vref = $ref = Route::Node::get($_[6]) unless $ref;
 415         if ($ref) {
 416                 $dxchan = $ref->dxchan;
 417                 $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
 418         }
 419 }
 420
 421 # DX Spot handling
 422 sub handle_11
 423 {
 424         my $self = shift;
 425         my $pcno = shift;
 426         my $line = shift;
 427
 428         # route 'foreign' pc26s
 429         if ($pcno == 26) {
 430                 if ($_[7] ne $main::mycall) {
 431                         $self->route($_[7], $line);
 432                         return;
 433                 }
 434         }
 435
 436         # rsfp check
 437         #                       return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]);
 438
 439         # if this is a 'nodx' node then ignore it
 440         if ($badnode->in($_[7])) {
 441                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
 442                 return;
 443         }
 444
 445         # if this is a 'bad spotter' user then ignore it
 446         my $nossid = $_[6];
 447         $nossid =~ s/-\d+$//;
 448         if ($badspotter->in($nossid)) {
 449                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
 450                 return;
 451         }
 452
 453         # convert the date to a unix date
 454         my $d = cltounix($_[3], $_[4]);
 455         # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
 456         if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
 457                 dbg("PCPROT: Spot ignored, invalid date or out of range ($_[3] $_[4])\n") if isdbg('chanerr');
 458                 return;
 459         }
 460
 461         # is it 'baddx'
 462         if ($baddx->in($_[2]) || BadWords::check($_[2]) || $_[2] =~ /COCK/) {
 463                 dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr');
 464                 return;
 465         }
 466
 467         # do some de-duping
 468         $_[5] =~ s/^\s+//;                      # take any leading blanks off
 469         $_[2] = unpad($_[2]);           # take off leading and trailing blanks from spotted callsign
 470         if ($_[2] =~ /BUST\w*$/) {
 471                 dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr');
 472                 return;
 473         }
 474         if ($censorpc) {
 475                 my @bad;
 476                 if (@bad = BadWords::check($_[5])) {
 477                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
 478                         return;
 479                 }
 480         }
 481
 482
 483         my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]);
 484         # global spot filtering on INPUT
 485         if ($self->{inspotsfilter}) {
 486                 my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
 487                 unless ($filter) {
 488                         dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr');
 489                         return;
 490                 }
 491         }
 492
 493         # this goes after the input filtering, but before the add
 494         # so that if it is input filtered, it isn't added to the dup
 495         # list. This allows it to come in from a "legitimate" source
 496         if (Spot::dup($_[1], $_[2], $d, $_[5], $_[6])) {
 497                 dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
 498                 return;
 499         }
 500
 501         # add it
 502         Spot::add(@spot);
 503
 504         #
 505         # @spot at this point contains:-
 506         # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
 507         # then  spotted itu, spotted cq, spotters itu, spotters cq
 508         # you should be able to route on any of these
 509         #
 510
 511         # fix up qra locators of known users
 512         my $user = DXUser->get_current($spot[4]);
 513         if ($user) {
 514                 my $qra = $user->qra;
 515                 unless ($qra && is_qra($qra)) {
 516                         my $lat = $user->lat;
 517                         my $long = $user->long;
 518                         if (defined $lat && defined $long) {
 519                                 $user->qra(DXBearing::lltoqra($lat, $long));
 520                                 $user->put;
 521                         }
 522                 }
 523
 524                 # send a remote command to a distant cluster if it is visible and there is no
 525                 # qra locator and we havn't done it for a month.
 526
 527                 unless ($user->qra) {
 528                         my $node;
 529                         my $to = $user->homenode;
 530                         my $last = $user->lastoper || 0;
 531                         if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) {
 532                                 my $cmd = "forward/opernam $spot[4]";
 533                                 # send the rcmd but we aren't interested in the replies...
 534                                 my $dxchan = $node->dxchan;
 535                                 if ($dxchan && $dxchan->is_clx) {
 536                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 537                                 } else {
 538                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 539                                 }
 540                                 if ($to ne $_[7]) {
 541                                         $to = $_[7];
 542                                         $node = Route::Node::get($to);
 543                                         if ($node) {
 544                                                 $dxchan = $node->dxchan;
 545                                                 if ($dxchan && $dxchan->is_clx) {
 546                                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
 547                                                 } else {
 548                                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
 549                                                 }
 550                                         }
 551                                 }
 552                                 $user->lastoper($main::systime);
 553                                 $user->put;
 554                         }
 555                 }
 556         }
 557
 558         # local processing
 559         my $r;
 560         eval {
 561                 $r = Local::spot($self, @spot);
 562         };
 563         #                       dbg("Local::spot1 error $@") if isdbg('local') if $@;
 564         return if $r;
 565
 566         # DON'T be silly and send on PC26s!
 567         return if $pcno == 26;
 568
 569         # send out the filtered spots
 570         send_dx_spot($self, $line, @spot) if @spot;
 571 }
 572
 573 # announces
 574 sub handle_12
 575 {
 576         my $self = shift;
 577         my $pcno = shift;
 578         my $line = shift;
 579
 580         #                       return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]);
 581
 582         # announce duplicate checking
 583         $_[3] =~ s/^\s+//;                      # remove leading blanks
 584
 585         if ($censorpc) {
 586                 my @bad;
 587                 if (@bad = BadWords::check($_[3])) {
 588                         dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
 589                         return;
 590                 }
 591         }
 592
 593         # if this is a 'nodx' node then ignore it
 594         if ($badnode->in($_[5])) {
 595                 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
 596                 return;
 597         }
 598
 599         # if this is a 'bad spotter' user then ignore it
 600         my $nossid = $_[1];
 601         $nossid =~ s/-\d+$//;
 602         if ($badspotter->in($nossid)) {
 603                 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
 604                 return;
 605         }
 606
 607         if ($_[2] eq '*' || $_[2] eq $main::mycall) {
 608
 609
 610                 # here's a bit of fun, convert incoming ann with a callsign in the first word
 611                 # or one saying 'to <call>' to a talk if we can route to the recipient
 612                 if ($ann_to_talk) {
 613                         my $call = AnnTalk::is_talk_candidate($_[1], $_[3]);
 614                         if ($call) {
 615                                 my $ref = Route::get($call);
 616                                 if ($ref) {
 617                                         my $dxchan = $ref->dxchan;
 618                                         $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self;
 619                                         return;
 620                                 }
 621                         }
 622                 }
 623
 624                 # send it
 625                 $self->send_announce($line, @_[1..6]);
 626         } else {
 627                 $self->route($_[2], $line);
 628         }
 629 }
 630
 631 # incoming user
 632 sub handle_16
 633 {
 634         my $self = shift;
 635         my $pcno = shift;
 636         my $line = shift;
 637
 638
 639         if (eph_dup($line)) {
 640                 dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
 641                 return;
 642         }
 643
 644         # general checks
 645         my $dxchan;
 646         my $ncall = $_[1];
 647         my $newline = "PC16^";
 648
 649         # do I want users from this channel?
 650         unless ($self->user->wantpc16) {
 651                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 652                 return;
 653         }
 654         # is it me?
 655         if ($ncall eq $main::mycall) {
 656                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 657                 return;
 658         }
 659         my $parent = Route::Node::get($ncall);
 660
 661         # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list,
 662         # fix it up in the routing tables and issue it forth before the PC16
 663         unless ($parent) {
 664                 my $nl = $pc19list{$ncall};
 665
 666                 if ($nl && @_ > 3) { # 3 because of the hop count!
 667
 668                         # this is a new (remembered) node, now attach it to me if it isn't in filtered
 669                         # and we haven't disallowed it
 670                         my $user = DXUser->get_current($ncall);
 671                         if (!$user) {
 672                                 $user = DXUser->new($ncall);
 673                                 $user->sort('A');
 674                                 $user->priv(1); # I have relented and defaulted nodes
 675                                 $user->lockout(1);
 676                                 $user->homenode($ncall);
 677                                 $user->node($ncall);
 678                         }
 679
 680                         my $wantpc19 = $user->wantroutepc19;
 681                         if ($wantpc19 || !defined $wantpc19) {
 682                                 my $new = Route->new($ncall); # throw away
 683                                 if ($self->in_filter_route($new)) {
 684                                         my @nrout;
 685                                         for (@$nl) {
 686                                                 $parent = Route::Node::get($_->[0]);
 687                                                 $dxchan = $parent->dxchan if $parent;
 688                                                 if ($dxchan && $dxchan ne $self) {
 689                                                         dbg("PCPROT: PC19 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 690                                                         $parent = undef;
 691                                                 }
 692                                                 if ($parent) {
 693                                                         my $r = $parent->add($ncall, $_->[1], $_->[2]);
 694                                                         push @nrout, $r unless @nrout;
 695                                                 }
 696                                         }
 697                                         $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route
 698                                         $user->lastin($main::systime) unless DXChannel->get($ncall);
 699                                         $user->put;
 700
 701                                         # route the pc19 - this will cause 'stuttering PC19s' for a while
 702                                         $self->route_pc19(@nrout) if @nrout ;
 703                                         $parent = Route::Node::get($ncall);
 704                                         unless ($parent) {
 705                                                 dbg("PCPROT: lost $ncall after sending PC19 for it?");
 706                                                 return;
 707                                         }
 708                                 } else {
 709                                         return;
 710                                 }
 711                                 delete $pc19list{$ncall};
 712                         }
 713                 } else {
 714                         dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr');
 715                         return;
 716                 }
 717         } else {
 718
 719                 $dxchan = $parent->dxchan;
 720                 if ($dxchan && $dxchan ne $self) {
 721                         dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 722                         return;
 723                 }
 724
 725                 # input filter if required
 726                 return unless $self->in_filter_route($parent);
 727         }
 728
 729         my $i;
 730         my @rout;
 731         for ($i = 2; $i < $#_; $i++) {
 732                 my ($call, $conf, $here) = $_[$i] =~ /^(\S+) (\S) (\d)/o;
 733                 next unless $call && $conf && defined $here && is_callsign($call);
 734                 next if $call eq $main::mycall;
 735
 736                 eph_del_regex("^PC17\\^$call\\^$ncall");
 737
 738                 $conf = $conf eq '*';
 739
 740                 # reject this if we think it is a node already
 741                 my $r = Route::Node::get($call);
 742                 my $u = DXUser->get_current($call) unless $r;
 743                 if ($r || ($u && $u->is_node)) {
 744                         dbg("PCPROT: $call is a node") if isdbg('chanerr');
 745                         next;
 746                 }
 747
 748                 $r = Route::User::get($call);
 749                 my $flags = Route::here($here)|Route::conf($conf);
 750
 751                 if ($r) {
 752                         my $au = $r->addparent($parent);
 753                         if ($r->flags != $flags) {
 754                                 $r->flags($flags);
 755                                 $au = $r;
 756                         }
 757                         push @rout, $r if $au;
 758                 } else {
 759                         push @rout, $parent->add_user($call, $flags);
 760                 }
 761
 762
 763                 # add this station to the user database, if required
 764                 $call =~ s/-\d+$//o;    # remove ssid for users
 765                 my $user = DXUser->get_current($call);
 766                 $user = DXUser->new($call) if !$user;
 767                 $user->homenode($parent->call) if !$user->homenode;
 768                 $user->node($parent->call);
 769                 $user->lastin($main::systime) unless DXChannel->get($call);
 770                 $user->put;
 771         }
 772
 773         $self->route_pc16($parent, @rout) if @rout;
 774 }
 775
 776 # remove a user
 777 sub handle_17
 778 {
 779         my $self = shift;
 780         my $pcno = shift;
 781         my $line = shift;
 782         my $dxchan;
 783         my $ncall = $_[2];
 784         my $ucall = $_[1];
 785
 786         eph_del_regex("^PC16\\^$ncall.*$ucall");
 787
 788         # do I want users from this channel?
 789         unless ($self->user->wantpc16) {
 790                 dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
 791                 return;
 792         }
 793         if ($ncall eq $main::mycall) {
 794                 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 795                 return;
 796         }
 797
 798         my $uref = Route::User::get($ucall);
 799         unless ($uref) {
 800                 dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
 801                 return;
 802         }
 803         my $parent = Route::Node::get($ncall);
 804         unless ($parent) {
 805                 dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
 806                 return;
 807         }
 808
 809         $dxchan = $parent->dxchan;
 810         if ($dxchan && $dxchan ne $self) {
 811                 dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
 812                 return;
 813         }
 814
 815         # input filter if required
 816         return unless $self->in_filter_route($parent);
 817
 818         $parent->del_user($uref);
 819
 820         if (eph_dup($line)) {
 821                 dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
 822                 return;
 823         }
 824
 825         $self->route_pc17($parent, $uref);
 826 }
 827
 828 # link request
 829 sub handle_18
 830 {
 831         my $self = shift;
 832         my $pcno = shift;
 833         my $line = shift;
 834         $self->state('init');
 835
 836         # record the type and version offered
 837         if ($_[1] =~ /DXSpider Version: (\d+\.\d+) Build: (\d+\.\d+)/) {
 838                 $self->version(53 + $1);
 839                 $self->user->version(53 + $1);
 840                 $self->build(0 + $2);
 841                 $self->user->build(0 + $2);
 842                 unless ($self->is_spider) {
 843                         $self->user->sort('S');
 844                         $self->user->put;
 845                         $self->sort('S');
 846                 }
 847         } else {
 848                 $self->version(50.0);
 849                 $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
 850                 $self->user->version($self->version);
 851         }
 852
 853         # first clear out any nodes on this dxchannel
 854         my $parent = Route::Node::get($self->{call});
 855         my @rout = $parent->del_nodes;
 856         $self->route_pc21(@rout, $parent) if @rout;
 857         $self->send_local_config();
 858         $self->send(pc20());
 859 }
 860
 861 # incoming cluster list
 862 sub handle_19
 863 {
 864         my $self = shift;
 865         my $pcno = shift;
 866         my $line = shift;
 867
 868         my $i;
 869         my $newline = "PC19^";
 870
 871         if (eph_dup($line)) {
 872                 dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
 873                 return;
 874         }
 875
 876         # new routing list
 877         my @rout;
 878         my $parent = Route::Node::get($self->{call});
 879         unless ($parent) {
 880                 dbg("DXPROT: my parent $self->{call} has disappeared");
 881                 $self->disconnect;
 882                 return;
 883         }
 884
 885         # parse the PC19
 886         for ($i = 1; $i < $#_-1; $i += 4) {
 887                 my $here = $_[$i];
 888                 my $call = uc $_[$i+1];
 889                 my $conf = $_[$i+2];
 890                 my $ver = $_[$i+3];
 891                 next unless defined $here && defined $conf && is_callsign($call);
 892
 893                 eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)");
 894
 895                 # check for sane parameters
 896                 #                               $ver = 5000 if $ver eq '0000';
 897                 next if $ver < 5000;    # only works with version 5 software
 898                 next if length $call < 3; # min 3 letter callsigns
 899                 next if $call eq $main::mycall;
 900
 901                 # check that this PC19 isn't trying to alter the wrong dxchan
 902                 my $dxchan = DXChannel->get($call);
 903                 if ($dxchan && $dxchan != $self) {
 904                         dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
 905                         next;
 906                 }
 907
 908                 # add this station to the user database, if required (don't remove SSID from nodes)
 909                 my $user = DXUser->get_current($call);
 910                 if (!$user) {
 911                         $user = DXUser->new($call);
 912                         $user->sort('A');
 913                         $user->priv(1);         # I have relented and defaulted nodes
 914                         $user->lockout(1);
 915                         $user->homenode($call);
 916                         $user->node($call);
 917                 }
 918
 919                 my $r = Route::Node::get($call);
 920                 my $flags = Route::here($here)|Route::conf($conf);
 921
 922                 # modify the routing table if it is in it, otherwise store it in the pc19list for now
 923                 if ($r) {
 924                         my $ar;
 925                         if ($call ne $parent->call) {
 926                                 if ($self->in_filter_route($r)) {
 927                                         $ar = $parent->add($call, $ver, $flags);
 928                                         push @rout, $ar if $ar;
 929                                 } else {
 930                                         next;
 931                                 }
 932                         }
 933                         if ($r->version ne $ver || $r->flags != $flags) {
 934                                 $r->version($ver);
 935                                 $r->flags($flags);
 936                                 push @rout, $r unless $ar;
 937                         }
 938                 } else {
 939
 940                         # if he is directly connected or allowed then add him, otherwise store him up for later
 941                         if ($call eq $self->{call} || $user->wantroutepc19) {
 942                                 my $new = Route->new($call); # throw away
 943                                 if ($self->in_filter_route($new)) {
 944                                         my $ar = $parent->add($call, $ver, $flags);
 945                                         $user->wantroutepc19(1) unless defined $user->wantroutepc19;
 946                                         push @rout, $ar if $ar;
 947                                 } else {
 948                                         next;
 949                                 }
 950                         } else {
 951                                 $pc19list{$call} = [] unless exists $pc19list{$call};
 952                                 my $nl = $pc19list{$call};
 953                                 push @{$pc19list{$call}}, [$self->{call}, $ver, $flags] unless grep $_->[0] eq $self->{call}, @$nl;
 954                         }
 955                 }
 956
 957                 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
 958                 my $mref = DXMsg::get_busy($call);
 959                 $mref->stop_msg($call) if $mref;
 960
 961                 $user->lastin($main::systime) unless DXChannel->get($call);
 962                 $user->put;
 963         }
 964
 965
 966         $self->route_pc19(@rout) if @rout;
 967 }
 968
 969 # send local configuration
 970 sub handle_20
 971 {
 972         my $self = shift;
 973         my $pcno = shift;
 974         my $line = shift;
 975         $self->send_local_config();
 976         $self->send(pc22());
 977         $self->state('normal');
 978         $self->{lastping} = 0;
 979 }
 980
 981 # delete a cluster from the list
 982 sub handle_21
 983 {
 984         my $self = shift;
 985         my $pcno = shift;
 986         my $line = shift;
 987         my $call = uc $_[1];
 988
 989         eph_del_regex("^PC1[679].*$call");
 990
 991         # if I get a PC21 from the same callsign as self then treat it
 992         # as a PC39: I have gone away
 993         if ($call eq $self->call) {
 994                 $self->disconnect(1);
 995                 return;
 996         }
 997
 998         # check to see if we are in the pc19list, if we are then don't bother with any of
 999         # this routing table manipulation, just remove it from the list and dump it
1000         my @rout;
1001         if (my $nl = $pc19list{$call}) {
1002                 $pc19list{$call} = [ grep {$_->[0] ne $self->{call}} @$nl ];
1003                 delete $pc19list{$call} unless @{$pc19list{$call}};
1004         } else {
1005
1006                 my $parent = Route::Node::get($self->{call});
1007                 unless ($parent) {
1008                         dbg("DXPROT: my parent $self->{call} has disappeared");
1009                         $self->disconnect;
1010                         return;
1011                 }
1012                 if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
1013                         my $node = Route::Node::get($call);
1014                         if ($node) {
1015
1016                                 my $dxchan = DXChannel->get($call);
1017                                 if ($dxchan && $dxchan != $self) {
1018                                         dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
1019                                         return;
1020                                 }
1021
1022                                 # input filter it
1023                                 return unless $self->in_filter_route($node);
1024
1025                                 # routing objects
1026                                 push @rout, $node->del($parent);
1027                         }
1028                 } else {
1029                         dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr');
1030                         return;
1031                 }
1032         }
1033
1034         $self->route_pc21(@rout) if @rout;
1035 }
1036
1037
1038 sub handle_22
1039 {
1040         my $self = shift;
1041         my $pcno = shift;
1042         my $line = shift;
1043         $self->state('normal');
1044         $self->{lastping} = 0;
1045 }
1046
1047 # WWV info
1048 sub handle_23
1049 {
1050         my $self = shift;
1051         my $pcno = shift;
1052         my $line = shift;
1053
1054         # route 'foreign' pc27s
1055         if ($pcno == 27) {
1056                 if ($_[8] ne $main::mycall) {
1057                         $self->route($_[8], $line);
1058                         return;
1059                 }
1060         }
1061
1062         return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]);
1063
1064         # do some de-duping
1065         my $d = cltounix($_[1], sprintf("%02d18Z", $_[2]));
1066         my $sfi = unpad($_[3]);
1067         my $k = unpad($_[4]);
1068         my $i = unpad($_[5]);
1069         my ($r) = $_[6] =~ /R=(\d+)/;
1070         $r = 0 unless $r;
1071         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) {
1072                 dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr');
1073                 return;
1074         }
1075         if (Geomag::dup($d,$sfi,$k,$i,$_[6])) {
1076                 dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
1077                 return;
1078         }
1079         $_[7] =~ s/-\d+$//o;            # remove spotter's ssid
1080
1081         my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
1082
1083         my $rep;
1084         eval {
1085                 $rep = Local::wwv($self, $_[1], $_[2], $sfi, $k, $i, @_[6..8], $r);
1086         };
1087         #                       dbg("Local::wwv2 error $@") if isdbg('local') if $@;
1088         return if $rep;
1089
1090         # DON'T be silly and send on PC27s!
1091         return if $pcno == 27;
1092
1093         # broadcast to the eager world
1094         send_wwv_spot($self, $line, $d, $_[2], $sfi, $k, $i, @_[6..8]);
1095 }
1096
1097 # set here status
1098 sub handle_24
1099 {
1100         my $self = shift;
1101         my $pcno = shift;
1102         my $line = shift;
1103         my $call = uc $_[1];
1104         my ($nref, $uref);
1105         $nref = Route::Node::get($call);
1106         $uref = Route::User::get($call);
1107         return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on
1108
1109         if (eph_dup($line)) {
1110                 dbg("PCPROT: Dup PC24 ignored\n") if isdbg('chanerr');
1111                 return;
1112         }
1113
1114         $nref->here($_[2]) if $nref;
1115         $uref->here($_[2]) if $uref;
1116         my $ref = $nref || $uref;
1117         return unless $self->in_filter_route($ref);
1118
1119         $self->route_pc24($ref, $_[3]);
1120 }
1121
1122 # merge request
1123 sub handle_25
1124 {
1125         my $self = shift;
1126         my $pcno = shift;
1127         my $line = shift;
1128         if ($_[1] ne $main::mycall) {
1129                 $self->route($_[1], $line);
1130                 return;
1131         }
1132         if ($_[2] eq $main::mycall) {
1133                 dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr');
1134                 return;
1135         }
1136
1137         Log('DXProt', "Merge request for $_[3] spots and $_[4] WWV from $_[2]");
1138
1139         # spots
1140         if ($_[3] > 0) {
1141                 my @in = reverse Spot::search(1, undef, undef, 0, $_[3]);
1142                 my $in;
1143                 foreach $in (@in) {
1144                         $self->send(pc26(@{$in}[0..4], $_[2]));
1145                 }
1146         }
1147
1148         # wwv
1149         if ($_[4] > 0) {
1150                 my @in = reverse Geomag::search(0, $_[4], time, 1);
1151                 my $in;
1152                 foreach $in (@in) {
1153                         $self->send(pc27(@{$in}[0..5], $_[2]));
1154                 }
1155         }
1156 }
1157
1158 sub handle_26 {goto &handle_11}
1159 sub handle_27 {goto &handle_23}
1160
1161 # mail/file handling
1162 sub handle_28
1163 {
1164         my $self = shift;
1165         my $pcno = shift;
1166         my $line = shift;
1167         if ($_[1] eq $main::mycall) {
1168                 no strict 'refs';
1169                 my $sub = "DXMsg::handle_$pcno";
1170                 &$sub($self, @_);
1171         } else {
1172                 $self->route($_[1], $line) unless $self->is_clx;
1173         }
1174 }
1175
1176 sub handle_29 {goto &handle_28}
1177 sub handle_30 {goto &handle_28}
1178 sub handle_31 {goto &handle_28}
1179 sub handle_32 {goto &handle_28}
1180 sub handle_33 {goto &handle_28}
1181
1182 sub handle_34
1183 {
1184         my $self = shift;
1185         my $pcno = shift;
1186         my $line = shift;
1187         if (eph_dup($line, $eph_pc34_restime)) {
1188                 dbg("PCPROT: dupe PC34, ignored") if isdbg('chanerr');
1189         } else {
1190                 $self->process_rcmd($_[1], $_[2], $_[2], $_[3]);
1191         }
1192 }
1193
1194 # remote command replies
1195 sub handle_35
1196 {
1197         my $self = shift;
1198         my $pcno = shift;
1199         my $line = shift;
1200         eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^");
1201         $self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]);
1202 }
1203
1204 sub handle_36 {goto &handle_34}
1205
1206 # database stuff
1207 sub handle_37
1208 {
1209         my $self = shift;
1210         my $pcno = shift;
1211         my $line = shift;
1212         DXDb::process($self, $line);
1213 }
1214
1215 # node connected list from neighbour
1216 sub handle_38
1217 {
1218         my $self = shift;
1219         my $pcno = shift;
1220         my $line = shift;
1221 }
1222
1223 # incoming disconnect
1224 sub handle_39
1225 {
1226         my $self = shift;
1227         my $pcno = shift;
1228         my $line = shift;
1229         if ($_[1] eq $self->{call}) {
1230                 $self->disconnect(1);
1231         } else {
1232                 dbg("PCPROT: came in on wrong channel") if isdbg('chanerr');
1233         }
1234 }
1235
1236 sub handle_40 {goto &handle_28}
1237
1238 # user info
1239 sub handle_41
1240 {
1241         my $self = shift;
1242         my $pcno = shift;
1243         my $line = shift;
1244         my $call = $_[1];
1245
1246         my $l = $line;
1247         $l =~ s/[\x00-\x20\x7f-\xff]+//g; # remove all funny characters and spaces for dup checking
1248         if (eph_dup($l, $eph_info_restime)) {
1249                 dbg("PCPROT: dup PC41, ignored") if isdbg('chanerr');
1250                 return;
1251         }
1252
1253         # input filter if required
1254         #                       my $ref = Route::get($call) || Route->new($call);
1255         #                       return unless $self->in_filter_route($ref);
1256
1257         if ($_[3] eq $_[2] || $_[3] =~ /^\s*$/) {
1258                 dbg('PCPROT: invalid value') if isdbg('chanerr');
1259                 return;
1260         }
1261
1262         # add this station to the user database, if required
1263         my $user = DXUser->get_current($call);
1264         $user = DXUser->new($call) unless $user;
1265
1266         if ($_[2] == 1) {
1267                 $user->name($_[3]);
1268         } elsif ($_[2] == 2) {
1269                 $user->qth($_[3]);
1270         } elsif ($_[2] == 3) {
1271                 if (is_latlong($_[3])) {
1272                         my ($lat, $long) = DXBearing::stoll($_[3]);
1273                         $user->lat($lat);
1274                         $user->long($long);
1275                         $user->qra(DXBearing::lltoqra($lat, $long));
1276                 } else {
1277                         dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
1278                         return;
1279                 }
1280         } elsif ($_[2] == 4) {
1281                 $user->homenode($_[3]);
1282         } elsif ($_[2] == 5) {
1283                 if (is_qra(uc $_[3])) {
1284                         my ($lat, $long) = DXBearing::qratoll(uc $_[3]);
1285                         $user->lat($lat);
1286                         $user->long($long);
1287                         $user->qra(uc $_[3]);
1288                 } else {
1289                         dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
1290                         return;
1291                 }
1292         }
1293         $user->lastoper($main::systime); # to cut down on excessive for/opers being generated
1294         $user->put;
1295
1296         unless ($self->{isolate}) {
1297                 DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
1298         }
1299
1300         #  perhaps this IS what we want after all
1301         #                       $self->route_pc41($ref, $call, $_[2], $_[3], $_[4]);
1302 }
1303
1304 sub handle_42 {goto &handle_28}
1305
1306
1307 # database
1308 sub handle_44 {goto &handle_37}
1309 sub handle_45 {goto &handle_37}
1310 sub handle_46 {goto &handle_37}
1311 sub handle_47 {goto &handle_37}
1312 sub handle_48 {goto &handle_37}
1313
1314 # message and database
1315 sub handle_49
1316 {
1317         my $self = shift;
1318         my $pcno = shift;
1319         my $line = shift;
1320
1321         if (eph_dup($line)) {
1322                 dbg("PCPROT: Dup PC49 ignored\n") if isdbg('chanerr');
1323                 return;
1324         }
1325
1326         if ($_[1] eq $main::mycall) {
1327                 DXMsg::handle_49($self, @_);
1328         } else {
1329                 $self->route($_[1], $line) unless $self->is_clx;
1330         }
1331 }
1332
1333 # keep alive/user list
1334 sub handle_50
1335 {
1336         my $self = shift;
1337         my $pcno = shift;
1338         my $line = shift;
1339
1340         my $call = $_[1];
1341         my $node = Route::Node::get($call);
1342         if ($node) {
1343                 return unless $node->call eq $self->{call};
1344                 $node->usercount($_[2]);
1345
1346                 # input filter if required
1347                 return unless $self->in_filter_route($node);
1348
1349                 $self->route_pc50($node, $_[2], $_[3]) unless eph_dup($line);
1350         }
1351 }
1352
1353 # incoming ping requests/answers
1354 sub handle_51
1355 {
1356         my $self = shift;
1357         my $pcno = shift;
1358         my $line = shift;
1359         my $to = $_[1];
1360         my $from = $_[2];
1361         my $flag = $_[3];
1362
1363
1364         # is it for us?
1365         if ($to eq $main::mycall) {
1366                 if ($flag == 1) {
1367                         $self->send(pc51($from, $to, '0'));
1368                 } else {
1369                         # it's a reply, look in the ping list for this one
1370                         my $ref = $pings{$from};
1371                         if ($ref) {
1372                                 my $tochan =  DXChannel->get($from);
1373                                 while (@$ref) {
1374                                         my $r = shift @$ref;
1375                                         my $dxchan = DXChannel->get($r->{call});
1376                                         next unless $dxchan;
1377                                         my $t = tv_interval($r->{t}, [ gettimeofday ]);
1378                                         if ($dxchan->is_user) {
1379                                                 my $s = sprintf "%.2f", $t;
1380                                                 my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
1381                                                 $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
1382                                         } elsif ($dxchan->is_node) {
1383                                                 if ($tochan) {
1384                                                         my $nopings = $tochan->user->nopings || 2;
1385                                                         push @{$tochan->{pingtime}}, $t;
1386                                                         shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
1387
1388                                                                 # cope with a missed ping, this means you must set the pingint large enough
1389                                                         if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
1390                                                                 $t -= $tochan->{pingint};
1391                                                         }
1392
1393                                                                 # calc smoothed RTT a la TCP
1394                                                         if (@{$tochan->{pingtime}} == 1) {
1395                                                                 $tochan->{pingave} = $t;
1396                                                         } else {
1397                                                                 $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
1398                                                         }
1399                                                         $tochan->{nopings} = $nopings; # pump up the timer
1400                                                 }
1401                                         }
1402                                 }
1403                         }
1404                 }
1405         } else {
1406                 if (eph_dup($line)) {
1407                         dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
1408                         return;
1409                 }
1410                 # route down an appropriate thingy
1411                 $self->route($to, $line);
1412         }
1413 }
1414
1415 # dunno but route it
1416 sub handle_75
1417 {
1418         my $self = shift;
1419         my $pcno = shift;
1420         my $line = shift;
1421         my $call = $_[1];
1422         if ($call ne $main::mycall) {
1423                 $self->route($call, $line);
1424         }
1425 }
1426
1427 # WCY broadcasts
1428 sub handle_73
1429 {
1430         my $self = shift;
1431         my $pcno = shift;
1432         my $line = shift;
1433         my $call = $_[1];
1434
1435         # do some de-duping
1436         my $d = cltounix($call, sprintf("%02d18Z", $_[2]));
1437         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $_[2] < 0 || $_[2] > 23) {
1438                 dbg("PCPROT: WCY Date ($call $_[2]) out of range") if isdbg('chanerr');
1439                 return;
1440         }
1441         @_ = map { unpad($_) } @_;
1442         if (WCY::dup($d)) {
1443                 dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr');
1444                 return;
1445         }
1446
1447         my $wcy = WCY::update($d, @_[2..12]);
1448
1449         my $rep;
1450         eval {
1451                 $rep = Local::wcy($self, @_[1..12]);
1452         };
1453         # dbg("Local::wcy error $@") if isdbg('local') if $@;
1454         return if $rep;
1455
1456         # broadcast to the eager world
1457         send_wcy_spot($self, $line, $d, @_[2..12]);
1458 }
1459
1460 # remote commands (incoming)
1461 sub handle_84
1462 {
1463         my $self = shift;
1464         my $pcno = shift;
1465         my $line = shift;
1466         $self->process_rcmd($_[1], $_[2], $_[3], $_[4]);
1467 }
1468
1469 # remote command replies
1470 sub handle_85
1471 {
1472         my $self = shift;
1473         my $pcno = shift;
1474         my $line = shift;
1475         $self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]);
1476 }
1477
1478 # if get here then rebroadcast the thing with its Hop count decremented (if
1479 # there is one). If it has a hop count and it decrements to zero then don't
1480 # rebroadcast it.
1481 #
1482 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
1483 #        REBROADCAST!!!!
1484 #
1485
1486 sub handle_default
1487 {
1488         my $self = shift;
1489         my $pcno = shift;
1490         my $line = shift;
1491
1492         if (eph_dup($line)) {
1493                 dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
1494         } else {
1495                 unless ($self->{isolate}) {
1496                         DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
1497                 }
1498         }
1499 }
1500
1501 #
1502 # This is called from inside the main cluster processing loop and is used
1503 # for despatching commands that are doing some long processing job
1504 #
1505 sub process
1506 {
1507         my $t = time;
1508         my @dxchan = DXChannel->get_all();
1509         my $dxchan;
1510         my $pc50s;
1511
1512         # send out a pc50 on EVERY channel all at once
1513         if ($t >= $last_pc50 + $DXProt::pc50_interval) {
1514                 $pc50s = pc50($main::me, scalar DXChannel::get_all_users);
1515                 eph_dup($pc50s);
1516                 $last_pc50 = $t;
1517         }
1518
1519         foreach $dxchan (@dxchan) {
1520                 next unless $dxchan->is_node();
1521                 next if $dxchan == $main::me;
1522
1523                 # send the pc50 or PC90
1524                 $dxchan->send($pc50s) if $pc50s;
1525
1526                 # send a ping out on this channel
1527                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
1528                         if ($dxchan->{nopings} <= 0) {
1529                                 $dxchan->disconnect;
1530                         } else {
1531                                 addping($main::mycall, $dxchan->call);
1532                                 $dxchan->{nopings} -= 1;
1533                                 $dxchan->{lastping} = $t;
1534                         }
1535                 }
1536         }
1537
1538         # every ten seconds
1539         if ($t - $last10 >= 10) {
1540                 # clean out ephemera
1541
1542                 eph_clean();
1543
1544                 $last10 = $t;
1545         }
1546
1547         if ($main::systime - 3600 > $last_hour) {
1548                 $last_hour = $main::systime;
1549         }
1550 }
1551
1552 #
1553 # finish up a pc context
1554 #
1555
1556 #
1557 # some active measures
1558 #
1559
1560
1561 sub send_dx_spot
1562 {
1563         my $self = shift;
1564         my $line = shift;
1565         my @dxchan = DXChannel->get_all();
1566         my $dxchan;
1567
1568         # send it if it isn't the except list and isn't isolated and still has a hop count
1569         # taking into account filtering and so on
1570         foreach $dxchan (@dxchan) {
1571                 next if $dxchan == $main::me;
1572                 next if $dxchan == $self && $self->is_node;
1573                 $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call});
1574         }
1575 }
1576
1577 sub dx_spot
1578 {
1579         my $self = shift;
1580         my $line = shift;
1581         my $isolate = shift;
1582         my ($filter, $hops);
1583
1584         if ($self->{spotsfilter}) {
1585                 ($filter, $hops) = $self->{spotsfilter}->it(@_);
1586                 return unless $filter;
1587         }
1588         send_prot_line($self, $filter, $hops, $isolate, $line);
1589 }
1590
1591 sub send_prot_line
1592 {
1593         my ($self, $filter, $hops, $isolate, $line) = @_;
1594         my $routeit;
1595
1596         if ($hops) {
1597                 $routeit = $line;
1598                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1599         } else {
1600                 $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
1601                 return unless $routeit;
1602         }
1603         if ($filter) {
1604                 $self->send($routeit);
1605         } else {
1606                 $self->send($routeit) unless $self->{isolate} || $isolate;
1607         }
1608 }
1609
1610
1611 sub send_wwv_spot
1612 {
1613         my $self = shift;
1614         my $line = shift;
1615         my @dxchan = DXChannel->get_all();
1616         my $dxchan;
1617         my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1618         my @dxcc = Prefix::extract($_[6]);
1619         if (@dxcc > 0) {
1620                 $wwv_dxcc = $dxcc[1]->dxcc;
1621                 $wwv_itu = $dxcc[1]->itu;
1622                 $wwv_cq = $dxcc[1]->cq;
1623         }
1624         @dxcc = Prefix::extract($_[7]);
1625         if (@dxcc > 0) {
1626                 $org_dxcc = $dxcc[1]->dxcc;
1627                 $org_itu = $dxcc[1]->itu;
1628                 $org_cq = $dxcc[1]->cq;
1629         }
1630
1631         # send it if it isn't the except list and isn't isolated and still has a hop count
1632         # taking into account filtering and so on
1633         foreach $dxchan (@dxchan) {
1634                 next if $dxchan == $main::me;
1635                 next if $dxchan == $self && $self->is_node;
1636                 my $routeit;
1637                 my ($filter, $hops);
1638
1639                 $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
1640         }
1641
1642 }
1643
1644 sub wwv
1645 {
1646         my $self = shift;
1647         my $line = shift;
1648         my $isolate = shift;
1649         my ($filter, $hops);
1650
1651         if ($self->{wwvfilter}) {
1652                 ($filter, $hops) = $self->{wwvfilter}->it(@_);
1653                 return unless $filter;
1654         }
1655         send_prot_line($self, $filter, $hops, $isolate, $line)
1656 }
1657
1658 sub send_wcy_spot
1659 {
1660         my $self = shift;
1661         my $line = shift;
1662         my @dxchan = DXChannel->get_all();
1663         my $dxchan;
1664         my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1665         my @dxcc = Prefix::extract($_[10]);
1666         if (@dxcc > 0) {
1667                 $wcy_dxcc = $dxcc[1]->dxcc;
1668                 $wcy_itu = $dxcc[1]->itu;
1669                 $wcy_cq = $dxcc[1]->cq;
1670         }
1671         @dxcc = Prefix::extract($_[11]);
1672         if (@dxcc > 0) {
1673                 $org_dxcc = $dxcc[1]->dxcc;
1674                 $org_itu = $dxcc[1]->itu;
1675                 $org_cq = $dxcc[1]->cq;
1676         }
1677
1678         # send it if it isn't the except list and isn't isolated and still has a hop count
1679         # taking into account filtering and so on
1680         foreach $dxchan (@dxchan) {
1681                 next if $dxchan == $main::me;
1682                 next if $dxchan == $self;
1683
1684                 $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
1685         }
1686 }
1687
1688 sub wcy
1689 {
1690         my $self = shift;
1691         my $line = shift;
1692         my $isolate = shift;
1693         my ($filter, $hops);
1694
1695         if ($self->{wcyfilter}) {
1696                 ($filter, $hops) = $self->{wcyfilter}->it(@_);
1697                 return unless $filter;
1698         }
1699         send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet;
1700 }
1701
1702 # send an announce
1703 sub send_announce
1704 {
1705         my $self = shift;
1706         my $line = shift;
1707         my @dxchan = DXChannel->get_all();
1708         my $dxchan;
1709         my $target;
1710         my $to = 'To ';
1711         my $text = unpad($_[2]);
1712
1713         if ($_[3] eq '*') {     # sysops
1714                 $target = "SYSOP";
1715         } elsif ($_[3] gt ' ') { # speciality list handling
1716                 my ($name) = split /\./, $_[3];
1717                 $target = "$name"; # put the rest in later (if bothered)
1718         }
1719
1720         if ($_[5] eq '1') {
1721                 $target = "WX";
1722                 $to = '';
1723         }
1724         $target = "ALL" if !$target;
1725
1726
1727         # obtain country codes etc
1728         my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1729         my ($ann_state, $org_state) = ("", "");
1730         my @dxcc = Prefix::extract($_[0]);
1731         if (@dxcc > 0) {
1732                 $ann_dxcc = $dxcc[1]->dxcc;
1733                 $ann_itu = $dxcc[1]->itu;
1734                 $ann_cq = $dxcc[1]->cq;
1735                 $ann_state = $dxcc[1]->state;
1736         }
1737         @dxcc = Prefix::extract($_[4]);
1738         if (@dxcc > 0) {
1739                 $org_dxcc = $dxcc[1]->dxcc;
1740                 $org_itu = $dxcc[1]->itu;
1741                 $org_cq = $dxcc[1]->cq;
1742                 $org_state = $dxcc[1]->state;
1743         }
1744
1745         if ($self->{inannfilter}) {
1746                 my ($filter, $hops) =
1747                         $self->{inannfilter}->it(@_, $self->{call},
1748                                                                          $ann_dxcc, $ann_itu, $ann_cq,
1749                                                                          $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
1750                 unless ($filter) {
1751                         dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
1752                         return;
1753                 }
1754         }
1755
1756         if (AnnTalk::dup($_[0], $_[1], $_[2])) {
1757                 dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr');
1758                 return;
1759         }
1760
1761         Log('ann', $target, $_[0], $text);
1762
1763         # send it if it isn't the except list and isn't isolated and still has a hop count
1764         # taking into account filtering and so on
1765         foreach $dxchan (@dxchan) {
1766                 next if $dxchan == $main::me;
1767                 next if $dxchan == $self && $self->is_node;
1768                 $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
1769         }
1770 }
1771
1772 sub announce
1773 {
1774         my $self = shift;
1775         my $line = shift;
1776         my $isolate = shift;
1777         my $to = shift;
1778         my $target = shift;
1779         my $text = shift;
1780         my ($filter, $hops);
1781
1782         if ($self->{annfilter}) {
1783                 ($filter, $hops) = $self->{annfilter}->it(@_);
1784                 return unless $filter;
1785         }
1786         send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
1787 }
1788
1789
1790 sub send_local_config
1791 {
1792         my $self = shift;
1793         my $node;
1794         my @nodes;
1795         my @localnodes;
1796         my @remotenodes;
1797
1798         dbg('DXProt::send_local_config') if isdbg('trace');
1799
1800         # send our nodes
1801         if ($self->{isolate}) {
1802                 @localnodes = ( $main::routeroot );
1803         } else {
1804                 # create a list of all the nodes that are not connected to this connection
1805                 # and are not themselves isolated, this to make sure that isolated nodes
1806         # don't appear outside of this node
1807                 my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
1808                 @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
1809                 my @intcalls = map { $_->nodes } @localnodes if @localnodes;
1810                 my $ref = Route::Node::get($self->{call});
1811                 my @rnodes = $ref->nodes;
1812                 for my $node (@intcalls) {
1813                         push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes;
1814                 }
1815                 unshift @localnodes, $main::routeroot;
1816         }
1817
1818
1819         $self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
1820
1821         # get all the users connected on the above nodes and send them out
1822         foreach $node (@localnodes, @remotenodes) {
1823                 if ($node) {
1824                         my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
1825                         $self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
1826                 } else {
1827                         dbg("sent a null value") if isdbg('chanerr');
1828                 }
1829         }
1830 }
1831
1832 #
1833 # route a message down an appropriate interface for a callsign
1834 #
1835 # is called route(to, pcline);
1836 #
1837 sub route
1838 {
1839         my ($self, $call, $line) = @_;
1840
1841         if (ref $self && $call eq $self->{call}) {
1842                 dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
1843                 return;
1844         }
1845
1846         # always send it down the local interface if available
1847         my $dxchan = DXChannel->get($call);
1848         unless ($dxchan) {
1849                 my $cl = Route::get($call);
1850                 $dxchan = $cl->dxchan if $cl;
1851                 if (ref $dxchan) {
1852                         if (ref $self && $dxchan eq $self) {
1853                                 dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
1854                                 return;
1855                         }
1856                 }
1857         }
1858         if ($dxchan) {
1859                 my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
1860                 if ($routeit) {
1861                         $dxchan->send($routeit) unless $dxchan == $main::me;
1862                 }
1863         } else {
1864                 dbg("PCPROT: No route available, dropped") if isdbg('chanerr');
1865         }
1866 }
1867
1868 #
1869 # obtain the hops from the list for this callsign and pc no
1870 #
1871
1872 sub get_hops
1873 {
1874         my $pcno = shift;
1875         my $hops = $DXProt::hopcount{$pcno};
1876         $hops = $DXProt::def_hopcount if !$hops;
1877         return "H$hops";
1878 }
1879
1880 #
1881 # adjust the hop count on a per node basis using the user loadable
1882 # hop table if available or else decrement an existing one
1883 #
1884
1885 sub adjust_hops
1886 {
1887         my $self = shift;
1888         my $s = shift;
1889         my $call = $self->{call};
1890         my $hops;
1891
1892         if (($hops) = $s =~ /\^H(\d+)\^~?$/o) {
1893                 my ($pcno) = $s =~ /^PC(\d\d)/o;
1894                 confess "$call called adjust_hops with '$s'" unless $pcno;
1895                 my $ref = $nodehops{$call} if %nodehops;
1896                 if ($ref) {
1897                         my $newhops = $ref->{$pcno};
1898                         return "" if defined $newhops && $newhops == 0;
1899                         $newhops = $ref->{default} unless $newhops;
1900                         return "" if defined $newhops && $newhops == 0;
1901                         $newhops = $hops if !$newhops;
1902                         $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
1903                 } else {
1904                         # simply decrement it
1905                         $hops--;
1906                         return "" if !$hops;
1907                         $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
1908                 }
1909         }
1910         return $s;
1911 }
1912
1913 #
1914 # load hop tables
1915 #
1916 sub load_hops
1917 {
1918         my $self = shift;
1919         return $self->msg('lh1') unless -e "$main::data/hop_table.pl";
1920         do "$main::data/hop_table.pl";
1921         return $@ if $@;
1922         return ();
1923 }
1924
1925
1926 # add a ping request to the ping queues
1927 sub addping
1928 {
1929         my ($from, $to) = @_;
1930         my $ref = $pings{$to} || [];
1931         my $r = {};
1932         $r->{call} = $from;
1933         $r->{t} = [ gettimeofday ];
1934         route(undef, $to, pc51($to, $main::mycall, 1));
1935         push @$ref, $r;
1936         $pings{$to} = $ref;
1937 }
1938
1939 sub process_rcmd
1940 {
1941         my ($self, $tonode, $fromnode, $user, $cmd) = @_;
1942         if ($tonode eq $main::mycall) {
1943                 my $ref = DXUser->get_current($fromnode);
1944                 my $cref = Route::Node::get($fromnode);
1945                 Log('rcmd', 'in', $ref->{priv}, $fromnode, $cmd);
1946                 if ($cmd !~ /^\s*rcmd/i && $cref && $ref && $cref->call eq $ref->homenode) { # not allowed to relay RCMDS!
1947                         if ($ref->{priv}) {             # you have to have SOME privilege, the commands have further filtering
1948                                 $self->{remotecmd} = 1; # for the benefit of any command that needs to know
1949                                 my $oldpriv = $self->{priv};
1950                                 $self->{priv} = $ref->{priv}; # assume the user's privilege level
1951                                 my @in = (DXCommandmode::run_cmd($self, $cmd));
1952                                 $self->{priv} = $oldpriv;
1953                                 $self->send_rcmd_reply($main::mycall, $fromnode, $user, @in);
1954                                 delete $self->{remotecmd};
1955                         } else {
1956                                 $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!");
1957                         }
1958                 } else {
1959                         $self->send_rcmd_reply($main::mycall, $fromnode, $user, "your attempt is logged, Tut tut tut...!");
1960                 }
1961         } else {
1962                 my $ref = DXUser->get_current($tonode);
1963                 if ($ref && $ref->is_clx) {
1964                         $self->route($tonode, pc84($fromnode, $tonode, $user, $cmd));
1965                 } else {
1966                         $self->route($tonode, pc34($fromnode, $tonode, $cmd));
1967                 }
1968         }
1969 }
1970
1971 sub process_rcmd_reply
1972 {
1973         my ($self, $tonode, $fromnode, $user, $line) = @_;
1974         if ($tonode eq $main::mycall) {
1975                 my $s = $rcmds{$fromnode};
1976                 if ($s) {
1977                         my $dxchan = DXChannel->get($s->{call});
1978                         my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
1979                         $ref->send($line) if $ref;
1980                         delete $rcmds{$fromnode} if !$dxchan;
1981                 } else {
1982                         # send unsolicited ones to the sysop
1983                         my $dxchan = DXChannel->get($main::myalias);
1984                         $dxchan->send($line) if $dxchan;
1985                 }
1986         } else {
1987                 my $ref = DXUser->get_current($tonode);
1988                 if ($ref && $ref->is_clx) {
1989                         $self->route($tonode, pc85($fromnode, $tonode, $user, $line));
1990                 } else {
1991                         $self->route($tonode, pc35($fromnode, $tonode, $line));
1992                 }
1993         }
1994 }
1995
1996 sub send_rcmd_reply
1997 {
1998         my $self = shift;
1999         my $tonode = shift;
2000         my $fromnode = shift;
2001         my $user = shift;
2002         while (@_) {
2003                 my $line = shift;
2004                 $line =~ s/\s*$//;
2005                 Log('rcmd', 'out', $fromnode, $line);
2006                 if ($self->is_clx) {
2007                         $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line"));
2008                 } else {
2009                         $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line"));
2010                 }
2011         }
2012 }
2013
2014 # add a rcmd request to the rcmd queues
2015 sub addrcmd
2016 {
2017         my ($self, $to, $cmd) = @_;
2018
2019         my $r = {};
2020         $r->{call} = $self->{call};
2021         $r->{t} = $main::systime;
2022         $r->{cmd} = $cmd;
2023         $rcmds{$to} = $r;
2024
2025         my $ref = Route::Node::get($to);
2026         my $dxchan = $ref->dxchan;
2027         if ($dxchan && $dxchan->is_clx) {
2028                 route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd));
2029         } else {
2030                 route(undef, $to, pc34($main::mycall, $to, $cmd));
2031         }
2032 }
2033
2034 sub disconnect
2035 {
2036         my $self = shift;
2037         my $pc39flag = shift;
2038         my $call = $self->call;
2039
2040         return if $self->{disconnecting}++;
2041
2042         unless ($pc39flag && $pc39flag == 1) {
2043                 $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op")));
2044         }
2045
2046         # get rid of any PC16/17/19
2047         eph_del_regex("^PC1[679]*$call");
2048
2049         # do routing stuff, remove me from routing table
2050         my $node = Route::Node::get($call);
2051         my @rout;
2052         if ($node) {
2053                 @rout = $node->del($main::routeroot);
2054
2055                 # and all my ephemera as well
2056                 for (@rout) {
2057                         my $c = $_->call;
2058                         eph_del_regex("^PC1[679].*$c");
2059                 }
2060         }
2061
2062         # remove them from the pc19list as well
2063         while (my ($k,$v) = each %pc19list) {
2064                 my @l = grep {$_->[0] ne $call} @{$pc19list{$k}};
2065                 if (@l) {
2066                         $pc19list{$k} = \@l;
2067                 } else {
2068                         delete $pc19list{$k};
2069                 }
2070
2071                 # and the ephemera
2072                 eph_del_regex("^PC1[679].*$k");
2073         }
2074
2075         # unbusy and stop and outgoing mail
2076         my $mref = DXMsg::get_busy($call);
2077         $mref->stop_msg($call) if $mref;
2078
2079         # broadcast to all other nodes that all the nodes connected to via me are gone
2080         unless ($pc39flag && $pc39flag == 2) {
2081                 $self->route_pc21(@rout) if @rout;
2082         }
2083
2084         # remove outstanding pings
2085         delete $pings{$call};
2086
2087         # I was the last node visited
2088     $self->user->node($main::mycall);
2089
2090         # send info to all logged in thingies
2091         $self->tell_login('logoutn');
2092
2093         Log('DXProt', $call . " Disconnected");
2094
2095         $self->SUPER::disconnect;
2096 }
2097
2098
2099 #
2100 # send a talk message to this thingy
2101 #
2102 sub talk
2103 {
2104         my ($self, $from, $to, $via, $line, $origin) = @_;
2105
2106         $line =~ s/\^/\\5E/g;                   # remove any ^ characters
2107         $self->send(DXProt::pc10($from, $to, $via, $line, $origin));
2108         Log('talk', $to, $from, $via?$via:$self->call, $line) unless $origin && $origin ne $main::mycall;
2109 }
2110
2111 # send it if it isn't the except list and isn't isolated and still has a hop count
2112 # taking into account filtering and so on
2113 sub send_route
2114 {
2115         my $self = shift;
2116         my $generate = shift;
2117         my $no = shift;     # the no of things to filter on
2118         my $routeit;
2119         my ($filter, $hops);
2120         my @rin;
2121
2122         for (; @_ && $no; $no--) {
2123                 my $r = shift;
2124
2125                 if (!$self->{isolate} && $self->{routefilter}) {
2126                         $filter = undef;
2127                         if ($r) {
2128                                 ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->{state}, $r->{state});
2129                                 if ($filter) {
2130                                         push @rin, $r;
2131                                 } else {
2132                                         dbg("DXPROT: $self->{call}/" . $r->call . " rejected by output filter") if isdbg('chanerr');
2133                                 }
2134                         } else {
2135                                 dbg("was sent a null value") if isdbg('chanerr');
2136                         }
2137                 } else {
2138                         push @rin, $r unless $self->{isolate} && $r->call ne $main::mycall;
2139                 }
2140         }
2141         if (@rin) {
2142                 foreach my $line (&$generate(@rin, @_)) {
2143                         if ($hops) {
2144                                 $routeit = $line;
2145                                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
2146                         } else {
2147                                 $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
2148                                 next unless $routeit;
2149                         }
2150                         $self->send($routeit);
2151                 }
2152         }
2153 }
2154
2155 sub broadcast_route
2156 {
2157         my $self = shift;
2158         my $generate = shift;
2159         my @dxchan = DXChannel::get_all_nodes();
2160         my $dxchan;
2161         my $line;
2162
2163         unless ($self->{isolate}) {
2164                 foreach $dxchan (@dxchan) {
2165                         next if $dxchan == $self;
2166                         next if $dxchan == $main::me;
2167                         next unless $dxchan->isa('DXProt');
2168                         next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
2169
2170                         $dxchan->send_route($generate, @_);
2171                 }
2172         }
2173 }
2174
2175 sub route_pc16
2176 {
2177         my $self = shift;
2178         return unless $self->user->wantpc16;
2179         broadcast_route($self, \&pc16, 1, @_);
2180 }
2181
2182 sub route_pc17
2183 {
2184         my $self = shift;
2185         return unless $self->user->wantpc16;
2186         broadcast_route($self, \&pc17, 1, @_);
2187 }
2188
2189 sub route_pc19
2190 {
2191         my $self = shift;
2192         broadcast_route($self, \&pc19, scalar @_, @_);
2193 }
2194
2195 sub route_pc21
2196 {
2197         my $self = shift;
2198         broadcast_route($self, \&pc21, scalar @_, @_);
2199 }
2200
2201 sub route_pc24
2202 {
2203         my $self = shift;
2204         broadcast_route($self, \&pc24, 1, @_);
2205 }
2206
2207 sub route_pc41
2208 {
2209         my $self = shift;
2210         broadcast_route($self, \&pc41, 1, @_);
2211 }
2212
2213 sub route_pc50
2214 {
2215         my $self = shift;
2216         broadcast_route($self, \&pc50, 1, @_);
2217 }
2218
2219 sub route_pc90
2220 {
2221         my $self = shift;
2222         broadcast_route($self, \&pc90, 1, @_);
2223 }
2224
2225 sub in_filter_route
2226 {
2227         my $self = shift;
2228         my $r = shift;
2229         my ($filter, $hops) = (1, 1);
2230
2231         if ($self->{inroutefilter}) {
2232                 ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->state, $r->state);
2233                 dbg("PCPROT: $self->{call}/" . $r->call . ' rejected by in_filter_route') if !$filter && isdbg('chanerr');
2234         }
2235         return $filter;
2236 }
2237
2238 sub eph_dup
2239 {
2240         my $s = shift;
2241         my $t = shift || $eph_restime;
2242         my $r;
2243
2244         # chop the end off
2245         $s =~ s/\^H\d\d?\^?\~?$//;
2246         $r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
2247         $eph{$s} = $main::systime + $t;
2248         return $r;
2249 }
2250
2251 sub eph_del_regex
2252 {
2253         my $regex = shift;
2254         my ($key, $val);
2255         while (($key, $val) = each %eph) {
2256                 if ($key =~ m{$regex}) {
2257                         delete $eph{$key};
2258                 }
2259         }
2260 }
2261
2262 sub eph_clean
2263 {
2264         my ($key, $val);
2265
2266         while (($key, $val) = each %eph) {
2267                 if ($main::systime >= $val) {
2268                         delete $eph{$key};
2269                 }
2270         }
2271 }
2272
2273 sub eph_list
2274 {
2275         my ($key, $val);
2276         my @out;
2277
2278         while (($key, $val) = each %eph) {
2279                 push @out, $key, $val;
2280         }
2281         return @out;
2282 }
2283
2284 sub run_cmd
2285 {
2286         goto &DXCommandmode::run_cmd;
2287 }
2288 1;
2289 __END__