]> www.dxcluster.org Git - spider.git/blob - perl/DXProtHandle.pm
4a2be35765f854d815ae805a28847ac399d869ed
[spider.git] / perl / DXProtHandle.pm
1 #
2 #
3 # This module impliments the handlers for the protocal mode for a dx cluster
4 #
5 # Copyright (c) 1998-2006 Dirk Koopman G1TLH
6 #
7 #
8 #
9
10 package DXProt;
11
12 @ISA = qw(DXChannel);
13
14 use DXUtil;
15 use DXChannel;
16 use DXUser;
17 use DXM;
18 use DXProtVars;
19 use DXCommandmode;
20 use DXLog;
21 use Spot;
22 use DXProtout;
23 use DXDebug;
24 use Filter;
25 use Local;
26 use DXDb;
27 use AnnTalk;
28 use Geomag;
29 use WCY;
30 use BadWords;
31 use DXHash;
32 use Route;
33 use Route::Node;
34 use Script;
35 use RouteDB;
36
37
38 use strict;
39
40 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
41                         $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
42                         $pingint $obscount %pc19list $chatdupeage $chatimportfn
43                         $investigation_int $pc19_version $myprot_version
44                         %nodehops $baddx $badspotter $badnode $censorpc $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('obscount');
1598                         if ($oparent != $parent) {
1599                                 $parent->reset_obs;
1600                                 dbg("ROUTE: reset obscount on $parent->{call} now " . $parent->obscount) if isdbg('obscount');
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         unless (eph_dup($line)) {
1763                 if ($pcno >= 90) {
1764                         my $pcall = $_[1];
1765                         unless (is_callsign($pcall)) {
1766                                 dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr');
1767                                 return;
1768                         }
1769                         my $t = $_[2];
1770                         my $parent = check_pc9x_t($pcall, $t, $pcno, 1) || return;
1771                         $self->broadcast_route_pc9x($pcall, undef, $line, 0);
1772                 } else {
1773                         unless ($self->{isolate}) {
1774                                 DXChannel::broadcast_nodes($line, $self) if $line =~ /\^H\d+\^?~?$/; # send it to everyone but me
1775                         }
1776                 }
1777         }
1778 }
1779
1780 1;