]> scm.dxcluster.org Git - spider.git/blob - perl/DXProt.pm
26d1b169854b585ee1cd94a136da525cb1ff47d7
[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 DXCluster;
19 use DXProtVars;
20 use DXCommandmode;
21 use DXLog;
22 use Spot;
23 use DXProtout;
24 use DXDebug;
25 use Filter;
26 use Local;
27 use DXDb;
28 use AnnTalk;
29 use Geomag;
30 use WCY;
31 use Time::HiRes qw(gettimeofday tv_interval);
32
33 use strict;
34 use vars qw($me $pc11_max_age $pc23_max_age
35                         $last_hour %pings %rcmds
36                         %nodehops @baddx $baddxfn 
37                         $allowzero $decode_dk0wcy $send_opernam @checklist);
38
39 $me = undef;                                    # the channel id for this cluster
40 $pc11_max_age = 1*3600;                 # the maximum age for an incoming 'real-time' pc11
41 $pc23_max_age = 1*3600;                 # the maximum age for an incoming 'real-time' pc23
42
43 $last_hour = time;                              # last time I did an hourly periodic update
44 %pings = ();                    # outstanding ping requests outbound
45 %rcmds = ();                    # outstanding rcmd requests outbound
46 %nodehops = ();                 # node specific hop control
47 @baddx = ();                    # list of illegal spotted callsigns
48
49
50 $baddxfn = "$main::data/baddx.pl";
51
52 @checklist = 
53 (
54  [ qw(c c m p bc c) ],                  # pc10
55  [ qw(f m d t m c c h) ],               # pc11
56  [ qw(c bc m bp bm p h) ],              # pc12
57  [ qw(c h) ],                                   # 
58  [ qw(c h) ],                                   # 
59  [ qw(c m h) ],                                 # 
60  undef ,                                                # pc16 has to be validated manually
61  [ qw(c c h) ],                                 # pc17
62  [ qw(m n) ],                                   # pc18
63  undef ,                                                # pc19 has to be validated manually
64  undef ,                                                # pc20 no validation
65  [ qw(c m h) ],                                 # pc21
66  undef ,                                                # pc22 no validation
67  [ qw(d n n n n m c c h) ],             # pc23
68  [ qw(c p h) ],                                 # pc24
69  [ qw(c c n n) ],                               # pc25
70  [ qw(f m d t m c c bc) ],              # pc26
71  [ qw(d n n n n m c c bc) ],    # pc27
72  [ qw(c c c c d t p m bp n p bp bc) ], # pc28
73  [ qw(c c n m) ],                               # pc29
74  [ qw(c c n) ],                                 # pc30
75  [ qw(c c n) ],                                 # pc31
76  [ qw(c c n) ],                                 # pc32
77  [ qw(c c n) ],                                 # pc33
78  [ qw(c c m) ],                                 # pc34
79  [ qw(c c m) ],                                 # pc35
80  [ qw(c c m) ],                                 # pc36
81  [ qw(c c n m) ],                               # pc37
82  undef,                                                 # pc38 not interested
83  [ qw(c m) ],                                   # pc39
84  [ qw(c c m p n) ],                             # pc40
85  [ qw(c n m h) ],                               # pc41
86  [ qw(c c n) ],                                 # pc42
87  undef,                                                 # pc43 don't handle it
88  [ qw(c c n m m c) ],                   # pc44
89  [ qw(c c n m) ],                               # pc45
90  [ qw(c c n) ],                                 # pc46
91  undef,                                                 # pc47
92  undef,                                                 # pc48
93  [ qw(c m h) ],                                 # pc49
94  [ qw(c n h) ],                                 # pc50
95  [ qw(c c n) ],                                 # pc51
96  undef,
97  undef,
98  undef,
99  undef,
100  undef,
101  undef,
102  undef,
103  undef,
104  undef,                                                 # pc60
105  undef,
106  undef,
107  undef,
108  undef,
109  undef,
110  undef,
111  undef,
112  undef,
113  undef,
114  undef,                                                 # pc70
115  undef,
116  undef,
117  [ qw(d n n n n n n m m m c c h) ],     # pc73
118  undef,
119  undef,
120  undef,
121  undef,
122  undef,
123  undef,
124  undef,                                                 # pc80
125  undef,
126  undef,
127  undef,
128  [ qw(c c c m) ],                               # pc84
129  [ qw(c c c m) ],                               # pc85
130 );
131
132 # use the entry in the check list to check the field list presented
133 # return OK if line NOT in check list (for now)
134 sub check
135 {
136         my $n = shift;
137         $n -= 10;
138         return 0 if $n < 0 || $n > @checklist; 
139         my $ref = $checklist[$n];
140         return 0 unless ref $ref;
141         
142         my $i;
143         shift;    # not interested in the first field
144         for ($i = 0; $i < @$ref; $i++) {
145                 my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
146                 return 0 unless $act;
147                 next if $blank && $_[$i] =~ /^[ \*]$/;
148                 if ($act eq 'c') {
149                         return $i+1 unless is_callsign($_[$i]);
150                 } elsif ($act eq 'm') {
151                         return $i+1 unless is_pctext($_[$i]);
152                 } elsif ($act eq 'p') {
153                         return $i+1 unless is_pcflag($_[$i]);
154                 } elsif ($act eq 'f') {
155                         return $i+1 unless is_freq($_[$i]);
156                 } elsif ($act eq 'n') {
157                         return $i+1 unless $_[$i] =~ /^[\d ]+$/;
158                 } elsif ($act eq 'h') {
159                         return $i+1 unless $_[$i] =~ /^H\d\d?$/;
160                 } elsif ($act eq 'd') {
161                         return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
162                 } elsif ($act eq 't') {
163                         return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
164                 }
165         }
166         return 0;
167 }
168
169 sub init
170 {
171         my $user = DXUser->get($main::mycall);
172         $DXProt::myprot_version += $main::version*100;
173         $me = DXProt->new($main::mycall, 0, $user); 
174         $me->{here} = 1;
175         $me->{state} = "indifferent";
176         do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
177         confess $@ if $@;
178         $me->{sort} = 'S';    # S for spider
179
180         # now prime the spot and wwv  duplicates file with data
181 #    my @today = Julian::unixtoj(time);
182 #       for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) {
183 #               Spot::dup(@{$_}[0..3]);
184 #       }
185 #       for (Geomag::readfile(time)) {
186 #               Geomag::dup(@{$_}[1..5]);
187 #       }
188
189         # load the baddx file
190         do "$baddxfn" if -e "$baddxfn";
191         print "$@\n" if $@;
192 }
193
194 #
195 # obtain a new connection this is derived from dxchannel
196 #
197
198 sub new 
199 {
200         my $self = DXChannel::alloc(@_);
201         return $self;
202 }
203
204 # this is how a pc connection starts (for an incoming connection)
205 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
206 # all the crap that comes between).
207 sub start
208 {
209         my ($self, $line, $sort) = @_;
210         my $call = $self->{call};
211         my $user = $self->{user};
212         
213         # remember type of connection
214         $self->{consort} = $line;
215         $self->{outbound} = $sort eq 'O';
216         $self->{priv} = $user->priv || 1;     # other clusters can always be 'normal' users
217         $self->{lang} = $user->lang || 'en';
218         $self->{isolate} = $user->{isolate};
219         $self->{consort} = $line;       # save the connection type
220         $self->{here} = 1;
221
222         # get the INPUT filters (these only pertain to Clusters)
223         $self->{inspotfilter} = Filter::read_in('spots', $call, 1);
224         $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1);
225         $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1);
226         $self->{inannfilter} = Filter::read_in('ann', $call, 1);
227         
228         # set unbuffered and no echo
229         $self->send_now('B',"0");
230         $self->send_now('E',"0");
231         
232         # ping neighbour node stuff
233         my $ping = $user->pingint;
234         $ping = 5*60 unless defined $ping;
235         $self->{pingint} = $ping;
236         $self->{nopings} = $user->nopings || 2;
237         $self->{pingtime} = [ ];
238         $self->{pingave} = 0;
239
240         # send initialisation string
241         unless ($self->{outbound}) {
242                 $self->send(pc38()) if DXNode->get_all();
243                 $self->send(pc18());
244                 $self->{lastping} = $main::systime;
245         } else {
246                 # remove from outstanding connects queue
247                 @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects;
248                 $self->{lastping} = $main::systime + $self->pingint / 2;
249         }
250         $self->state('init');
251         $self->pc50_t(time);
252
253         # send info to all logged in thingies
254         $self->tell_login('loginn');
255
256         Log('DXProt', "$call connected");
257 }
258
259 #
260 # This is the normal pcxx despatcher
261 #
262 sub normal
263 {
264         my ($self, $line) = @_;
265         my @field = split /\^/, $line;
266         return unless @field;
267         
268         pop @field if $field[-1] eq '~';
269         
270 #       print join(',', @field), "\n";
271                                                 
272         # ignore any lines that don't start with PC
273         return if !$field[0] =~ /^PC/;
274         
275         # process PC frames
276         my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
277         return unless $pcno;
278         return if $pcno < 10 || $pcno > 99;
279
280         # check for and dump bad protocol messages
281         my $n = check($pcno, @field);
282         if ($n) {
283                 dbg('chan', "bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")");
284                 return;
285         }
286
287         # local processing 1
288         my $pcr;
289         eval {
290                 $pcr = Local::pcprot($self, $pcno, @field);
291         };
292 #       dbg('local', "Local::pcprot error $@") if $@;
293         return if $pcr;
294         
295  SWITCH: {
296                 if ($pcno == 10) {              # incoming talk
297                         
298                         # is it for me or one of mine?
299                         my ($to, $via, $call, $dxchan);
300                         if ($field[5] gt ' ') {
301                                 $call = $via = $field[2];
302                                 $to = $field[5];
303                                 unless (is_callsign($to)) {
304                                         dbg('chan', "Corrupt talk, rejected");
305                                         return;
306                                 }
307                         } else {
308                                 $call = $to = $field[2];
309                         }
310                         if ($dxchan = DXChannel->get($call)) {
311                                 $dxchan->talk($field[1], $to, $via, $field[3]);
312                         } else {
313                                 $self->route($field[2], $line); # relay it on its way
314                         }
315                         return;
316                 }
317                 
318                 if ($pcno == 11 || $pcno == 26) { # dx spot
319
320                         # route 'foreign' pc26s 
321                         if ($pcno == 26) {
322                                 if ($field[7] ne $main::mycall) {
323                                         $self->route($field[7], $line);
324                                         return;
325                                 }
326                         }
327                         
328                         # if this is a 'nodx' node then ignore it
329                         if (grep $field[7] =~ /^$_/,  @DXProt::nodx_node) {
330                                 dbg('chan', "Bad DXNode, dropped");
331                                 return;
332                         }
333                         
334                         # convert the date to a unix date
335                         my $d = cltounix($field[3], $field[4]);
336                         # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
337                         if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
338                                 dbg('chan', "Spot ignored, invalid date or out of range ($field[3] $field[4])\n");
339                                 return;
340                         }
341
342                         # is it 'baddx'
343                         if (grep $field[2] eq $_, @baddx) {
344                                 dbg('chan', "Bad DX spot, ignored");
345                                 return;
346                         }
347                         
348                         # do some de-duping
349                         $field[5] =~ s/^\s+//;      # take any leading blanks off
350                         if (Spot::dup($field[1], $field[2], $d, $field[5])) {
351                                 dbg('chan', "Duplicate Spot ignored\n");
352                                 return;
353                         }
354                         
355                         my @spot = Spot::add($field[1], $field[2], $d, $field[5], $field[6], $field[7]);
356
357             #
358                         # @spot at this point contains:-
359             # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
360                         # then  spotted itu, spotted cq, spotters itu, spotters cq
361                         # you should be able to route on any of these
362             #
363                         
364                         # fix up qra locators of known users 
365                         my $user = DXUser->get_current($spot[4]);
366                         if ($user) {
367                                 my $qra = $user->qra;
368                                 unless ($qra && DXBearing::is_qra($qra)) {
369                                         my $lat = $user->lat;
370                                         my $long = $user->long;
371                                         if (defined $lat && defined $long) {
372                                                 $user->qra(DXBearing::lltoqra($lat, $long)); 
373                                                 $user->put;
374                                         }
375                                 }
376
377                                 # send a remote command to a distant cluster if it is visible and there is no
378                                 # qra locator and we havn't done it for a month.
379
380                                 unless ($user->qra) {
381                                         my $node;
382                                         my $to = $user->homenode;
383                                         my $last = $user->lastoper || 0;
384                                         if ($send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = DXCluster->get_exact($to)) ) {
385                                                 my $cmd = "forward/opernam $spot[4]";
386                                                 # send the rcmd but we aren't interested in the replies...
387                                                 if ($node && $node->dxchan && $node->dxchan->is_clx) {
388                                                         route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
389                                                 } else {
390                                                         route(undef, $to, pc34($main::mycall, $to, $cmd));
391                                                 }
392                                                 if ($to ne $field[7]) {
393                                                         $to = $field[7];
394                                                         $node = DXCluster->get_exact($to);
395                                                         if ($node && $node->dxchan && $node->dxchan->is_clx) {
396                                                                 route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
397                                                         } else {
398                                                                 route(undef, $to, pc34($main::mycall, $to, $cmd));
399                                                         }
400                                                 }
401                                                 $user->lastoper($main::systime);
402                                                 $user->put;
403                                         }
404                                 }
405                         }
406                                 
407                         # local processing 
408                         my $r;
409                         eval {
410                                 $r = Local::spot($self, @spot);
411                         };
412 #                       dbg('local', "Local::spot1 error $@") if $@;
413                         return if $r;
414
415                         # DON'T be silly and send on PC26s!
416                         return if $pcno == 26;
417
418                         # send out the filtered spots
419                         send_dx_spot($self, $line, @spot) if @spot;
420                         return;
421                 }
422                 
423                 if ($pcno == 12) {              # announces
424                         # announce duplicate checking
425                         $field[3] =~ s/^\s+//;  # remove leading blanks
426                         if (AnnTalk::dup($field[1], $field[2], $field[3])) {
427                                 dbg('chan', "Duplicate Announce ignored");
428                                 return;
429                         }
430                         
431                         if ($field[2] eq '*' || $field[2] eq $main::mycall) {
432                                 
433                                 # global ann filtering on INPUT
434                                 if ($self->{inannfilter}) {
435                                         my ($filter, $hops) = Filter::it($self->{inannfilter}, @field[1..6], $self->{call} );
436                                         unless ($filter) {
437                                                 dbg('chan', "Rejected by filter");
438                                                 return;
439                                         }
440                                 }
441
442                                 # send it
443                                 $self->send_announce($line, @field[1..6]);
444                         } else {
445                                 $self->route($field[2], $line);
446                         }
447                         
448                         return;
449                 }
450                 
451                 if ($pcno == 13) {
452                         last SWITCH;
453                 }
454                 if ($pcno == 14) {
455                         last SWITCH;
456                 }
457                 if ($pcno == 15) {
458                         last SWITCH;
459                 }
460                 
461                 if ($pcno == 16) {              # add a user
462                         my $node = DXCluster->get_exact($field[1]); 
463                         my $dxchan;
464                         if (!$node && ($dxchan = DXChannel->get($field[1]))) {
465                                 # add it to the node table if it isn't present and it's
466                                 # connected locally
467                                 $node = DXNode->new($dxchan, $field[1], 0, 1, 5400);
468                                 broadcast_ak1a(pc19($dxchan, $node), $dxchan, $self) unless $dxchan->{isolate};
469                                 
470                         }
471                         return unless $node; # ignore if havn't seen a PC19 for this one yet
472                         return unless $node->isa('DXNode');
473                         if ($node->dxchan != $self) {
474                                 dbg('chan', "LOOP: $field[1] came in on wrong channel");
475                                 return;
476                         }
477                         if (($dxchan = DXChannel->get($field[1])) && $dxchan != $self) {
478                                 dbg('chan', "LOOP: $field[1] connected locally");
479                                 return;
480                         }
481                         my $i;
482                                                 
483                         for ($i = 2; $i < $#field; $i++) {
484                                 my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
485                                 next if !$call || length $call < 3 || length $call > 8;
486                                 next if !$confmode;
487                                 $call = uc $call;
488                                 next if DXCluster->get_exact($call); # we already have this (loop?)
489                                 
490                                 $confmode = $confmode eq '*';
491                                 DXNodeuser->new($self, $node, $call, $confmode, $here);
492                                 
493                                 # add this station to the user database, if required
494                                 $call =~ s/-\d+$//o;        # remove ssid for users
495                                 my $user = DXUser->get_current($call);
496                                 $user = DXUser->new($call) if !$user;
497                                 $user->homenode($node->call) if !$user->homenode;
498                                 $user->node($node->call);
499                                 $user->lastin($main::systime) unless DXChannel->get($call);
500                                 $user->put;
501                         }
502                         
503                         # queue up any messages (look for privates only)
504                         DXMsg::queue_msg(1) if $self->state eq 'normal';     
505                         last SWITCH;
506                 }
507                 
508                 if ($pcno == 17) {              # remove a user
509                         my $node = DXCluster->get_exact($field[2]);
510                         my $dxchan;
511                         if (!$node && ($dxchan = DXChannel->get($field[2]))) {
512                                 # add it to the node table if it isn't present and it's
513                                 # connected locally
514                                 $node = DXNode->new($dxchan, $field[2], 0, 1, 5400);
515                                 broadcast_ak1a(pc19($dxchan, $node), $dxchan, $self) unless $dxchan->{isolate};
516                                 return;
517                         }
518                         return unless $node;
519                         return unless $node->isa('DXNode');
520                         if ($node->dxchan != $self) {
521                                 dbg('chan', "LOOP: $field[2] came in on wrong channel");
522                                 return;
523                         }
524                         if (($dxchan = DXChannel->get($field[2])) && $dxchan != $self) {
525                                 dbg('chan', "LOOP: $field[2] connected locally");
526                                 return;
527                         }
528                         my $ref = DXCluster->get_exact($field[1]);
529                         $ref->del() if $ref;
530                         last SWITCH;
531                 }
532                 
533                 if ($pcno == 18) {              # link request
534                         $self->state('init');   
535
536                         # first clear out any nodes on this dxchannel
537                         my @gonenodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all();
538                         foreach my $node (@gonenodes) {
539                                 next if $node->dxchan == $DXProt::me;
540                                 broadcast_ak1a(pc21($node->call, 'Gone, re-init') , $self) unless $self->{isolate}; 
541                                 $node->del();
542                         }
543                         $self->send_local_config();
544                         $self->send(pc20());
545                         return;             # we don't pass these on
546                 }
547                 
548                 if ($pcno == 19) {              # incoming cluster list
549                         my $i;
550                         my $newline = "PC19^";
551                         for ($i = 1; $i < $#field-1; $i += 4) {
552                                 my $here = $field[$i];
553                                 my $call = uc $field[$i+1];
554                                 my $confmode = $field[$i+2];
555                                 my $ver = $field[$i+3];
556
557                                 $ver = 5400 if !$ver && $allowzero;
558                                 
559                                 # now check the call over
560                                 my $node = DXCluster->get_exact($call);
561                                 if ($node) {
562                                         my $dxchan;
563                                         if (($dxchan = DXChannel->get($call)) && $dxchan != $self) {
564                                                 dbg('chan', "LOOP: $call connected locally");
565                                         }
566                                     if ($node->dxchan != $self) {
567                                                 dbg('chan', "LOOP: $call come in on wrong channel");
568                                                 next;
569                                         }
570                                         dbg('chan', "already have $call");
571                                         next;
572                                 }
573                                 
574                                 # check for sane parameters
575                                 next if $ver < 5000; # only works with version 5 software
576                                 next if length $call < 3; # min 3 letter callsigns
577
578                                 # add it to the nodes table and outgoing line
579                                 $newline .= "$here^$call^$confmode^$ver^";
580                                 DXNode->new($self, $call, $confmode, $here, $ver);
581                                 
582                                 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
583                                 my $mref = DXMsg::get_busy($call);
584                                 $mref->stop_msg($call) if $mref;
585                                 
586                                 # add this station to the user database, if required (don't remove SSID from nodes)
587                                 my $user = DXUser->get_current($call);
588                                 if (!$user) {
589                                         $user = DXUser->new($call);
590                                         $user->sort('A');
591                                         $user->priv(1);                   # I have relented and defaulted nodes
592                                         $self->{priv} = 1;                # to user RCMDs allowed
593                                         $user->homenode($call);
594                                         $user->node($call);
595                                 }
596                                 $user->lastin($main::systime) unless DXChannel->get($call);
597                                 $user->put;
598                         }
599                         
600                         return if $newline eq "PC19^";
601
602                         # add hop count 
603                         $newline .=  get_hops(19) . "^";
604                         $line = $newline;
605                         last SWITCH;
606                 }
607                 
608                 if ($pcno == 20) {              # send local configuration
609                         $self->send_local_config();
610                         $self->send(pc22());
611                         $self->state('normal');
612                         return;
613                 }
614                 
615                 if ($pcno == 21) {              # delete a cluster from the list
616                         my $call = uc $field[1];
617                         if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
618                                 my $node = DXCluster->get_exact($call);
619                                 if ($node) {
620                                         if ($node->dxchan != $self) {
621                                                 dbg('chan', "LOOP: $call come in on wrong channel");
622                                                 return;
623                                         }
624                                         my $dxchan;
625                                         if (($dxchan = DXChannel->get($call)) && $dxchan != $self) {
626                                                 dbg('chan', "LOOP: $call connected locally");
627                                                 return;
628                                         }
629                                         $node->del();
630                                 } else {
631                                         dbg('chan', "$call not in table, dropped");
632                                         return;
633                                 }
634                         }
635                         last SWITCH;
636                 }
637                 
638                 if ($pcno == 22) {
639                         $self->state('normal');
640                         return;
641                 }
642                                 
643                 if ($pcno == 23 || $pcno == 27) { # WWV info
644                         
645                         # route 'foreign' pc27s 
646                         if ($pcno == 27) {
647                                 if ($field[8] ne $main::mycall) {
648                                         $self->route($field[8], $line);
649                                         return;
650                                 }
651                         }
652
653                         # do some de-duping
654                         my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
655                         my $sfi = unpad($field[3]);
656                         my $k = unpad($field[4]);
657                         my $i = unpad($field[5]);
658                         my ($r) = $field[6] =~ /R=(\d+)/;
659                         $r = 0 unless $r;
660                         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
661                                 dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
662                                 return;
663                         }
664                         if (Geomag::dup($d,$sfi,$k,$i,$field[6])) {
665                                 dbg('chan', "Dup WWV Spot ignored\n");
666                                 return;
667                         }
668                         $field[7] =~ s/-\d+$//o;            # remove spotter's ssid
669                 
670                         my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8], $r);
671
672                         my $rep;
673                         eval {
674                                 $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r);
675                         };
676 #                       dbg('local', "Local::wwv2 error $@") if $@;
677                         return if $rep;
678
679                         # DON'T be silly and send on PC27s!
680                         return if $pcno == 27;
681
682                         # broadcast to the eager world
683                         send_wwv_spot($self, $line, $d, $field[2], $sfi, $k, $i, @field[6..8]);
684                         return;
685                 }
686                 
687                 if ($pcno == 24) {              # set here status
688                         my $call = uc $field[1];
689                         my $ref = DXCluster->get_exact($call);
690                         $ref->here($field[2]) if $ref;
691                         last SWITCH;
692                 }
693                 
694                 if ($pcno == 25) {      # merge request
695                         if ($field[1] ne $main::mycall) {
696                                 $self->route($field[1], $line);
697                                 return;
698                         }
699                         if ($field[2] eq $main::mycall) {
700                                 dbg('chan', "Trying to merge to myself, ignored");
701                                 return;
702                         }
703
704                         Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[1]");
705                         
706                         # spots
707                         if ($field[3] > 0) {
708                                 my @in = reverse Spot::search(1, undef, undef, 0, $field[3]);
709                                 my $in;
710                                 foreach $in (@in) {
711                                         $self->send(pc26(@{$in}[0..4], $field[2]));
712                                 }
713                         }
714
715                         # wwv
716                         if ($field[4] > 0) {
717                                 my @in = reverse Geomag::search(0, $field[4], time, 1);
718                                 my $in;
719                                 foreach $in (@in) {
720                                         $self->send(pc27(@{$in}[0..5], $field[2]));
721                                 }
722                         }
723                         return;
724                 }
725
726                 if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
727                         if ($pcno == 49 || $field[1] eq $main::mycall) {
728                                 DXMsg::process($self, $line);
729                         } else {
730                                 $self->route($field[1], $line) unless $self->is_clx;
731                         }
732                         return;
733                 }
734                 
735                 if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
736                         if ($field[1] eq $main::mycall) {
737                                 my $ref = DXUser->get_current($field[2]);
738                                 my $cref = DXCluster->get($field[2]);
739                                 Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]);
740                                 unless (!$cref || !$ref || $cref->mynode->call ne $ref->homenode) {    # not allowed to relay RCMDS!
741                                         if ($ref->{priv}) {     # you have to have SOME privilege, the commands have further filtering
742                                                 $self->{remotecmd} = 1; # for the benefit of any command that needs to know
743                                                 my $oldpriv = $self->{priv};
744                                                 $self->{priv} = $ref->{priv};     # assume the user's privilege level
745                                                 my @in = (DXCommandmode::run_cmd($self, $field[3]));
746                                                 $self->{priv} = $oldpriv;
747                                                 for (@in) {
748                                                         s/\s*$//og;
749                                                         $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_"));
750                                                         Log('rcmd', 'out', $field[2], $_);
751                                                 }
752                                                 delete $self->{remotecmd};
753                                         } else {
754                                                 $self->send(pc35($main::mycall, $field[2], "$main::mycall:sorry...!"));
755                                         }
756                                 } else {
757                                         $self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!"));
758                                 }
759                         } else {
760                                 my $ref = DXUser->get_current($field[1]);
761                                 if ($ref && $ref->is_clx) {
762                                         route($field[1], pc84($field[2], $field[1], $field[2], $field[3]));
763                                 } else {
764                                         $self->route($field[1], $line);
765                                 }
766                         }
767                         return;
768                 }
769                 
770                 if ($pcno == 35) {              # remote command replies
771                         if ($field[1] eq $main::mycall) {
772                                 my $s = $rcmds{$field[2]};
773                                 if ($s) {
774                                         my $dxchan = DXChannel->get($s->{call});
775                                         $dxchan->send($field[3]) if $dxchan;
776                                         delete $rcmds{$field[2]} if !$dxchan;
777                                 } else {
778                                         # send unsolicited ones to the sysop
779                                         my $dxchan = DXChannel->get($main::myalias);
780                                         $dxchan->send($field[3]) if $dxchan;
781                                 }
782                         } else {
783                                 my $ref = DXUser->get_current($field[1]);
784                                 if ($ref && $ref->is_clx) {
785                                         route($field[1], pc85($field[2], $field[1], $field[2], $field[3]));
786                                 } else {
787                                         $self->route($field[1], $line);
788                                 }
789                         }
790                         return;
791                 }
792                 
793                 # for pc 37 see 44 onwards
794
795                 if ($pcno == 38) {              # node connected list from neighbour
796                         return;
797                 }
798                 
799                 if ($pcno == 39) {              # incoming disconnect
800                         $self->disconnect(1);
801                         return;
802                 }
803                 
804                 if ($pcno == 41) {              # user info
805                         # add this station to the user database, if required
806                         my $user = DXUser->get_current($field[1]);
807                         if (!$user) {
808                                 # then try without an SSID
809                                 $field[1] =~ s/-\d+$//o;
810                                 $user = DXUser->get_current($field[1]);
811                         }
812                         $user = DXUser->new($field[1]) if !$user;
813                         
814                         if ($field[2] == 1) {
815                                 $user->name($field[3]);
816                         } elsif ($field[2] == 2) {
817                                 $user->qth($field[3]);
818                         } elsif ($field[2] == 3) {
819                                 my ($lat, $long) = DXBearing::stoll($field[3]);
820                                 $user->lat($lat);
821                                 $user->long($long);
822                                 $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra && DXBearing::is_qra($user->qra);
823                         } elsif ($field[2] == 4) {
824                                 $user->homenode($field[3]);
825                         }
826                         $user->lastoper($main::systime);   # to cut down on excessive for/opers being generated
827                         $user->put;
828                         last SWITCH;
829                 }
830                 if ($pcno == 43) {
831                         last SWITCH;
832                 }
833                 if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47 || $pcno == 48) {
834                         DXDb::process($self, $line);
835                         return;
836                 }
837                 
838                 if ($pcno == 50) {              # keep alive/user list
839                         my $node = DXCluster->get_exact($field[1]);
840                         if ($node) {
841                                 return unless $node->isa('DXNode');
842                                 return unless $node->dxchan == $self;
843                                 $node->update_users($field[2]);
844                         }
845                         last SWITCH;
846                 }
847                 
848                 if ($pcno == 51) {              # incoming ping requests/answers
849                         
850                         # is it for us?
851                         if ($field[1] eq $main::mycall) {
852                                 my $flag = $field[3];
853                                 if ($flag == 1) {
854                                         $self->send(pc51($field[2], $field[1], '0'));
855                                 } else {
856                                         # it's a reply, look in the ping list for this one
857                                         my $ref = $pings{$field[2]};
858                                         if ($ref) {
859                                                 my $tochan =  DXChannel->get($field[2]);
860                                                 while (@$ref) {
861                                                         my $r = shift @$ref;
862                                                         my $dxchan = DXChannel->get($r->{call});
863                                                         next unless $dxchan;
864                                                         my $t = tv_interval($r->{t}, [ gettimeofday ]);
865                                                         if ($dxchan->is_user) {
866                                                                 my $s = sprintf "%.2f", $t; 
867                                                                 my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
868                                                                 $dxchan->send($dxchan->msg('pingi', $field[2], $s, $ave))
869                                                         } elsif ($dxchan->is_node) {
870                                                                 if ($tochan) {
871                                                                         $tochan->{nopings} = 2; # pump up the timer
872                                                                         push @{$tochan->{pingtime}}, $t;
873                                                                         shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
874                                                                         my $st;
875                                                                         for (@{$tochan->{pingtime}}) {
876                                                                                 $st += $_;
877                                                                         }
878                                                                         $tochan->{pingave} = $st / @{$tochan->{pingtime}};
879                                                                 }
880                                                         } 
881                                                 }
882                                         }
883                                 }
884                         } else {
885                                 # route down an appropriate thingy
886                                 $self->route($field[1], $line);
887                         }
888                         return;
889                 }
890
891                 if ($pcno == 75) {              # dunno but route it
892                         if ($field[1] ne $main::mycall) {
893                                 $self->route($field[1], $line);
894                         }
895                         return;
896                 }
897
898                 if ($pcno == 73) {  # WCY broadcasts
899                         
900                         # do some de-duping
901                         my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
902                         if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
903                                 dbg('chan', "WCY Date ($field[1] $field[2]) out of range");
904                                 return;
905                         }
906                         @field = map { unpad($_) } @field;
907                         if (WCY::dup($d,@field[3..7])) {
908                                 dbg('chan', "Dup WCY Spot ignored\n");
909                                 return;
910                         }
911                 
912                         my $wcy = WCY::update($d, @field[2..12]);
913
914                         my $rep;
915                         eval {
916                                 $rep = Local::wwv($self, @field[1..12]);
917                         };
918                         # dbg('local', "Local::wcy error $@") if $@;
919                         return if $rep;
920
921                         # broadcast to the eager world
922                         send_wcy_spot($self, $line, $d, @field[2..12]);
923                         return;
924                 }
925
926                 if ($pcno == 84) { # remote commands (incoming)
927                         if ($field[1] eq $main::mycall) {
928                                 my $ref = DXUser->get_current($field[2]);
929                                 my $cref = DXCluster->get($field[2]);
930                                 Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]);
931                                 unless ($field[4] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) {    # not allowed to relay RCMDS!
932                                         if ($ref->{priv}) {     # you have to have SOME privilege, the commands have further filtering
933                                                 $self->{remotecmd} = 1; # for the benefit of any command that needs to know
934                                                 my $oldpriv = $self->{priv};
935                                                 $self->{priv} = $ref->{priv};     # assume the user's privilege level
936                                                 my @in = (DXCommandmode::run_cmd($self, $field[4]));
937                                                 $self->{priv} = $oldpriv;
938                                                 for (@in) {
939                                                         s/\s*$//og;
940                                                         $self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:$_"));
941                                                         Log('rcmd', 'out', $field[2], $_);
942                                                 }
943                                                 delete $self->{remotecmd};
944                                         } else {
945                                                 $self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:sorry...!"));
946                                         }
947                                 } else {
948                                         $self->send(pc85($main::mycall, $field[2], $field[3],"$main::mycall:your attempt is logged, Tut tut tut...!"));
949                                 }
950                         } else {
951                                 my $ref = DXUser->get_current($field[1]);
952                                 if ($ref && $ref->is_clx) {
953                                         $self->route($field[1], $line);
954                                 } else {
955                                         route($field[1], pc34($field[2], $field[1], $field[4]));
956                                 }
957                         }
958                         return;
959                 }
960
961                 if ($pcno == 85) {              # remote command replies
962                         if ($field[1] eq $main::mycall) {
963                                 my $dxchan = DXChannel->get($field[3]);
964                                 if ($dxchan) {
965                                         $dxchan->send($field[4]);
966                                 } else {
967                                         my $s = $rcmds{$field[2]};
968                                         if ($s) {
969                                                 $dxchan = DXChannel->get($s->{call});
970                                                 $dxchan->send($field[4]) if $dxchan;
971                                                 delete $rcmds{$field[2]} if !$dxchan;
972                                         } else {
973                                                 # send unsolicited ones to the sysop
974                                                 my $dxchan = DXChannel->get($main::myalias);
975                                                 $dxchan->send($field[4]) if $dxchan;
976                                         }
977                                 }
978                         } else {
979                                 my $ref = DXUser->get_current($field[1]);
980                                 if ($ref && $ref->is_clx) {
981                                         $self->route($field[1], $line);
982                                 } else {
983                                         route($field[1], pc35($field[2], $field[1], $field[4]));
984                                 }
985                         }
986                         return;
987                 }
988         }
989          
990         # if get here then rebroadcast the thing with its Hop count decremented (if
991         # there is one). If it has a hop count and it decrements to zero then don't
992         # rebroadcast it.
993         #
994         # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
995         #        REBROADCAST!!!!
996         #
997          
998         unless ($self->{isolate}) {
999                 broadcast_ak1a($line, $self); # send it to everyone but me
1000         }
1001 }
1002
1003 #
1004 # This is called from inside the main cluster processing loop and is used
1005 # for despatching commands that are doing some long processing job
1006 #
1007 sub process
1008 {
1009         my $t = time;
1010         my @dxchan = DXChannel->get_all();
1011         my $dxchan;
1012         
1013         foreach $dxchan (@dxchan) {
1014                 next unless $dxchan->is_node();
1015                 next if $dxchan == $me;
1016                 
1017                 # send a pc50 out on this channel
1018                 if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) {
1019                         $dxchan->send(pc50(scalar DXChannel::get_all_users));
1020                         $dxchan->pc50_t($t);
1021                 } 
1022
1023                 # send a ping out on this channel
1024                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
1025                         if ($dxchan->{nopings} <= 0) {
1026                                 $dxchan->disconnect;
1027                         } else {
1028                                 addping($main::mycall, $dxchan->call);
1029                                 $dxchan->{nopings} -= 1;
1030                                 $dxchan->{lastping} = $t;
1031                         }
1032                 }
1033         }
1034         
1035         my $key;
1036         my $val;
1037         my $cutoff;
1038         if ($main::systime - 3600 > $last_hour) {
1039 #               Spot::process;
1040 #               Geomag::process;
1041 #               AnnTalk::process;
1042                 $last_hour = $main::systime;
1043         }
1044 }
1045
1046 #
1047 # finish up a pc context
1048 #
1049 sub finish
1050 {
1051         my $self = shift;
1052         my $call = $self->call;
1053         my $conn = shift;
1054         my $ref = DXCluster->get_exact($call);
1055         
1056         # unbusy and stop and outgoing mail
1057         my $mref = DXMsg::get_busy($call);
1058         $mref->stop_msg($call) if $mref;
1059         
1060         # broadcast to all other nodes that all the nodes connected to via me are gone
1061         my @gonenodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all();
1062         my $node;
1063         
1064         foreach $node (@gonenodes) {
1065                 next if $node->call eq $call;
1066                 broadcast_ak1a(pc21($node->call, 'Gone') , $self) unless $self->{isolate}; 
1067                 $node->del();
1068         }
1069
1070         # remove outstanding pings
1071         delete $pings{$call};
1072         
1073         # now broadcast to all other ak1a nodes that I have gone
1074         broadcast_ak1a(pc21($call, 'Gone.'), $self) unless $self->{isolate};
1075
1076         # I was the last node visited
1077     $self->user->node($main::mycall);
1078
1079         # send info to all logged in thingies
1080         $self->tell_login('logoutn');
1081
1082         Log('DXProt', $call . " Disconnected");
1083         $ref->del() if $ref;
1084 }
1085
1086 #
1087 # some active measures
1088 #
1089 sub send_dx_spot
1090 {
1091         my $self = shift;
1092         my $line = shift;
1093         my @dxchan = DXChannel->get_all();
1094         my $dxchan;
1095         
1096         # send it if it isn't the except list and isn't isolated and still has a hop count
1097         # taking into account filtering and so on
1098         foreach $dxchan (@dxchan) {
1099                 my $routeit;
1100                 my ($filter, $hops);
1101
1102                 if ($dxchan->{spotfilter}) {
1103                     ($filter, $hops) = Filter::it($dxchan->{spotfilter}, @_, $self->{call} );
1104                         next unless $filter;
1105                 }
1106                 
1107                 if ($dxchan->is_node) {
1108                         next if $dxchan == $self;
1109                         if ($hops) {
1110                                 $routeit = $line;
1111                                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1112                         } else {
1113                                 $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
1114                                 next unless $routeit;
1115                         }
1116                         if ($filter) {
1117                                 $dxchan->send($routeit) if $routeit;
1118                         } else {
1119                                 $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
1120                         }
1121                 } elsif ($dxchan->is_user && $dxchan->{dx}) {
1122                         my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]);
1123                         $buf .= "\a\a" if $dxchan->{beep};
1124                         if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1125                                 $dxchan->send($buf);
1126                         } else {
1127                                 $dxchan->delay($buf);
1128                         }
1129                 }                                       
1130         }
1131 }
1132
1133 sub send_wwv_spot
1134 {
1135         my $self = shift;
1136         my $line = shift;
1137         my @dxchan = DXChannel->get_all();
1138         my $dxchan;
1139         
1140         # send it if it isn't the except list and isn't isolated and still has a hop count
1141         # taking into account filtering and so on
1142         foreach $dxchan (@dxchan) {
1143                 my $routeit;
1144                 my ($filter, $hops);
1145
1146                 if ($dxchan->{wwvfilter}) {
1147                          ($filter, $hops) = Filter::it($dxchan->{wwvfilter}, @_, $self->{call} );
1148                          next unless $filter;
1149                 }
1150                 if ($dxchan->is_node) {
1151                         next if $dxchan == $self;
1152                         if ($hops) {
1153                                 $routeit = $line;
1154                                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1155                         } else {
1156                                 $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
1157                                 next unless $routeit;
1158                         }
1159                         if ($filter) {
1160                                 $dxchan->send($routeit) if $routeit;
1161                         } else {
1162                                 $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
1163                                 
1164                         }
1165                 } elsif ($dxchan->is_user && $dxchan->{wwv}) {
1166                         my $buf = "WWV de $_[6] <$_[1]>:   SFI=$_[2], A=$_[3], K=$_[4], $_[5]";
1167                         $buf .= "\a\a" if $dxchan->{beep};
1168                         if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1169                                 $dxchan->send($buf);
1170                         } else {
1171                                 $dxchan->delay($buf);
1172                         }
1173                 }                                       
1174         }
1175 }
1176
1177 sub send_wcy_spot
1178 {
1179         my $self = shift;
1180         my $line = shift;
1181         my @dxchan = DXChannel->get_all();
1182         my $dxchan;
1183         
1184         # send it if it isn't the except list and isn't isolated and still has a hop count
1185         # taking into account filtering and so on
1186         foreach $dxchan (@dxchan) {
1187                 my $routeit;
1188                 my ($filter, $hops);
1189
1190                 if ($dxchan->{wcyfilter}) {
1191                          ($filter, $hops) = Filter::it($dxchan->{wcyfilter}, @_, $self->{call} );
1192                          next unless $filter;
1193                 }
1194                 if ($dxchan->is_clx || $dxchan->is_spider) {
1195                         next if $dxchan == $self;
1196                         if ($hops) {
1197                                 $routeit = $line;
1198                                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1199                         } else {
1200                                 $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
1201                                 next unless $routeit;
1202                         }
1203                         if ($filter) {
1204                                 $dxchan->send($routeit) if $routeit;
1205                         } else {
1206                                 $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
1207                         }
1208                 } elsif ($dxchan->is_user && $dxchan->{wcy}) {
1209                         my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]";
1210                         $buf .= "\a\a" if $dxchan->{beep};
1211                         if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1212                                 $dxchan->send($buf);
1213                         } else {
1214                                 $dxchan->delay($buf);
1215                         }
1216                 }                                       
1217         }
1218 }
1219
1220 # send an announce
1221 sub send_announce
1222 {
1223         my $self = shift;
1224         my $line = shift;
1225         my @dxchan = DXChannel->get_all();
1226         my $dxchan;
1227         my $text = unpad($_[2]);
1228         my $target;
1229         my $to = 'To ';
1230                                 
1231         if ($_[3] eq '*') {     # sysops
1232                 $target = "SYSOP";
1233         } elsif ($_[3] gt ' ') { # speciality list handling
1234                 my ($name) = split /\./, $_[3]; 
1235                 $target = "$name"; # put the rest in later (if bothered) 
1236         } 
1237         
1238         if ($_[5] eq '1') {
1239                 $target = "WX"; 
1240                 $to = '';
1241         }
1242         $target = "All" if !$target;
1243         
1244         Log('ann', $target, $_[0], $text);
1245
1246         # send it if it isn't the except list and isn't isolated and still has a hop count
1247         # taking into account filtering and so on
1248         foreach $dxchan (@dxchan) {
1249                 my $routeit;
1250                 my ($filter, $hops);
1251
1252                 if ($dxchan->{annfilter}) {
1253                         ($filter, $hops) = Filter::it($dxchan->{annfilter}, @_, $self->{call} );
1254                         next unless $filter;
1255                 } 
1256                 if ($dxchan->is_node && $_[1] ne $main::mycall) {  # i.e not specifically routed to me
1257                         next if $dxchan == $self;
1258                         if ($hops) {
1259                                 $routeit = $line;
1260                                 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1261                         } else {
1262                                 $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
1263                                 next unless $routeit;
1264                         }
1265                         if ($filter) {
1266                                 $dxchan->send($routeit) if $routeit;
1267                         } else {
1268                                 $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
1269                                 
1270                         }
1271                 } elsif ($dxchan->is_user) {
1272                         unless ($dxchan->{ann}) {
1273                                 next if $_[0] ne $main::myalias && $_[0] ne $main::mycall;
1274                         }
1275                         next if $target eq 'SYSOP' && $dxchan->{priv} < 5;
1276                         my $buf = "$to$target de $_[0]: $text";
1277                         $buf .= "\a\a" if $dxchan->{beep};
1278                         if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1279                                 $dxchan->send($buf);
1280                         } else {
1281                                 $dxchan->delay($buf);
1282                         }
1283                 }                                       
1284         }
1285 }
1286
1287 sub send_local_config
1288 {
1289         my $self = shift;
1290         my $n;
1291         my @nodes;
1292         my @localnodes;
1293         my @remotenodes;
1294                 
1295         # send our nodes
1296         if ($self->{isolate}) {
1297                 @localnodes = (DXCluster->get_exact($main::mycall));
1298         } else {
1299                 # create a list of all the nodes that are not connected to this connection
1300                 # and are not themselves isolated, this to make sure that isolated nodes
1301         # don't appear outside of this node
1302                 @nodes = DXNode::get_all();
1303                 @nodes = grep { $_->{call} ne $main::mycall } @nodes;
1304                 @nodes = grep { $_->dxchan != $self } @nodes if @nodes;
1305                 @nodes = grep { !$_->dxchan->{isolate} } @nodes if @nodes;
1306                 @localnodes = grep { $_->dxchan->{call} eq $_->{call} } @nodes if @nodes;
1307                 unshift @localnodes, DXCluster->get_exact($main::mycall);
1308                 @remotenodes = grep { $_->dxchan->{call} ne $_->{call} } @nodes if @nodes;
1309         }
1310
1311         my @s = $me->pc19(@localnodes, @remotenodes);
1312         for (@s) {
1313                 my $routeit = adjust_hops($self, $_);
1314                 $self->send($routeit) if $routeit;
1315         }
1316         
1317         # get all the users connected on the above nodes and send them out
1318         foreach $n (@localnodes, @remotenodes) {
1319                 my @users = values %{$n->list};
1320                 my @s = pc16($n, @users);
1321                 for (@s) {
1322                         my $routeit = adjust_hops($self, $_);
1323                         $self->send($routeit) if $routeit;
1324                 }
1325         }
1326 }
1327
1328 #
1329 # route a message down an appropriate interface for a callsign
1330 #
1331 # is called route(to, pcline);
1332 #
1333 sub route
1334 {
1335         my ($self, $call, $line) = @_;
1336         my $cl = DXCluster->get_exact($call);
1337         if ($cl) {       # don't route it back down itself
1338                 if (ref $self && $call eq $self->{call}) {
1339                         dbg('chan', "Trying to route back to source, dropped");
1340                         return;
1341                 }
1342                 my $hops;
1343                 my $dxchan = $cl->{dxchan};
1344                 if ($dxchan) {
1345                         my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
1346                         if ($routeit) {
1347                                 $dxchan->send($routeit) if $dxchan;
1348                         }
1349                 }
1350         }
1351 }
1352
1353 # broadcast a message to all clusters taking into account isolation
1354 # [except those mentioned after buffer]
1355 sub broadcast_ak1a
1356 {
1357         my $s = shift;                          # the line to be rebroadcast
1358         my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
1359         my @dxchan = DXChannel::get_all_nodes();
1360         my $dxchan;
1361         
1362         # send it if it isn't the except list and isn't isolated and still has a hop count
1363         foreach $dxchan (@dxchan) {
1364                 next if grep $dxchan == $_, @except;
1365                 my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
1366                 $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
1367         }
1368 }
1369
1370 # broadcast a message to all clusters ignoring isolation
1371 # [except those mentioned after buffer]
1372 sub broadcast_all_ak1a
1373 {
1374         my $s = shift;                          # the line to be rebroadcast
1375         my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
1376         my @dxchan = DXChannel::get_all_nodes();
1377         my $dxchan;
1378         
1379         # send it if it isn't the except list and isn't isolated and still has a hop count
1380         foreach $dxchan (@dxchan) {
1381                 next if grep $dxchan == $_, @except;
1382                 my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
1383                 $dxchan->send($routeit);
1384         }
1385 }
1386
1387 # broadcast to all users
1388 # storing the spot or whatever until it is in a state to receive it
1389 sub broadcast_users
1390 {
1391         my $s = shift;                          # the line to be rebroadcast
1392         my $sort = shift;           # the type of transmission
1393         my $fref = shift;           # a reference to an object to filter on
1394         my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
1395         my @dxchan = DXChannel::get_all_users();
1396         my $dxchan;
1397         my @out;
1398         
1399         foreach $dxchan (@dxchan) {
1400                 next if grep $dxchan == $_, @except;
1401                 push @out, $dxchan;
1402         }
1403         broadcast_list($s, $sort, $fref, @out);
1404 }
1405
1406 # broadcast to a list of users
1407 sub broadcast_list
1408 {
1409         my $s = shift;
1410         my $sort = shift;
1411         my $fref = shift;
1412         my $dxchan;
1413         
1414         foreach $dxchan (@_) {
1415                 my $filter = 1;
1416                 
1417                 if ($sort eq 'dx') {
1418                     next unless $dxchan->{dx};
1419                         ($filter) = Filter::it($dxchan->{spotfilter}, @{$fref}) if ref $fref;
1420                         next unless $filter;
1421                 }
1422                 next if $sort eq 'ann' && !$dxchan->{ann};
1423                 next if $sort eq 'wwv' && !$dxchan->{wwv};
1424                 next if $sort eq 'wcy' && !$dxchan->{wcy};
1425                 next if $sort eq 'wx' && !$dxchan->{wx};
1426
1427                 $s =~ s/\a//og unless $dxchan->{beep};
1428
1429                 if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1430                         $dxchan->send($s);      
1431                 } else {
1432                         $dxchan->delay($s);
1433                 }
1434         }
1435 }
1436
1437
1438 #
1439 # obtain the hops from the list for this callsign and pc no 
1440 #
1441
1442 sub get_hops
1443 {
1444         my $pcno = shift;
1445         my $hops = $DXProt::hopcount{$pcno};
1446         $hops = $DXProt::def_hopcount if !$hops;
1447         return "H$hops";       
1448 }
1449
1450
1451 # adjust the hop count on a per node basis using the user loadable 
1452 # hop table if available or else decrement an existing one
1453 #
1454
1455 sub adjust_hops
1456 {
1457         my $self = shift;
1458         my $s = shift;
1459         my $call = $self->{call};
1460         my $hops;
1461         
1462         if (($hops) = $s =~ /\^H(\d+)\^~?$/o) {
1463                 my ($pcno) = $s =~ /^PC(\d\d)/o;
1464                 confess "$call called adjust_hops with '$s'" unless $pcno;
1465                 my $ref = $nodehops{$call} if %nodehops;
1466                 if ($ref) {
1467                         my $newhops = $ref->{$pcno};
1468                         return "" if defined $newhops && $newhops == 0;
1469                         $newhops = $ref->{default} unless $newhops;
1470                         return "" if defined $newhops && $newhops == 0;
1471                         $newhops = $hops if !$newhops;
1472                         $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
1473                 } else {
1474                         # simply decrement it
1475                         $hops--;
1476                         return "" if !$hops;
1477                         $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
1478                 }
1479         }
1480         return $s;
1481 }
1482
1483
1484 # load hop tables
1485 #
1486 sub load_hops
1487 {
1488         my $self = shift;
1489         return $self->msg('lh1') unless -e "$main::data/hop_table.pl";
1490         do "$main::data/hop_table.pl";
1491         return $@ if $@;
1492         return 0;
1493 }
1494
1495
1496 # add a ping request to the ping queues
1497 sub addping
1498 {
1499         my ($from, $to) = @_;
1500         my $ref = $pings{$to} || [];
1501         my $r = {};
1502         $r->{call} = $from;
1503         $r->{t} = [ gettimeofday ];
1504         route(undef, $to, pc51($to, $main::mycall, 1));
1505         push @$ref, $r;
1506         $pings{$to} = $ref;
1507 }
1508
1509 # add a rcmd request to the rcmd queues
1510 sub addrcmd
1511 {
1512         my ($self, $to, $cmd) = @_;
1513
1514         my $r = {};
1515         $r->{call} = $self->{call};
1516         $r->{t} = $main::systime;
1517         $r->{cmd} = $cmd;
1518         $rcmds{$to} = $r;
1519
1520         my $ref = DXCluster->get_exact($to);
1521     if ($ref && $ref->dxchan && $ref->dxchan->is_clx) {
1522                 route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd));
1523         } else {
1524                 route(undef, $to, pc34($main::mycall, $to, $cmd));
1525         }
1526 }
1527
1528 sub disconnect
1529 {
1530         my $self = shift;
1531         my $nopc39 = shift;
1532
1533         if ($self->{conn} && !$nopc39) {
1534                 $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op")));
1535         }
1536
1537         $self->SUPER::disconnect;
1538 }
1539
1540
1541
1542 # send a talk message to this thingy
1543 #
1544 sub talk
1545 {
1546         my ($self, $from, $to, $via, $line) = @_;
1547         
1548         $line =~ s/\^/\\5E/g;                   # remove any ^ characters
1549         $self->send(DXProt::pc10($from, $to, $via, $line));
1550         Log('talk', $self->call, $from, $via?$via:$main::mycall, $line);
1551 }
1552 1;
1553 __END__