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