3 # This module impliments the protocal mode for a dx cluster
5 # Copyright (c) 1998 Dirk Koopman G1TLH
30 use Time::HiRes qw(gettimeofday tv_interval);
38 use vars qw($VERSION $BRANCH);
39 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
40 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
41 $main::build += $VERSION;
42 $main::branch += $BRANCH;
44 use vars qw($me $pc11_max_age $pc23_max_age $last_pc50
45 $last_hour $last10 %eph %pings %rcmds
46 %nodehops $baddx $badspotter $badnode $censorpc
47 $allowzero $decode_dk0wcy $send_opernam @checklist);
49 $me = undef; # the channel id for this cluster
50 $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11
51 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23
53 $last_hour = time; # last time I did an hourly periodic update
54 %pings = (); # outstanding ping requests outbound
55 %rcmds = (); # outstanding rcmd requests outbound
56 %nodehops = (); # node specific hop control
57 $censorpc = 1; # Do a BadWords::check on text fields and reject things
58 # loads of 'bad things'
59 $baddx = new DXHash "baddx";
60 $badspotter = new DXHash "badspotter";
61 $badnode = new DXHash "badnode";
62 $last10 = $last_pc50 = time;
66 [ qw(c c m bp bc c) ], # pc10
67 [ qw(f m d t m c c h) ], # pc11
68 [ qw(c bc m bp bm p h) ], # pc12
72 undef , # pc16 has to be validated manually
75 undef , # pc19 has to be validated manually
76 undef , # pc20 no validation
78 undef , # pc22 no validation
79 [ qw(d n n n n m c c h) ], # pc23
81 [ qw(c c n n) ], # pc25
82 [ qw(f m d t m c c bc) ], # pc26
83 [ qw(d n n n n m c c bc) ], # pc27
84 [ qw(c c m c d t p m bp n p bp bc) ], # pc28
85 [ qw(c c n m) ], # pc29
93 [ qw(c c n m) ], # pc37
94 undef, # pc38 not interested
96 [ qw(c c m p n) ], # pc40
97 [ qw(c n m h) ], # pc41
99 undef, # pc43 don't handle it
100 [ qw(c c n m m c) ], # pc44
101 [ qw(c c n m) ], # pc45
102 [ qw(c c n) ], # pc46
105 [ qw(c m h) ], # pc49
106 [ qw(c n h) ], # pc50
107 [ qw(c c n) ], # pc51
129 [ qw(d n n n n n n m m m c c h) ], # pc73
140 [ qw(c c c m) ], # pc84
141 [ qw(c c c m) ], # pc85
144 # use the entry in the check list to check the field list presented
145 # return OK if line NOT in check list (for now)
150 return 0 if $n < 0 || $n > @checklist;
151 my $ref = $checklist[$n];
152 return 0 unless ref $ref;
155 shift; # not interested in the first field
156 for ($i = 0; $i < @$ref; $i++) {
157 my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
158 return 0 unless $act;
159 next if $blank && $_[$i] =~ /^[ \*]$/;
161 return $i+1 unless is_callsign($_[$i]);
162 } elsif ($act eq 'm') {
163 return $i+1 unless is_pctext($_[$i]);
164 } elsif ($act eq 'p') {
165 return $i+1 unless is_pcflag($_[$i]);
166 } elsif ($act eq 'f') {
167 return $i+1 unless is_freq($_[$i]);
168 } elsif ($act eq 'n') {
169 return $i+1 unless $_[$i] =~ /^[\d ]+$/;
170 } elsif ($act eq 'h') {
171 return $i+1 unless $_[$i] =~ /^H\d\d?$/;
172 } elsif ($act eq 'd') {
173 return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
174 } elsif ($act eq 't') {
175 return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
183 my $user = DXUser->get($main::mycall);
184 $DXProt::myprot_version += $main::version*100;
185 $me = DXProt->new($main::mycall, 0, $user);
187 $me->{state} = "indifferent";
188 do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
190 $me->{sort} = 'S'; # S for spider
192 # $Route::Node::me->adddxchan($me);
196 # obtain a new connection this is derived from dxchannel
201 my $self = DXChannel::alloc(@_);
203 # add this node to the table, the values get filled in later
206 $main::routeroot->add($call, '0000', Route::here(1)) if $call ne $main::mycall;
211 # this is how a pc connection starts (for an incoming connection)
212 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
213 # all the crap that comes between).
216 my ($self, $line, $sort) = @_;
217 my $call = $self->{call};
218 my $user = $self->{user};
221 my $host = $self->{conn}->{peerhost} || "unknown";
222 Log('DXProt', "$call connected from $host");
224 # remember type of connection
225 $self->{consort} = $line;
226 $self->{outbound} = $sort eq 'O';
227 my $priv = $user->priv;
228 $priv = $user->priv(1) unless $priv;
229 $self->{priv} = $priv; # other clusters can always be 'normal' users
230 $self->{lang} = $user->lang || 'en';
231 $self->{isolate} = $user->{isolate};
232 $self->{consort} = $line; # save the connection type
236 # get the output filters
237 $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
238 $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
239 $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
240 $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
241 $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ;
244 # get the INPUT filters (these only pertain to Clusters)
245 $self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1);
246 $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
247 $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
248 $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
249 $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
251 # set unbuffered and no echo
252 $self->send_now('B',"0");
253 $self->send_now('E',"0");
255 # ping neighbour node stuff
256 my $ping = $user->pingint;
257 $ping = 5*60 unless defined $ping;
258 $self->{pingint} = $ping;
259 $self->{nopings} = $user->nopings || 2;
260 $self->{pingtime} = [ ];
261 $self->{pingave} = 999;
262 $self->{lastping} = $main::systime;
264 # send initialisation string
265 unless ($self->{outbound}) {
269 $self->state('init');
270 $self->{pc50_t} = $main::systime;
272 # send info to all logged in thingies
273 $self->tell_login('loginn');
277 # This is the normal pcxx despatcher
281 my ($self, $line) = @_;
282 my @field = split /\^/, $line;
283 return unless @field;
285 pop @field if $field[-1] eq '~';
287 # print join(',', @field), "\n";
290 # process PC frames, this will fail unless the frame starts PCnn
291 my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
293 return if $pcno < 10 || $pcno > 99;
295 # check for and dump bad protocol messages
296 my $n = check($pcno, @field);
298 dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
305 $pcr = Local::pcprot($self, $pcno, @field);
307 # dbg("Local::pcprot error $@") if isdbg('local') if $@;
311 if ($pcno == 10) { # incoming talk
313 # will we allow it at all?
316 if (@bad = BadWords::check($field[3])) {
317 dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
322 # is it for me or one of mine?
323 my ($to, $via, $call, $dxchan);
324 if ($field[5] gt ' ') {
325 $call = $via = $field[2];
328 $call = $to = $field[2];
330 $dxchan = DXChannel->get($main::myalias) if $call eq $main::mycall;
331 $dxchan = DXChannel->get($call) unless $dxchan;
332 if ($dxchan && $dxchan->is_user) {
333 $field[3] =~ s/\%5E/^/g;
334 $dxchan->talk($field[1], $to, $via, $field[3]);
336 $self->route($field[2], $line); # relay it on its way
341 if ($pcno == 11 || $pcno == 26) { # dx spot
343 # route 'foreign' pc26s
345 if ($field[7] ne $main::mycall) {
346 $self->route($field[7], $line);
351 # if this is a 'nodx' node then ignore it
352 if ($badnode->in($field[7])) {
353 dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
357 # if this is a 'bad spotter' user then ignore it
358 if ($badspotter->in($field[6])) {
359 dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
363 # convert the date to a unix date
364 my $d = cltounix($field[3], $field[4]);
365 # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
366 if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
367 dbg("PCPROT: Spot ignored, invalid date or out of range ($field[3] $field[4])\n") if isdbg('chanerr');
372 if ($baddx->in($field[2])) {
373 dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr');
378 $field[5] =~ s/^\s+//; # take any leading blanks off
379 $field[2] = unpad($field[2]); # take off leading and trailing blanks from spotted callsign
380 if ($field[2] =~ /BUST\w*$/) {
381 dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr');
384 if (Spot::dup($field[1], $field[2], $d, $field[5])) {
385 dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
390 if (@bad = BadWords::check($field[5])) {
391 dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
396 my @spot = Spot::prepare($field[1], $field[2], $d, $field[5], $field[6], $field[7]);
397 # global spot filtering on INPUT
398 if ($self->{inspotsfilter}) {
399 my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
401 dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr');
410 # @spot at this point contains:-
411 # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
412 # then spotted itu, spotted cq, spotters itu, spotters cq
413 # you should be able to route on any of these
416 # fix up qra locators of known users
417 my $user = DXUser->get_current($spot[4]);
419 my $qra = $user->qra;
420 unless ($qra && is_qra($qra)) {
421 my $lat = $user->lat;
422 my $long = $user->long;
423 if (defined $lat && defined $long) {
424 $user->qra(DXBearing::lltoqra($lat, $long));
429 # send a remote command to a distant cluster if it is visible and there is no
430 # qra locator and we havn't done it for a month.
432 unless ($user->qra) {
434 my $to = $user->homenode;
435 my $last = $user->lastoper || 0;
436 if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) {
437 my $cmd = "forward/opernam $spot[4]";
438 # send the rcmd but we aren't interested in the replies...
439 my $dxchan = $node->dxchan;
440 if ($dxchan && $dxchan->is_clx) {
441 route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
443 route(undef, $to, pc34($main::mycall, $to, $cmd));
445 if ($to ne $field[7]) {
447 $node = Route::Node::get($to);
449 $dxchan = $node->dxchan;
450 if ($dxchan && $dxchan->is_clx) {
451 route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
453 route(undef, $to, pc34($main::mycall, $to, $cmd));
457 $user->lastoper($main::systime);
466 $r = Local::spot($self, @spot);
468 # dbg("Local::spot1 error $@") if isdbg('local') if $@;
471 # DON'T be silly and send on PC26s!
472 return if $pcno == 26;
474 # send out the filtered spots
475 send_dx_spot($self, $line, @spot) if @spot;
479 if ($pcno == 12) { # announces
480 # announce duplicate checking
481 $field[3] =~ s/^\s+//; # remove leading blanks
482 if (AnnTalk::dup($field[1], $field[2], $field[3])) {
483 dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr');
489 if (@bad = BadWords::check($field[3])) {
490 dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr');
495 if ($field[2] eq '*' || $field[2] eq $main::mycall) {
497 # global ann filtering on INPUT
498 if ($self->{inannfilter}) {
499 my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
500 my @dxcc = Prefix::extract($field[1]);
502 $ann_dxcc = $dxcc[1]->dxcc;
503 $ann_itu = $dxcc[1]->itu;
504 $ann_cq = $dxcc[1]->cq();
506 @dxcc = Prefix::extract($field[5]);
508 $org_dxcc = $dxcc[1]->dxcc;
509 $org_itu = $dxcc[1]->itu;
510 $org_cq = $dxcc[1]->cq();
512 my ($filter, $hops) = $self->{inannfilter}->it(@field[1..6], $self->{call},
513 $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
515 dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
521 $self->send_announce($line, @field[1..6]);
523 $self->route($field[2], $line);
539 if ($pcno == 16) { # add a user
543 my $ncall = $field[1];
544 my $newline = "PC16^";
546 if ($ncall eq $main::mycall) {
547 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
550 $dxchan = DXChannel->get($ncall);
551 if ($dxchan && $dxchan ne $self) {
552 dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
555 my $parent = Route::Node::get($ncall);
557 dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr');
561 # input filter if required
562 return unless $self->in_filter_route($parent);
566 for ($i = 2; $i < $#field; $i++) {
567 my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
568 next unless $call && $conf && defined $here && is_callsign($call);
569 next if $call eq $main::mycall;
571 eph_del_regex("^PC17\^$call\^$ncall");
573 $conf = $conf eq '*';
575 # reject this if we think it is a node already
576 my $r = Route::Node::get($call);
577 my $u = DXUser->get_current($call) unless $r;
578 if ($r || ($u && $u->is_node)) {
579 dbg("PCPROT: $call is a node") if isdbg('chanerr');
583 $r = Route::User::get($call);
584 my $flags = Route::here($here)|Route::conf($conf);
587 if ($r->flags != $flags) {
591 $r->addparent($parent);
593 push @rout, $parent->add_user($call, $flags);
596 # add this station to the user database, if required
597 $call =~ s/-\d+$//o; # remove ssid for users
598 my $user = DXUser->get_current($call);
599 $user = DXUser->new($call) if !$user;
600 $user->homenode($parent->call) if !$user->homenode;
601 $user->node($parent->call);
602 $user->lastin($main::systime) unless DXChannel->get($call);
606 if (eph_dup($line)) {
607 dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
611 # queue up any messages (look for privates only)
612 DXMsg::queue_msg(1) if $self->state eq 'normal';
614 $self->route_pc16($parent, @rout) if @rout;
618 if ($pcno == 17) { # remove a user
620 my $ncall = $field[2];
621 my $ucall = $field[1];
623 eph_del_regex("^PC16.*$ncall.*$ucall");
625 if ($ncall eq $main::mycall) {
626 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
629 $dxchan = DXChannel->get($ncall);
630 if ($dxchan && $dxchan ne $self) {
631 dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
635 my $uref = Route::User::get($ucall);
637 dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
640 my $parent = Route::Node::get($ncall);
642 dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
646 # input filter if required
647 return unless $self->in_filter_route($parent);
649 my @rout = $parent->del_user($uref);
651 if (eph_dup($line)) {
652 dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
656 $self->route_pc17($parent, @rout) if @rout;
660 if ($pcno == 18) { # link request
661 $self->state('init');
663 # first clear out any nodes on this dxchannel
664 my $parent = Route::Node::get($self->{call});
665 my @rout = $parent->del_nodes;
666 $self->route_pc21(@rout, $parent) if @rout;
667 $self->send_local_config();
669 return; # we don't pass these on
672 if ($pcno == 19) { # incoming cluster list
674 my $newline = "PC19^";
678 my $parent = Route::Node::get($self->{call});
680 dbg("DXPROT: my parent $self->{call} has disappeared");
686 for ($i = 1; $i < $#field-1; $i += 4) {
687 my $here = $field[$i];
688 my $call = uc $field[$i+1];
689 my $conf = $field[$i+2];
690 my $ver = $field[$i+3];
691 next unless defined $here && defined $conf && is_callsign($call);
693 eph_del_regex("^PC(?:21\^$call|17\^[^\^]+\^$call)");
695 # check for sane parameters
696 $ver = 5000 if $ver eq '0000';
697 next if $ver < 5000; # only works with version 5 software
698 next if length $call < 3; # min 3 letter callsigns
699 next if $call eq $main::mycall;
701 # update it if required
702 my $r = Route::Node::get($call);
703 my $flags = Route::here($here)|Route::conf($conf);
706 if ($call ne $parent->call) {
707 if ($self->in_filter_route($r)) {
708 $ar = $parent->add($call, $ver, $flags);
709 push @rout, $ar if $ar;
714 if ($r->version ne $ver || $r->flags != $flags) {
717 push @rout, $r unless $ar;
720 if ($call eq $self->{call}) {
721 dbg("DXPROT: my channel route for $call has disappeared");
725 my $new = Route->new($call); # throw away
726 if ($self->in_filter_route($new)) {
727 my $r = $parent->add($call, $ver, $flags);
734 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
735 my $mref = DXMsg::get_busy($call);
736 $mref->stop_msg($call) if $mref;
738 # add this station to the user database, if required (don't remove SSID from nodes)
739 my $user = DXUser->get_current($call);
741 $user = DXUser->new($call);
743 $user->priv(1); # I have relented and defaulted nodes
745 $user->homenode($call);
748 $user->lastin($main::systime) unless DXChannel->get($call);
752 if (eph_dup($line)) {
753 dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
757 $self->route_pc19(@rout) if @rout;
761 if ($pcno == 20) { # send local configuration
762 $self->send_local_config();
764 $self->state('normal');
765 $self->{lastping} = 0;
769 if ($pcno == 21) { # delete a cluster from the list
770 my $call = uc $field[1];
772 eph_del_regex("^PC1[79].*$call");
775 my $parent = Route::Node::get($self->{call});
777 dbg("DXPROT: my parent $self->{call} has disappeared");
781 my $node = Route::Node::get($call);
782 if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
783 if ($call eq $self->{call}) {
784 dbg("PCPROT: Trying to disconnect myself with PC21") if isdbg('chanerr');
790 return unless $self->in_filter_route($node);
793 push @rout, $node->del($parent);
796 dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr');
800 if (eph_dup($line)) {
801 dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
805 $self->route_pc21(@rout) if @rout;
810 $self->state('normal');
811 $self->{lastping} = 0;
815 if ($pcno == 23 || $pcno == 27) { # WWV info
817 # route 'foreign' pc27s
819 if ($field[8] ne $main::mycall) {
820 $self->route($field[8], $line);
826 my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
827 my $sfi = unpad($field[3]);
828 my $k = unpad($field[4]);
829 my $i = unpad($field[5]);
830 my ($r) = $field[6] =~ /R=(\d+)/;
832 if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
833 dbg("PCPROT: WWV Date ($field[1] $field[2]) out of range") if isdbg('chanerr');
836 if (Geomag::dup($d,$sfi,$k,$i,$field[6])) {
837 dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
840 $field[7] =~ s/-\d+$//o; # remove spotter's ssid
842 my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8], $r);
846 $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r);
848 # dbg("Local::wwv2 error $@") if isdbg('local') if $@;
851 # DON'T be silly and send on PC27s!
852 return if $pcno == 27;
854 # broadcast to the eager world
855 send_wwv_spot($self, $line, $d, $field[2], $sfi, $k, $i, @field[6..8]);
859 if ($pcno == 24) { # set here status
860 my $call = uc $field[1];
862 $nref = Route::Node::get($call);
863 $uref = Route::User::get($call);
864 return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on
866 unless (eph_dup($line)) {
867 $nref->here($field[2]) if $nref;
868 $uref->here($field[2]) if $uref;
869 my $ref = $nref || $uref;
870 return unless $self->in_filter_route($ref);
871 $self->route_pc24($ref, $field[3]);
876 if ($pcno == 25) { # merge request
877 if ($field[1] ne $main::mycall) {
878 $self->route($field[1], $line);
881 if ($field[2] eq $main::mycall) {
882 dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr');
886 Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[2]");
890 my @in = reverse Spot::search(1, undef, undef, 0, $field[3]);
893 $self->send(pc26(@{$in}[0..4], $field[2]));
899 my @in = reverse Geomag::search(0, $field[4], time, 1);
902 $self->send(pc27(@{$in}[0..5], $field[2]));
908 if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
909 if ($pcno == 49 || $field[1] eq $main::mycall) {
910 DXMsg::process($self, $line);
912 $self->route($field[1], $line) unless $self->is_clx;
917 if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
918 $self->process_rcmd($field[1], $field[2], $field[2], $field[3]);
922 if ($pcno == 35) { # remote command replies
923 $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]);
927 # for pc 37 see 44 onwards
929 if ($pcno == 38) { # node connected list from neighbour
933 if ($pcno == 39) { # incoming disconnect
934 if ($field[1] eq $self->{call}) {
935 $self->disconnect(1);
936 eph_del_regex("^PC(?:1[679]|21).*$field[1]");
938 dbg("PCPROT: came in on wrong channel") if isdbg('chanerr');
943 if ($pcno == 41) { # user info
944 my $call = $field[1];
946 # input filter if required
947 # my $ref = Route::get($call) || Route->new($call);
948 # return unless $self->in_filter_route($ref);
950 if ($field[3] eq $field[2]) {
951 dbg('PCPROT: invalid value') if isdbg('chanerr');
955 # add this station to the user database, if required
956 my $user = DXUser->get_current($call);
957 $user = DXUser->new($call) if !$user;
959 if ($field[2] == 1) {
960 $user->name($field[3]);
961 } elsif ($field[2] == 2) {
962 $user->qth($field[3]);
963 } elsif ($field[2] == 3) {
964 if (is_latlong($field[3])) {
965 my ($lat, $long) = DXBearing::stoll($field[3]);
968 $user->qra(DXBearing::lltoqra($lat, $long));
970 dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
973 } elsif ($field[2] == 4) {
974 $user->homenode($field[3]);
975 } elsif ($field[2] == 5) {
976 if (is_qra($field[3])) {
977 my ($lat, $long) = DXBearing::qratoll($field[3]);
980 $user->qra($field[3]);
982 dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
986 $user->lastoper($main::systime); # to cut down on excessive for/opers being generated
989 # perhaps this IS what we want after all
990 # $self->route_pc41($ref, $call, $field[2], $field[3], $field[4]);
998 if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47 || $pcno == 48) {
999 DXDb::process($self, $line);
1003 if ($pcno == 50) { # keep alive/user list
1004 my $call = $field[1];
1005 my $node = Route::Node::get($call);
1007 return unless $node->call eq $self->{call};
1008 $node->usercount($field[2]);
1010 # input filter if required
1011 return unless $self->in_filter_route($node);
1013 $self->route_pc50($node, $field[2], $field[3]) unless eph_dup($line);
1018 if ($pcno == 51) { # incoming ping requests/answers
1020 my $from = $field[2];
1021 my $flag = $field[3];
1025 if ($to eq $main::mycall) {
1027 $self->send(pc51($from, $to, '0'));
1029 # it's a reply, look in the ping list for this one
1030 my $ref = $pings{$from};
1032 my $tochan = DXChannel->get($from);
1034 my $r = shift @$ref;
1035 my $dxchan = DXChannel->get($r->{call});
1036 next unless $dxchan;
1037 my $t = tv_interval($r->{t}, [ gettimeofday ]);
1038 if ($dxchan->is_user) {
1039 my $s = sprintf "%.2f", $t;
1040 my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
1041 $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
1042 } elsif ($dxchan->is_node) {
1044 my $nopings = $tochan->user->nopings || 2;
1045 push @{$tochan->{pingtime}}, $t;
1046 shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
1048 # cope with a missed ping, this means you must set the pingint large enough
1049 if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) {
1050 $t -= $tochan->{pingint};
1053 # calc smoothed RTT a la TCP
1054 if (@{$tochan->{pingtime}} == 1) {
1055 $tochan->{pingave} = $t;
1057 $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
1060 # for (@{$tochan->{pingtime}}) {
1063 # $tochan->{pingave} = $st / @{$tochan->{pingtime}};
1064 $tochan->{nopings} = $nopings; # pump up the timer
1071 if (eph_dup($line)) {
1072 dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
1075 # route down an appropriate thingy
1076 $self->route($to, $line);
1081 if ($pcno == 75) { # dunno but route it
1082 my $call = $field[1];
1083 if ($call ne $main::mycall) {
1084 $self->route($call, $line);
1089 if ($pcno == 73) { # WCY broadcasts
1090 my $call = $field[1];
1093 my $d = cltounix($call, sprintf("%02d18Z", $field[2]));
1094 if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
1095 dbg("PCPROT: WCY Date ($call $field[2]) out of range") if isdbg('chanerr');
1098 @field = map { unpad($_) } @field;
1099 if (WCY::dup($d,@field[3..7])) {
1100 dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr');
1104 my $wcy = WCY::update($d, @field[2..12]);
1108 $rep = Local::wwv($self, @field[1..12]);
1110 # dbg("Local::wcy error $@") if isdbg('local') if $@;
1113 # broadcast to the eager world
1114 send_wcy_spot($self, $line, $d, @field[2..12]);
1118 if ($pcno == 84) { # remote commands (incoming)
1119 $self->process_rcmd($field[1], $field[2], $field[3], $field[4]);
1123 if ($pcno == 85) { # remote command replies
1124 $self->process_rcmd_reply($field[1], $field[2], $field[3], $field[4]);
1130 # if get here then rebroadcast the thing with its Hop count decremented (if
1131 # there is one). If it has a hop count and it decrements to zero then don't
1134 # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
1138 if (eph_dup($line)) {
1139 dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
1141 unless ($self->{isolate}) {
1142 broadcast_ak1a($line, $self); # send it to everyone but me
1148 # This is called from inside the main cluster processing loop and is used
1149 # for despatching commands that are doing some long processing job
1154 my @dxchan = DXChannel->get_all();
1158 # send out a pc50 on EVERY channel all at once
1159 if ($t >= $last_pc50 + $DXProt::pc50_interval) {
1160 $pc50s = pc50($me, scalar DXChannel::get_all_users);
1165 foreach $dxchan (@dxchan) {
1166 next unless $dxchan->is_node();
1167 next if $dxchan == $me;
1170 $dxchan->send($pc50s) if $pc50s;
1172 # send a ping out on this channel
1173 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
1174 if ($dxchan->{nopings} <= 0) {
1175 $dxchan->disconnect;
1177 addping($main::mycall, $dxchan->call);
1178 $dxchan->{nopings} -= 1;
1179 $dxchan->{lastping} = $t;
1185 if ($t - $last10 >= 10) {
1186 # clean out ephemera
1193 if ($main::systime - 3600 > $last_hour) {
1194 $last_hour = $main::systime;
1199 # finish up a pc context
1203 # some active measures
1210 my @dxchan = DXChannel->get_all();
1213 # send it if it isn't the except list and isn't isolated and still has a hop count
1214 # taking into account filtering and so on
1215 foreach $dxchan (@dxchan) {
1216 next if $dxchan == $me;
1217 next if $dxchan == $self && $self->is_node;
1218 $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call});
1226 my $isolate = shift;
1227 my ($filter, $hops);
1229 if ($self->{spotsfilter}) {
1230 ($filter, $hops) = $self->{spotsfilter}->it(@_);
1231 return unless $filter;
1233 send_prot_line($self, $filter, $hops, $isolate, $line);
1238 my ($self, $filter, $hops, $isolate, $line) = @_;
1243 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1245 $routeit = adjust_hops($self, $line); # adjust its hop count by node name
1246 return unless $routeit;
1249 $self->send($routeit);
1251 $self->send($routeit) unless $self->{isolate} || $isolate;
1260 my @dxchan = DXChannel->get_all();
1262 my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1263 my @dxcc = Prefix::extract($_[7]);
1265 $wwv_dxcc = $dxcc[1]->dxcc;
1266 $wwv_itu = $dxcc[1]->itu;
1267 $wwv_cq = $dxcc[1]->cq;
1269 @dxcc = Prefix::extract($_[8]);
1271 $org_dxcc = $dxcc[1]->dxcc;
1272 $org_itu = $dxcc[1]->itu;
1273 $org_cq = $dxcc[1]->cq;
1276 # send it if it isn't the except list and isn't isolated and still has a hop count
1277 # taking into account filtering and so on
1278 foreach $dxchan (@dxchan) {
1279 next if $dxchan == $me;
1280 next if $dxchan == $self && $self->is_node;
1282 my ($filter, $hops);
1284 $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
1293 my $isolate = shift;
1294 my ($filter, $hops);
1296 if ($self->{wwvfilter}) {
1297 ($filter, $hops) = $self->{wwvfilter}->it(@_);
1298 return unless $filter;
1300 send_prot_line($self, $filter, $hops, $isolate, $line)
1307 my @dxchan = DXChannel->get_all();
1309 my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1310 my @dxcc = Prefix::extract($_[11]);
1312 $wcy_dxcc = $dxcc[1]->dxcc;
1313 $wcy_itu = $dxcc[1]->itu;
1314 $wcy_cq = $dxcc[1]->cq;
1316 @dxcc = Prefix::extract($_[12]);
1318 $org_dxcc = $dxcc[1]->dxcc;
1319 $org_itu = $dxcc[1]->itu;
1320 $org_cq = $dxcc[1]->cq;
1323 # send it if it isn't the except list and isn't isolated and still has a hop count
1324 # taking into account filtering and so on
1325 foreach $dxchan (@dxchan) {
1326 next if $dxchan == $me;
1327 next if $dxchan == $self;
1329 $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
1337 my $isolate = shift;
1338 my ($filter, $hops);
1340 if ($self->{wcyfilter}) {
1341 ($filter, $hops) = $self->{wcyfilter}->it(@_);
1342 return unless $filter;
1344 send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet;
1352 my @dxchan = DXChannel->get_all();
1356 my $text = unpad($_[2]);
1358 if ($_[3] eq '*') { # sysops
1360 } elsif ($_[3] gt ' ') { # speciality list handling
1361 my ($name) = split /\./, $_[3];
1362 $target = "$name"; # put the rest in later (if bothered)
1369 $target = "ALL" if !$target;
1371 Log('ann', $target, $_[0], $text);
1373 # obtain country codes etc
1374 my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
1375 my @dxcc = Prefix::extract($_[0]);
1377 $ann_dxcc = $dxcc[1]->dxcc;
1378 $ann_itu = $dxcc[1]->itu;
1379 $ann_cq = $dxcc[1]->cq;
1381 @dxcc = Prefix::extract($_[4]);
1383 $org_dxcc = $dxcc[1]->dxcc;
1384 $org_itu = $dxcc[1]->itu;
1385 $org_cq = $dxcc[1]->cq;
1388 # send it if it isn't the except list and isn't isolated and still has a hop count
1389 # taking into account filtering and so on
1390 foreach $dxchan (@dxchan) {
1391 next if $dxchan == $me;
1392 next if $dxchan == $self && $self->is_node;
1393 $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
1401 my $isolate = shift;
1405 my ($filter, $hops);
1407 if ($self->{annfilter}) {
1408 ($filter, $hops) = $self->{annfilter}->it(@_);
1409 return unless $filter;
1411 send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
1415 sub send_local_config
1423 dbg('DXProt::send_local_config') if isdbg('trace');
1426 if ($self->{isolate}) {
1427 @localnodes = ( $main::routeroot );
1429 # create a list of all the nodes that are not connected to this connection
1430 # and are not themselves isolated, this to make sure that isolated nodes
1431 # don't appear outside of this node
1432 my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
1433 @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
1434 my @intcalls = map { $_->nodes } @localnodes if @localnodes;
1435 my $ref = Route::Node::get($self->{call});
1436 my @rnodes = $ref->nodes;
1437 for my $n (@intcalls) {
1438 push @remotenodes, Route::Node::get($n) unless grep $n eq $_, @rnodes;
1440 unshift @localnodes, $main::routeroot;
1443 send_route($self, \&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
1445 # get all the users connected on the above nodes and send them out
1446 foreach $n (@localnodes, @remotenodes) {
1448 send_route($self, \&pc16, 1, $n, map {my $r = Route::User::get($_); $r ? ($r) : ()} $n->users);
1450 dbg("sent a null value") if isdbg('chanerr');
1456 # route a message down an appropriate interface for a callsign
1458 # is called route(to, pcline);
1462 my ($self, $call, $line) = @_;
1464 if (ref $self && $call eq $self->{call}) {
1465 dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
1469 # always send it down the local interface if available
1470 my $dxchan = DXChannel->get($call);
1472 my $cl = Route::get($call);
1473 $dxchan = $cl->dxchan if $cl;
1475 if (ref $self && $dxchan eq $self) {
1476 dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
1482 my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name
1484 $dxchan->send($routeit) unless $dxchan == $me;
1487 dbg("PCPROT: No route available, dropped") if isdbg('chanerr');
1491 # broadcast a message to all clusters taking into account isolation
1492 # [except those mentioned after buffer]
1495 my $s = shift; # the line to be rebroadcast
1496 my @except = @_; # to all channels EXCEPT these (dxchannel refs)
1497 my @dxchan = DXChannel::get_all_nodes();
1500 # send it if it isn't the except list and isn't isolated and still has a hop count
1501 foreach $dxchan (@dxchan) {
1502 next if grep $dxchan == $_, @except;
1503 next if $dxchan == $me;
1505 my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name
1506 $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
1510 # broadcast a message to all clusters ignoring isolation
1511 # [except those mentioned after buffer]
1512 sub broadcast_all_ak1a
1514 my $s = shift; # the line to be rebroadcast
1515 my @except = @_; # to all channels EXCEPT these (dxchannel refs)
1516 my @dxchan = DXChannel::get_all_nodes();
1519 # send it if it isn't the except list and isn't isolated and still has a hop count
1520 foreach $dxchan (@dxchan) {
1521 next if grep $dxchan == $_, @except;
1522 next if $dxchan == $me;
1524 my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name
1525 $dxchan->send($routeit);
1529 # broadcast to all users
1530 # storing the spot or whatever until it is in a state to receive it
1533 my $s = shift; # the line to be rebroadcast
1534 my $sort = shift; # the type of transmission
1535 my $fref = shift; # a reference to an object to filter on
1536 my @except = @_; # to all channels EXCEPT these (dxchannel refs)
1537 my @dxchan = DXChannel::get_all_users();
1541 foreach $dxchan (@dxchan) {
1542 next if grep $dxchan == $_, @except;
1545 broadcast_list($s, $sort, $fref, @out);
1548 # broadcast to a list of users
1556 foreach $dxchan (@_) {
1558 next if $dxchan == $me;
1560 if ($sort eq 'dx') {
1561 next unless $dxchan->{dx};
1562 ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
1563 next unless $filter;
1565 next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i;
1566 next if $sort eq 'wwv' && !$dxchan->{wwv};
1567 next if $sort eq 'wcy' && !$dxchan->{wcy};
1568 next if $sort eq 'wx' && !$dxchan->{wx};
1570 $s =~ s/\a//og unless $dxchan->{beep};
1572 if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
1582 # obtain the hops from the list for this callsign and pc no
1588 my $hops = $DXProt::hopcount{$pcno};
1589 $hops = $DXProt::def_hopcount if !$hops;
1594 # adjust the hop count on a per node basis using the user loadable
1595 # hop table if available or else decrement an existing one
1602 my $call = $self->{call};
1605 if (($hops) = $s =~ /\^H(\d+)\^~?$/o) {
1606 my ($pcno) = $s =~ /^PC(\d\d)/o;
1607 confess "$call called adjust_hops with '$s'" unless $pcno;
1608 my $ref = $nodehops{$call} if %nodehops;
1610 my $newhops = $ref->{$pcno};
1611 return "" if defined $newhops && $newhops == 0;
1612 $newhops = $ref->{default} unless $newhops;
1613 return "" if defined $newhops && $newhops == 0;
1614 $newhops = $hops if !$newhops;
1615 $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
1617 # simply decrement it
1619 return "" if !$hops;
1620 $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
1632 return $self->msg('lh1') unless -e "$main::data/hop_table.pl";
1633 do "$main::data/hop_table.pl";
1639 # add a ping request to the ping queues
1642 my ($from, $to) = @_;
1643 my $ref = $pings{$to} || [];
1646 $r->{t} = [ gettimeofday ];
1647 route(undef, $to, pc51($to, $main::mycall, 1));
1654 my ($self, $tonode, $fromnode, $user, $cmd) = @_;
1655 if ($tonode eq $main::mycall) {
1656 my $ref = DXUser->get_current($fromnode);
1657 my $cref = Route::Node::get($fromnode);
1658 Log('rcmd', 'in', $ref->{priv}, $fromnode, $cmd);
1659 if ($cmd !~ /^\s*rcmd/i && $cref && $ref && $cref->call eq $ref->homenode) { # not allowed to relay RCMDS!
1660 if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering
1661 $self->{remotecmd} = 1; # for the benefit of any command that needs to know
1662 my $oldpriv = $self->{priv};
1663 $self->{priv} = $ref->{priv}; # assume the user's privilege level
1664 my @in = (DXCommandmode::run_cmd($self, $cmd));
1665 $self->{priv} = $oldpriv;
1666 $self->send_rcmd_reply($main::mycall, $fromnode, $user, @in);
1667 delete $self->{remotecmd};
1669 $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!");
1672 $self->send_rcmd_reply($main::mycall, $fromnode, $user, "your attempt is logged, Tut tut tut...!");
1675 my $ref = DXUser->get_current($tonode);
1676 if ($ref && $ref->is_clx) {
1677 $self->route($tonode, pc84($fromnode, $tonode, $user, $cmd));
1679 $self->route($tonode, pc34($fromnode, $tonode, $cmd));
1684 sub process_rcmd_reply
1686 my ($self, $tonode, $fromnode, $user, $line) = @_;
1687 if ($tonode eq $main::mycall) {
1688 my $s = $rcmds{$fromnode};
1690 my $dxchan = DXChannel->get($s->{call});
1691 my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
1692 $ref->send($line) if $ref;
1693 delete $rcmds{$fromnode} if !$dxchan;
1695 # send unsolicited ones to the sysop
1696 my $dxchan = DXChannel->get($main::myalias);
1697 $dxchan->send($line) if $dxchan;
1700 my $ref = DXUser->get_current($tonode);
1701 if ($ref && $ref->is_clx) {
1702 $self->route($tonode, pc85($fromnode, $tonode, $user, $line));
1704 $self->route($tonode, pc35($fromnode, $tonode, $line));
1713 my $fromnode = shift;
1718 Log('rcmd', 'out', $fromnode, $line);
1719 if ($self->is_clx) {
1720 $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line"));
1722 $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line"));
1727 # add a rcmd request to the rcmd queues
1730 my ($self, $to, $cmd) = @_;
1733 $r->{call} = $self->{call};
1734 $r->{t} = $main::systime;
1738 my $ref = Route::Node::get($to);
1739 my $dxchan = $ref->dxchan;
1740 if ($dxchan && $dxchan->is_clx) {
1741 route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd));
1743 route(undef, $to, pc34($main::mycall, $to, $cmd));
1750 my $pc39flag = shift;
1751 my $call = $self->call;
1753 return if $self->{disconnecting}++;
1755 unless ($pc39flag && $pc39flag == 1) {
1756 $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op")));
1760 my $node = Route::Node::get($call);
1763 @rout = $node->del($main::routeroot);
1766 # unbusy and stop and outgoing mail
1767 my $mref = DXMsg::get_busy($call);
1768 $mref->stop_msg($call) if $mref;
1770 # broadcast to all other nodes that all the nodes connected to via me are gone
1771 unless ($pc39flag && $pc39flag == 2) {
1772 $self->route_pc21(@rout) if @rout;
1775 # remove outstanding pings
1776 delete $pings{$call};
1778 # I was the last node visited
1779 $self->user->node($main::mycall);
1781 # send info to all logged in thingies
1782 $self->tell_login('logoutn');
1784 Log('DXProt', $call . " Disconnected");
1786 $self->SUPER::disconnect;
1791 # send a talk message to this thingy
1795 my ($self, $from, $to, $via, $line) = @_;
1797 $line =~ s/\^/\\5E/g; # remove any ^ characters
1798 $self->send(DXProt::pc10($from, $to, $via, $line));
1799 Log('talk', $self->call, $from, $via?$via:$main::mycall, $line);
1802 # send it if it isn't the except list and isn't isolated and still has a hop count
1803 # taking into account filtering and so on
1807 my $generate = shift;
1808 my $no = shift; # the no of things to filter on
1810 my ($filter, $hops);
1813 for (; @_ && $no; $no--) {
1816 if (!$self->{isolate} && $self->{routefilter}) {
1819 ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
1823 dbg("DXPROT: $self->{call}/" . $r->call . " rejected by output filter") if isdbg('chanerr');
1826 dbg("was sent a null value") if isdbg('chanerr');
1829 push @rin, $r unless $self->{isolate} && $r->call ne $main::mycall;
1833 foreach my $line (&$generate(@rin, @_)) {
1836 $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
1838 $routeit = adjust_hops($self, $line); # adjust its hop count by node name
1839 next unless $routeit;
1841 $self->send($routeit);
1849 my $generate = shift;
1850 my @dxchan = DXChannel::get_all_nodes();
1854 unless ($self->{isolate}) {
1855 foreach $dxchan (@dxchan) {
1856 next if $dxchan == $self;
1857 next if $dxchan == $me;
1858 $dxchan->send_route($generate, @_);
1866 broadcast_route($self, \&pc16, 1, @_);
1872 broadcast_route($self, \&pc17, 1, @_);
1878 broadcast_route($self, \&pc19, scalar @_, @_);
1884 broadcast_route($self, \&pc21, scalar @_, @_);
1890 broadcast_route($self, \&pc24, 1, @_);
1896 broadcast_route($self, \&pc41, 1, @_);
1902 broadcast_route($self, \&pc50, 1, @_);
1909 my ($filter, $hops) = (1, 1);
1911 if ($self->{inroutefilter}) {
1912 ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
1913 dbg("PCPROT: $self->{call}/" . $r->call . ' rejected by in_filter_route') if !$filter && isdbg('chanerr');
1924 $s =~ s/\^H\d\d?\^?\~?$//;
1925 $r = 1 if exists $eph{$s}; # pump up the dup if it keeps circulating
1926 $eph{$s} = $main::systime;
1934 while (($key, $val) = each %eph) {
1935 if ($key =~ m{$regex}) {
1945 while (($key, $val) = each %eph) {
1946 if ($main::systime - $val > 180) {