X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=81cdeaeeae5cc8d15d5cc02b997ba27a908236a7;hb=f63d598af3f797b56b8d5e23ec4ff5254192eee9;hp=2168c7fc3cb5404842f01808abee2acc6b39b22d;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 2168c7fc..b6e959e7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -4,8 +4,8 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # -# $Id$ -# +# +# package DXProt; @@ -27,33 +27,37 @@ use DXDb; use AnnTalk; use Geomag; use WCY; -use Time::HiRes qw(gettimeofday tv_interval); use BadWords; use DXHash; use Route; use Route::Node; use Script; +use DXProtHandle; +use DXCIDR; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime $last_hour $last10 %eph %pings %rcmds $ann_to_talk - %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck - $allowzero $decode_dk0wcy $send_opernam @checklist); + $pingint $obscount %pc19list $chatdupeage $chatimportfn + $pc19_version $myprot_version + %nodehops $baddx $badspotter $badnode $censorpc + $allowzero $decode_dk0wcy $send_opernam @checklist + $eph_pc15_restime $pc92_update_period $pc92_obs_timeout + %pc92_find $pc92_find_timeout $pc92_short_update_period + $next_pc92_obs_timeout $pc92_slug_changes $last_pc92_slug + $pc92_extnode_update_period $pc50_interval + $pc92_keepalive_period + ); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23 $last_hour = time; # last time I did an hourly periodic update -%pings = (); # outstanding ping requests outbound %rcmds = (); # outstanding rcmd requests outbound %nodehops = (); # node specific hop control +%pc19list = (); # list of outstanding PC19s that haven't had PC16s on them + $censorpc = 1; # Do a BadWords::check on text fields and reject things # loads of 'bad things' $baddx = new DXHash "baddx"; @@ -61,55 +65,67 @@ $badspotter = new DXHash "badspotter"; $badnode = new DXHash "badnode"; $last10 = $last_pc50 = time; $ann_to_talk = 1; -$rspfcheck = 1; -$eph_restime = 180; -$eph_info_restime = 60*60; +$eph_restime = 60; +$eph_info_restime = 18*60*60; +$eph_pc15_restime = 6*60; $eph_pc34_restime = 30; - -@checklist = +$pingint = 5*60; +$obscount = 2; +$chatdupeage = 20 * 60; +$chatimportfn = "$main::root/chat_import"; +$pc19_version = 5455; # the visible version no for outgoing PC19s generated from pc59 +$pc92_update_period = 4*60*60; # the period between outgoing PC92 C updates +$pc92_short_update_period = 15*60; # shorten the update period after a connection or start up +$pc92_extnode_update_period = 1*60*60; # the update period for external nodes +$pc92_keepalive_period = 1*60*60; # frequency of PC92 K (keepalive) records +%pc92_find = (); # outstanding pc92 find operations +$pc92_find_timeout = 30; # maximum time to wait for a reply + + +@checklist = ( - [ qw(c c m bp bc c) ], # pc10 - [ qw(f m d t m c c h) ], # pc11 - [ qw(c bc m bp bm p h) ], # pc12 - [ qw(c h) ], # - [ qw(c h) ], # - [ qw(c m h) ], # + [ qw(i c c m bp bc c) ], # pc10 + [ qw(i f m d t m c c h) ], # pc11 + [ qw(i c bm m bm bm p h) ], # pc12 + [ qw(i c h) ], # + [ qw(i c h) ], # + [ qw(i c m h) ], # undef , # pc16 has to be validated manually - [ qw(c c h) ], # pc17 - [ qw(m n) ], # pc18 + [ qw(i c c h) ], # pc17 + [ qw(i m n) ], # pc18 undef , # pc19 has to be validated manually undef , # pc20 no validation - [ qw(c m h) ], # pc21 + [ qw(i c m h) ], # pc21 undef , # pc22 no validation - [ qw(d n n n n m c c h) ], # pc23 - [ qw(c p h) ], # pc24 - [ qw(c c n n) ], # pc25 - [ qw(f m d t m c c bc) ], # pc26 - [ qw(d n n n n m c c bc) ], # pc27 - [ qw(c c m c d t p m bp n p bp bc) ], # pc28 - [ qw(c c n m) ], # pc29 - [ qw(c c n) ], # pc30 - [ qw(c c n) ], # pc31 - [ qw(c c n) ], # pc32 - [ qw(c c n) ], # pc33 - [ qw(c c m) ], # pc34 - [ qw(c c m) ], # pc35 - [ qw(c c m) ], # pc36 - [ qw(c c n m) ], # pc37 + [ qw(i d n n n n m c c h) ], # pc23 + [ qw(i c p h) ], # pc24 + [ qw(i c c n n) ], # pc25 + [ qw(i f m d t m c c bc) ], # pc26 + [ qw(i d n n n n m c c bc) ], # pc27 + [ qw(i c c m c d t p m bp n p bp bc) ], # pc28 + [ qw(i c c n m) ], # pc29 + [ qw(i c c n) ], # pc30 + [ qw(i c c n) ], # pc31 + [ qw(i c c n) ], # pc32 + [ qw(i c c n) ], # pc33 + [ qw(i c c m) ], # pc34 + [ qw(i c c m) ], # pc35 + [ qw(i c c m) ], # pc36 + [ qw(i c c n m) ], # pc37 undef, # pc38 not interested - [ qw(c m) ], # pc39 - [ qw(c c m p n) ], # pc40 - [ qw(c n m h) ], # pc41 - [ qw(c c n) ], # pc42 + [ qw(i c m) ], # pc39 + [ qw(i c c m p n) ], # pc40 + [ qw(i c n m h) ], # pc41 + [ qw(i c c n) ], # pc42 undef, # pc43 don't handle it - [ qw(c c n m m c) ], # pc44 - [ qw(c c n m) ], # pc45 - [ qw(c c n) ], # pc46 + [ qw(i c c n m m c) ], # pc44 + [ qw(i c c n m) ], # pc45 + [ qw(i c c n) ], # pc46 undef, # pc47 undef, # pc48 - [ qw(c m h) ], # pc49 - [ qw(c n h) ], # pc50 - [ qw(c c n) ], # pc51 + [ qw(i c m h) ], # pc49 + [ qw(i c n h) ], # pc50 + [ qw(i c c n) ], # pc51 undef, undef, undef, @@ -119,7 +135,7 @@ $eph_pc34_restime = 30; undef, undef, undef, # pc60 - undef, + [ qw(i f m d t m c c a h) ], # pc61 undef, undef, undef, @@ -131,7 +147,7 @@ $eph_pc34_restime = 30; undef, # pc70 undef, undef, - [ qw(d n n n n n n m m m c c h) ], # pc73 + [ qw(i d n n n n n n m m m c c h) ], # pc73 undef, undef, undef, @@ -142,8 +158,16 @@ $eph_pc34_restime = 30; undef, undef, undef, - [ qw(c c c m) ], # pc84 - [ qw(c c c m) ], # pc85 + [ qw(i c c c m) ], # pc84 + [ qw(i c c c m) ], # pc85 + undef, + undef, + undef, + undef, + undef, # pc90 + undef, + [ qw(i c f l)], # pc92 + [ qw(i c f *m c *c m)], # pc93 ); # use the entry in the check list to check the field list presented @@ -152,55 +176,104 @@ sub check { my $n = shift; $n -= 10; - return 0 if $n < 0 || $n > @checklist; + return 0 if $n < 0 || $n > @checklist; my $ref = $checklist[$n]; return 0 unless ref $ref; - + my $i; - shift; # not interested in the first field - for ($i = 0; $i < @$ref; $i++) { + for ($i = 1; $i < @$ref; $i++) { my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/; return 0 unless $act; - next if $blank && $_[$i] =~ /^[ \*]$/; + next if $blank eq 'b' && $_[$i] =~ /^[ \*]$/; + next if $blank eq '*' && $_[$i] =~ /^\*$/; if ($act eq 'c') { - return $i+1 unless is_callsign($_[$i]); + return $i unless is_callsign($_[$i]); + } elsif ($act eq 'i') { + ; # do nothing } elsif ($act eq 'm') { - return $i+1 unless is_pctext($_[$i]); + return $i unless is_pctext($_[$i]); } elsif ($act eq 'p') { - return $i+1 unless is_pcflag($_[$i]); + return $i unless is_pcflag($_[$i]); } elsif ($act eq 'f') { - return $i+1 unless is_freq($_[$i]); + return $i unless is_freq($_[$i]); } elsif ($act eq 'n') { - return $i+1 unless $_[$i] =~ /^[\d ]+$/; + return $i unless $_[$i] =~ /^[\d ]+$/; } elsif ($act eq 'h') { - return $i+1 unless $_[$i] =~ /^H\d\d?$/; + return $i unless $_[$i] =~ /^H\d\d?$/; } elsif ($act eq 'd') { - return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; + return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; } elsif ($act eq 't') { - return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/; + return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/; + } elsif ($act eq 'l') { + return $i unless $_[$i] =~ /^[A-Z]$/; + } elsif ($act eq 'a') { + return $i unless is_ipaddr($_[$i]); } } return 0; } +sub update_pc92_next +{ + my $self = shift; + my $period = shift || ($self->{do_pc9x} ? $pc92_update_period : $pc92_extnode_update_period); + $self->{next_pc92_update} = $main::systime + $period - int rand($period / 4); + dbg("ROUTE: update_pc92_next: $self->{call} " . atime($self->{next_pc92_update})) if isdbg('obscount'); +} + +sub update_pc92_keepalive +{ + my $self = shift; + my $period = shift || $pc92_keepalive_period; + $self->{next_pc92_keepalive} = $main::systime + $period - int rand($period / 4); + dbg("ROUTE: update_pc92_keepalive: $self->{call} " . atime($self->{next_pc92_keepalive})) if isdbg('obscount'); +} + sub init { do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; + + my $user = DXUser::get($main::mycall); + die "User $main::mycall not setup or disappeared RTFM" unless $user; + + $myprot_version += $main::version*100; + $main::me = DXProt->new($main::mycall, 0, $user); + $main::me->{here} = 1; + $main::me->{state} = "indifferent"; + $main::me->{sort} = 'S'; # S for spider + $main::me->{priv} = 9; + $main::me->{metric} = 0; + $main::me->{pingave} = 0; + $main::me->{registered} = 1; + $main::me->{version} = $main::version; + $main::me->{build} = $main::build; + $main::me->{do_pc9x} = 1; + $main::me->{hostname} = $main::clusteraddr; + $main::me->update_pc92_next($pc92_short_update_period); + $main::me->update_pc92_keepalive; } # # obtain a new connection this is derived from dxchannel # -sub new +sub new { my $self = DXChannel::alloc(@_); # add this node to the table, the values get filled in later my $pkg = shift; my $call = shift; - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; + + # if we have an entry already, then send a PC21 to all connect + # old style connections, because we are about to get the real deal + if (my $ref = Route::Node::get($call)) { + dbg("ROUTE: $call is already in the routing table, deleting") if isdbg('route'); + my @rout = $ref->delete; + $self->route_pc21($main::mycall, undef, @rout) if @rout; + } + $main::routeroot->add($call, '5000', Route::here(1), $self->{conn}->peerhost) if $call ne $main::mycall; return $self; } @@ -215,14 +288,19 @@ sub start my $user = $self->{user}; # log it - my $host = $self->{conn}->{peerhost} || "unknown"; + my $host = $self->{conn}->peerhost; + $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; + $host ||= $host if is_ipaddr($host); + $host ||= "unknown"; + $self->{hostname} = $host; + Log('DXProt', "$call connected from $host"); - + # remember type of connection $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; my $priv = $user->priv; - $priv = $user->priv(1) unless $priv; + $priv = $user->priv(1) unless defined $priv; $self->{priv} = $priv; # other clusters can always be 'normal' users $self->{lang} = $user->lang || 'en'; $self->{isolate} = $user->{isolate}; @@ -238,7 +316,8 @@ sub start $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; - $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate}; + $self->{pc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; # get the INPUT filters (these only pertain to Clusters) @@ -247,17 +326,19 @@ sub start $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; - + $self->{inpc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; + + # set unbuffered and no echo $self->send_now('B',"0"); $self->send_now('E',"0"); $self->conn->echo(0) if $self->conn->can('echo'); - + # ping neighbour node stuff my $ping = $user->pingint; - $ping = 5*60 unless defined $ping; + $ping = $pingint unless defined $ping; $self->{pingint} = $ping; - $self->{nopings} = $user->nopings || 2; + $self->{nopings} = $user->nopings || $obscount; $self->{pingtime} = [ ]; $self->{pingave} = 999; $self->{metric} ||= 100; @@ -267,7 +348,7 @@ sub start unless ($self->{outbound}) { $self->sendinit; } - + $self->state('init'); $self->{pc50_t} = $main::systime; @@ -277,6 +358,13 @@ sub start # run a script send the output to the debug file my $script = new Script(lc $call) || new Script('node_default'); $script->run($self) if $script; + + # set up a config broadcast "quite soon" to converge tables quicker + $main::me->update_pc92_next($pc92_short_update_period); + $self->update_pc92_next($pc92_short_update_period); + + # set next keepalive time + $self->update_pc92_keepalive; } # @@ -286,7 +374,7 @@ sub start sub sendinit { my $self = shift; - $self->send(pc18()); + $self->send(pc18(($self->{isolate} || !$self->user->wantpc9x) ? "" : " pc9x")); } # @@ -295,18 +383,26 @@ sub sendinit sub normal { my ($self, $line) = @_; + + if ($line =~ '^<\w+\s' && $main::do_xml) { + DXXml::normal($self, $line); + return; + } + my @field = split /\^/, $line; return unless @field; - + pop @field if $field[-1] eq '~'; - + # print join(',', @field), "\n"; - - + + # process PC frames, this will fail unless the frame starts PCnn my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number - return unless $pcno; - return if $pcno < 10 || $pcno > 99; + unless (defined $pcno && $pcno >= 10 && $pcno <= 99) { + dbg("PCPROT: unknown protocol") if isdbg('chanerr'); + return; + } # check for and dump bad protocol messages my $n = check($pcno, @field); @@ -315,1007 +411,125 @@ sub normal return; } - # local processing 1 - my $pcr; - eval { - $pcr = Local::pcprot($self, $pcno, @field); - }; -# dbg("Local::pcprot error $@") if isdbg('local') if $@; - return if $pcr; - - SWITCH: { - if ($pcno == 10) { # incoming talk - - # rsfp check - return if $rspfcheck and !$self->rspfcheck(0, $field[6], $field[1]); - - # will we allow it at all? - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } - - # is it for me or one of mine? - my ($from, $to, $via, $call, $dxchan); - $from = $field[1]; - if ($field[5] gt ' ') { - $via = $field[2]; - $to = $field[5]; - } else { - $to = $field[2]; - } - - # if this is a 'nodx' node then ignore it - if ($badnode->in($field[6]) || ($via && $badnode->in($via))) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } - - # if this is a 'bad spotter' user then ignore it - my $nossid = $from; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } - - # if we are converting announces to talk is it a dup? - if ($ann_to_talk) { - if (AnnTalk::is_talk_candidate($from, $field[3]) && AnnTalk::dup($from, $to, $field[3])) { - dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr'); - return; - } - } - - # it is here and logged on - $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall; - $dxchan = DXChannel->get($to) unless $dxchan; - if ($dxchan && $dxchan->is_user) { - $field[3] =~ s/\%5E/^/g; - $dxchan->talk($from, $to, $via, $field[3]); - return; - } - - # is it elsewhere, visible on the cluster via the to address? - # note: this discards the via unless the to address is on - # the via address - my ($ref, $vref); - if ($ref = Route::get($to)) { - $vref = Route::Node::get($via) if $via; - $vref = undef unless $vref && grep $to eq $_, $vref->users; - $ref->dxchan->talk($from, $to, $vref ? $via : undef, $field[3], $field[6]); - return; - } - - # not visible here, send a message of condolence - $vref = undef; - $ref = Route::get($from); - $vref = $ref = Route::Node::get($field[6]) unless $ref; - if ($ref) { - $dxchan = $ref->dxchan; - $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); - } - return; - } - - if ($pcno == 11 || $pcno == 26) { # dx spot - - # route 'foreign' pc26s - if ($pcno == 26) { - if ($field[7] ne $main::mycall) { - $self->route($field[7], $line); - return; - } - } - - # rsfp check -# return if $rspfcheck and !$self->rspfcheck(1, $field[7], $field[6]); - - # if this is a 'nodx' node then ignore it - if ($badnode->in($field[7])) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } - - # if this is a 'bad spotter' user then ignore it - my $nossid = $field[6]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } - - # convert the date to a unix date - my $d = cltounix($field[3], $field[4]); - # bang out (and don't pass on) if date is invalid or the spot is too old (or too young) - if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) { - dbg("PCPROT: Spot ignored, invalid date or out of range ($field[3] $field[4])\n") if isdbg('chanerr'); - return; - } - - # is it 'baddx' - if ($baddx->in($field[2]) || BadWords::check($field[2]) || $field[2] =~ /COCK/) { - dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr'); - return; - } - - # do some de-duping - $field[5] =~ s/^\s+//; # take any leading blanks off - $field[2] = unpad($field[2]); # take off leading and trailing blanks from spotted callsign - if ($field[2] =~ /BUST\w*$/) { - dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chanerr'); - return; - } - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[5])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } - - - my @spot = Spot::prepare($field[1], $field[2], $d, $field[5], $field[6], $field[7]); - # global spot filtering on INPUT - if ($self->{inspotsfilter}) { - my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); - unless ($filter) { - dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr'); - return; - } - } - - # this goes after the input filtering, but before the add - # so that if it is input filtered, it isn't added to the dup - # list. This allows it to come in from a "legitimate" source - if (Spot::dup($field[1], $field[2], $d, $field[5])) { - dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); - return; - } - - # add it - Spot::add(@spot); - - # - # @spot at this point contains:- - # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node - # then spotted itu, spotted cq, spotters itu, spotters cq - # you should be able to route on any of these - # - - # fix up qra locators of known users - my $user = DXUser->get_current($spot[4]); - if ($user) { - my $qra = $user->qra; - unless ($qra && is_qra($qra)) { - my $lat = $user->lat; - my $long = $user->long; - if (defined $lat && defined $long) { - $user->qra(DXBearing::lltoqra($lat, $long)); - $user->put; - } - } - - # send a remote command to a distant cluster if it is visible and there is no - # qra locator and we havn't done it for a month. - - unless ($user->qra) { - my $node; - my $to = $user->homenode; - my $last = $user->lastoper || 0; - if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) { - my $cmd = "forward/opernam $spot[4]"; - # send the rcmd but we aren't interested in the replies... - my $dxchan = $node->dxchan; - if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); - } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); - } - if ($to ne $field[7]) { - $to = $field[7]; - $node = Route::Node::get($to); - if ($node) { - $dxchan = $node->dxchan; - if ($dxchan && $dxchan->is_clx) { - route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); - } else { - route(undef, $to, pc34($main::mycall, $to, $cmd)); - } - } - } - $user->lastoper($main::systime); - $user->put; - } - } - } - - # local processing - my $r; - eval { - $r = Local::spot($self, @spot); - }; -# dbg("Local::spot1 error $@") if isdbg('local') if $@; - return if $r; - - # DON'T be silly and send on PC26s! - return if $pcno == 26; - - # send out the filtered spots - send_dx_spot($self, $line, @spot) if @spot; - return; + # modify the hop count here + if ($self != $main::me) { + if (my ($hops, $trail) = $line =~ /\^H(\d+)(\^?\~?)?$/) { + $trail ||= ''; + $hops--; + return if $hops < 0; + $line =~ s/\^H(\d+)(\^?\~?)?$/sprintf('^H%d%s', $hops, $trail)/e; + $field[-1] = "H$hops"; } - - if ($pcno == 12) { # announces + } -# return if $rspfcheck and !$self->rspfcheck(1, $field[5], $field[1]); + if (defined &Local::pcprot) { + my $r; + eval { $r = Local::pcprot($self, $pcno, $line, @field); }; + return if $r; # i.e don't process it + } - # announce duplicate checking - $field[3] =~ s/^\s+//; # remove leading blanks + # send it out for processing + my $origin = $self->{call}; + no strict 'subs'; + my $sub = "handle_$pcno"; - if ($censorpc) { - my @bad; - if (@bad = BadWords::check($field[3])) { - dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chanerr'); - return; - } - } + if ($self->can($sub)) { + $self->$sub($pcno, $line, $origin, \@field); + } else { + $self->handle_default($pcno, $line, $origin, \@field); + } +} - # if this is a 'nodx' node then ignore it - if ($badnode->in($field[5])) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); - return; - } +# +# This is called from inside the main cluster processing loop and is used +# for despatching commands that are doing some long processing job +# +sub process +{ + my $t = time; + my @dxchan = DXChannel::get_all(); + my $dxchan; + my $pc50s; - # if this is a 'bad spotter' user then ignore it - my $nossid = $field[1]; - $nossid =~ s/-\d+$//; - if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); - return; - } + # every ten seconds + if ($t - $last10 >= 10) { + # clean out ephemera - if ($field[2] eq '*' || $field[2] eq $main::mycall) { + eph_clean(); + import_chat(); + $last10 = $t; - # here's a bit of fun, convert incoming ann with a callsign in the first word - # or one saying 'to ' to a talk if we can route to the recipient - if ($ann_to_talk) { - my $call = AnnTalk::is_talk_candidate($field[1], $field[3]); - if ($call) { - my $ref = Route::get($call); - if ($ref) { - my $dxchan = $ref->dxchan; - $dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self; - return; - } - } - } - - # send it - $self->send_announce($line, @field[1..6]); - } else { - $self->route($field[2], $line); - } - return; - } - - if ($pcno == 13) { - last SWITCH; + # send out a pc50 on EVERY channel all at once + if ($t >= $last_pc50 + $pc50_interval) { + $pc50s = pc50($main::me, scalar DXChannel::get_all_users); + eph_dup($pc50s); + $last_pc50 = $t; } - if ($pcno == 14) { - last SWITCH; - } - if ($pcno == 15) { - last SWITCH; - } - - if ($pcno == 16) { # add a user - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } + foreach $dxchan (@dxchan) { + next unless $dxchan->is_node; + next if $dxchan == $main::me; - # general checks - my $dxchan; - my $ncall = $field[1]; - my $newline = "PC16^"; - - if ($ncall eq $main::mycall) { - dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); - return; - } - my $parent = Route::Node::get($ncall); - unless ($parent) { - dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); - return; - } - $dxchan = $parent->dxchan; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } + # send the pc50 + $dxchan->send($pc50s) if !$dxchan->{do_pc9x} && $pc50s; - # input filter if required - return unless $self->in_filter_route($parent); - - my $i; - my @rout; - for ($i = 2; $i < $#field; $i++) { - my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; - next unless $call && $conf && defined $here && is_callsign($call); - next if $call eq $main::mycall; - - eph_del_regex("^PC17\\^$call\\^$ncall"); - - $conf = $conf eq '*'; - - # reject this if we think it is a node already - my $r = Route::Node::get($call); - my $u = DXUser->get_current($call) unless $r; - if ($r || ($u && $u->is_node)) { - dbg("PCPROT: $call is a node") if isdbg('chanerr'); - next; - } - - $r = Route::User::get($call); - my $flags = Route::here($here)|Route::conf($conf); - - if ($r) { - if ($r->flags != $flags) { - $r->flags($flags); - push @rout, $r; - } - $r->addparent($parent); + # send a ping out on this channel + if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { + if ($dxchan->{nopings} <= 0) { + dbg("ROUTE: $dxchan->{call} disconnected on ping obscount") if isdbg('obscount'); + $dxchan->disconnect; } else { - push @rout, $parent->add_user($call, $flags); + DXXml::Ping::add($main::me, $dxchan->call); + $dxchan->{nopings} -= 1; + $dxchan->{lastping} = $t; + $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; + dbg("ROUTE: $dxchan->{call} ping obscount = $dxchan->{nopings}") if isdbg('obscount'); } - - # add this station to the user database, if required - $call =~ s/-\d+$//o; # remove ssid for users - my $user = DXUser->get_current($call); - $user = DXUser->new($call) if !$user; - $user->homenode($parent->call) if !$user->homenode; - $user->node($parent->call); - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; } - - # queue up any messages (look for privates only) - DXMsg::queue_msg(1) if $self->state eq 'normal'; - - $self->route_pc16($parent, @rout) if @rout; - return; - } - - if ($pcno == 17) { # remove a user - my $dxchan; - my $ncall = $field[2]; - my $ucall = $field[1]; - - eph_del_regex("^PC16\\^$ncall.*$ucall"); - - if ($ncall eq $main::mycall) { - dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); - return; - } - - my $uref = Route::User::get($ucall); - unless ($uref) { - dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); - return; - } - my $parent = Route::Node::get($ncall); - unless ($parent) { - dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); - return; - } - - $dxchan = $parent->dxchan; - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } - - # input filter if required - return unless $self->in_filter_route($parent); - - $parent->del_user($uref); - - if (eph_dup($line)) { - dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); - return; - } - - $self->route_pc17($parent, $uref); - return; - } - - if ($pcno == 18) { # link request - $self->state('init'); - - # record the type and version offered - if ($field[1] =~ /DXSpider Version: (\d+\.\d+) Build: (\d+\.\d+)/) { - $self->version(53 + $1); - $self->user->version(53 + $1); - $self->build(0 + $2); - $self->user->build(0 + $2); - unless ($self->is_spider) { - $self->user->sort('S'); - $self->user->put; - $self->sort('S'); - } - } else { - $self->version(50.0); - $self->version($field[2] / 100) if $field[2] && $field[2] =~ /^\d+$/; - $self->user->version($self->version); - } - - # first clear out any nodes on this dxchannel - my $parent = Route::Node::get($self->{call}); - my @rout = $parent->del_nodes; - $self->route_pc21(@rout, $parent) if @rout; - $self->send_local_config(); - $self->send(pc20()); - return; # we don't pass these on } - - if ($pcno == 19) { # incoming cluster list - my $i; - my $newline = "PC19^"; - if (eph_dup($line)) { - dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); - return; - } - - # new routing list - my @rout; - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); - $self->disconnect; - return; - } - - # parse the PC19 - for ($i = 1; $i < $#field-1; $i += 4) { - my $here = $field[$i]; - my $call = uc $field[$i+1]; - my $conf = $field[$i+2]; - my $ver = $field[$i+3]; - next unless defined $here && defined $conf && is_callsign($call); - - eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); - - # check for sane parameters -# $ver = 5000 if $ver eq '0000'; - next if $ver < 5000; # only works with version 5 software - next if length $call < 3; # min 3 letter callsigns - next if $call eq $main::mycall; - - # check that this PC19 isn't trying to alter the wrong dxchan - my $dxchan = DXChannel->get($call); - if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr'); - next; - } + clean_pc92_find(); - # update it if required - my $r = Route::Node::get($call); - my $flags = Route::here($here)|Route::conf($conf); - if ($r) { - my $ar; - if ($call ne $parent->call) { - if ($self->in_filter_route($r)) { - $ar = $parent->add($call, $ver, $flags); - push @rout, $ar if $ar; - } else { - next; - } - } - if ($r->version ne $ver || $r->flags != $flags) { - $r->version($ver); - $r->flags($flags); - push @rout, $r unless $ar; - } - } else { - if ($call eq $self->{call}) { - dbg("DXPROT: my channel route for $call has disappeared"); - next; - }; - - my $new = Route->new($call); # throw away - if ($self->in_filter_route($new)) { - my $r = $parent->add($call, $ver, $flags); - push @rout, $r; + # send out config broadcasts + foreach $dxchan (@dxchan) { + next unless $dxchan->is_node; + + # send out a PC92 config record if required for me and + # all my non pc9x dependent nodes. But for dependent nodes we only do + # this if we have not seen any from anyone else for at least half + # of one update period. This should stop quite a bit of excess C + # records. Someone will win, it does not really matter who, because + # we always believe "us". + if ($main::systime >= $dxchan->{next_pc92_update}) { + if ($dxchan == $main::me || !$dxchan->{do_pc9x}) { + dbg("ROUTE: pc92 broadcast candidate: $dxchan->{call}") if isdbg('obscount'); + my $ref = Route::Node::get($dxchan->{call}); + if ($dxchan == $main::me || ($ref && ($ref->measure_pc9x_t($main::systime-$main::systime_daystart)) >= $pc92_extnode_update_period/2)) { + $dxchan->broadcast_pc92_update($dxchan->{call}); } else { - next; - } - } - - # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) - my $mref = DXMsg::get_busy($call); - $mref->stop_msg($call) if $mref; - - # add this station to the user database, if required (don't remove SSID from nodes) - my $user = DXUser->get_current($call); - if (!$user) { - $user = DXUser->new($call); - $user->sort('A'); - $user->priv(1); # I have relented and defaulted nodes - $user->lockout(1); - $user->homenode($call); - $user->node($call); - } - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; - } - - - $self->route_pc19(@rout) if @rout; - return; - } - - if ($pcno == 20) { # send local configuration - $self->send_local_config(); - $self->send(pc22()); - $self->state('normal'); - $self->{lastping} = 0; - return; - } - - if ($pcno == 21) { # delete a cluster from the list - my $call = uc $field[1]; - - eph_del_regex("^PC1[79].*$call"); - - # if I get a PC21 from the same callsign as self then treat it - # as a PC39: I have gone away - if ($call eq $self->call) { - $self->disconnect(1); - return; - } - - my @rout; - my $parent = Route::Node::get($self->{call}); - unless ($parent) { - dbg("DXPROT: my parent $self->{call} has disappeared"); - $self->disconnect; - return; - } - if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! - my $node = Route::Node::get($call); - if ($node) { - - my $dxchan = DXChannel->get($call); - if ($dxchan && $dxchan != $self) { - dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); - return; + $dxchan->update_pc92_next; } - - # input filter it - return unless $self->in_filter_route($node); - - # routing objects - push @rout, $node->del($parent); - } - } else { - dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); - return; - } - -# if (eph_dup($line)) { -# dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); -# return; -# } - - $self->route_pc21(@rout) if @rout; - return; - } - - if ($pcno == 22) { - $self->state('normal'); - $self->{lastping} = 0; - return; - } - - if ($pcno == 23 || $pcno == 27) { # WWV info - - # route 'foreign' pc27s - if ($pcno == 27) { - if ($field[8] ne $main::mycall) { - $self->route($field[8], $line); - return; - } - } - - return if $rspfcheck and !$self->rspfcheck(1, $field[8], $field[7]); - - # do some de-duping - my $d = cltounix($field[1], sprintf("%02d18Z", $field[2])); - my $sfi = unpad($field[3]); - my $k = unpad($field[4]); - my $i = unpad($field[5]); - my ($r) = $field[6] =~ /R=(\d+)/; - $r = 0 unless $r; - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) { - dbg("PCPROT: WWV Date ($field[1] $field[2]) out of range") if isdbg('chanerr'); - return; - } - if (Geomag::dup($d,$sfi,$k,$i,$field[6])) { - dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); - return; - } - $field[7] =~ s/-\d+$//o; # remove spotter's ssid - - my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..8], $r); - - my $rep; - eval { - $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r); - }; -# dbg("Local::wwv2 error $@") if isdbg('local') if $@; - return if $rep; - - # DON'T be silly and send on PC27s! - return if $pcno == 27; - - # broadcast to the eager world - send_wwv_spot($self, $line, $d, $field[2], $sfi, $k, $i, @field[6..8]); - return; - } - - if ($pcno == 24) { # set here status - my $call = uc $field[1]; - my ($nref, $uref); - $nref = Route::Node::get($call); - $uref = Route::User::get($call); - return unless $nref || $uref; # if we don't know where they are, it's pointless sending it on - - unless (eph_dup($line)) { - $nref->here($field[2]) if $nref; - $uref->here($field[2]) if $uref; - my $ref = $nref || $uref; - return unless $self->in_filter_route($ref); - $self->route_pc24($ref, $field[3]); - } - return; - } - - if ($pcno == 25) { # merge request - if ($field[1] ne $main::mycall) { - $self->route($field[1], $line); - return; - } - if ($field[2] eq $main::mycall) { - dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chanerr'); - return; - } - - Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[2]"); - - # spots - if ($field[3] > 0) { - my @in = reverse Spot::search(1, undef, undef, 0, $field[3]); - my $in; - foreach $in (@in) { - $self->send(pc26(@{$in}[0..4], $field[2])); - } - } - - # wwv - if ($field[4] > 0) { - my @in = reverse Geomag::search(0, $field[4], time, 1); - my $in; - foreach $in (@in) { - $self->send(pc27(@{$in}[0..5], $field[2])); - } - } - return; - } - - if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling - return if $pcno == 49 && eph_dup($line); - if ($pcno == 49 || $field[1] eq $main::mycall) { - DXMsg::process($self, $line); - } else { - $self->route($field[1], $line) unless $self->is_clx; - } - return; - } - - if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) - if (eph_dup($line, $eph_pc34_restime)) { - dbg("PCPROT: dupe") if isdbg('chanerr'); - } else { - $self->process_rcmd($field[1], $field[2], $field[2], $field[3]); - } - return; - } - - if ($pcno == 35) { # remote command replies - eph_del_regex("^PC35\\^$field[2]\\^$field[1]\\^"); - $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]); - return; - } - - # for pc 37 see 44 onwards - - if ($pcno == 38) { # node connected list from neighbour - return; - } - - if ($pcno == 39) { # incoming disconnect - if ($field[1] eq $self->{call}) { - $self->disconnect(1); - } else { - dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); - } - return; - } - - if ($pcno == 41) { # user info - my $call = $field[1]; - - if (eph_dup($line, $eph_info_restime)) { - dbg("PCPROT: dupe") if isdbg('chanerr'); - return; - } - - # input filter if required -# my $ref = Route::get($call) || Route->new($call); -# return unless $self->in_filter_route($ref); - - if ($field[3] eq $field[2] || $field[3] =~ /^\s*$/) { - dbg('PCPROT: invalid value') if isdbg('chanerr'); - return; - } - - # add this station to the user database, if required - my $user = DXUser->get_current($call); - $user = DXUser->new($call) if !$user; - - if ($field[2] == 1) { - $user->name($field[3]); - } elsif ($field[2] == 2) { - $user->qth($field[3]); - } elsif ($field[2] == 3) { - if (is_latlong($field[3])) { - my ($lat, $long) = DXBearing::stoll($field[3]); - $user->lat($lat); - $user->long($long); - $user->qra(DXBearing::lltoqra($lat, $long)); - } else { - dbg('PCPROT: not a valid lat/long') if isdbg('chanerr'); - return; - } - } elsif ($field[2] == 4) { - $user->homenode($field[3]); - } elsif ($field[2] == 5) { - if (is_qra(uc $field[3])) { - my ($lat, $long) = DXBearing::qratoll(uc $field[3]); - $user->lat($lat); - $user->long($long); - $user->qra(uc $field[3]); - } else { - dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr'); - return; - } - } - $user->lastoper($main::systime); # to cut down on excessive for/opers being generated - $user->put; - - unless ($self->{isolate}) { - DXChannel::broadcast_nodes($line, $self); # send it to everyone but me - } - -# perhaps this IS what we want after all -# $self->route_pc41($ref, $call, $field[2], $field[3], $field[4]); - return; - } - - if ($pcno == 43) { - last SWITCH; - } - - if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47 || $pcno == 48) { - DXDb::process($self, $line); - return; - } - - if ($pcno == 50) { # keep alive/user list - my $call = $field[1]; - my $node = Route::Node::get($call); - if ($node) { - return unless $node->call eq $self->{call}; - $node->usercount($field[2]); - - # input filter if required - return unless $self->in_filter_route($node); - - $self->route_pc50($node, $field[2], $field[3]) unless eph_dup($line); - } - return; - } - - if ($pcno == 51) { # incoming ping requests/answers - my $to = $field[1]; - my $from = $field[2]; - my $flag = $field[3]; - - - # is it for us? - if ($to eq $main::mycall) { - if ($flag == 1) { - $self->send(pc51($from, $to, '0')); } else { - # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; - if ($ref) { - my $tochan = DXChannel->get($from); - while (@$ref) { - my $r = shift @$ref; - my $dxchan = DXChannel->get($r->{call}); - next unless $dxchan; - my $t = tv_interval($r->{t}, [ gettimeofday ]); - if ($dxchan->is_user) { - my $s = sprintf "%.2f", $t; - my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; - $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) - } elsif ($dxchan->is_node) { - if ($tochan) { - my $nopings = $tochan->user->nopings || 2; - push @{$tochan->{pingtime}}, $t; - shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough - if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { - $t -= $tochan->{pingint}; - } - - # calc smoothed RTT a la TCP - if (@{$tochan->{pingtime}} == 1) { - $tochan->{pingave} = $t; - } else { - $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); - } - $tochan->{nopings} = $nopings; # pump up the timer - } - } - } - } + $dxchan->update_pc92_next; # this won't actually do anything, it's just to be tidy } - } else { - if (eph_dup($line)) { - dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); - return; - } - # route down an appropriate thingy - $self->route($to, $line); - } - return; - } - - if ($pcno == 75) { # dunno but route it - my $call = $field[1]; - if ($call ne $main::mycall) { - $self->route($call, $line); } - return; - } - - if ($pcno == 73) { # WCY broadcasts - my $call = $field[1]; - - # do some de-duping - my $d = cltounix($call, sprintf("%02d18Z", $field[2])); - if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) { - dbg("PCPROT: WCY Date ($call $field[2]) out of range") if isdbg('chanerr'); - return; - } - @field = map { unpad($_) } @field; - if (WCY::dup($d)) { - dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chanerr'); - return; - } - - my $wcy = WCY::update($d, @field[2..12]); - - my $rep; - eval { - $rep = Local::wcy($self, @field[1..12]); - }; - # dbg("Local::wcy error $@") if isdbg('local') if $@; - return if $rep; - - # broadcast to the eager world - send_wcy_spot($self, $line, $d, @field[2..12]); - return; } - if ($pcno == 84) { # remote commands (incoming) - $self->process_rcmd($field[1], $field[2], $field[3], $field[4]); - return; + # do the keepalive for me, if required + if ($main::systime >= $main::me->{next_pc92_keepalive}) { + time_out_pc92_routes(); + $main::me->broadcast_pc92_keepalive($main::mycall); } - if ($pcno == 85) { # remote command replies - $self->process_rcmd_reply($field[1], $field[2], $field[3], $field[4]); - - return; - } - if ($pcno == 90) { # new style PC16,17,19,21 - return; + if ($pc92_slug_changes && $main::systime >= $last_pc92_slug + $pc92_slug_changes) { + my ($add, $del) = gen_pc92_changes(); + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, @$del) if @$del; + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, @$add) if @$add; + clear_pc92_changes(); } } - - # if get here then rebroadcast the thing with its Hop count decremented (if - # there is one). If it has a hop count and it decrements to zero then don't - # rebroadcast it. - # - # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be - # REBROADCAST!!!! - # - - if (eph_dup($line)) { - dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); - } else { - unless ($self->{isolate}) { - DXChannel::broadcast_nodes($line, $self); # send it to everyone but me - } - } -} -# -# This is called from inside the main cluster processing loop and is used -# for despatching commands that are doing some long processing job -# -sub process -{ - my $t = time; - my @dxchan = DXChannel->get_all(); - my $dxchan; - my $pc50s; - - # send out a pc50 on EVERY channel all at once - if ($t >= $last_pc50 + $DXProt::pc50_interval) { - $pc50s = pc50($main::me, scalar DXChannel::get_all_users); - eph_dup($pc50s); - $last_pc50 = $t; - } - - foreach $dxchan (@dxchan) { - next unless $dxchan->is_node(); - next if $dxchan == $main::me; - - # send the pc50 or PC90 - $dxchan->send($pc50s) if $pc50s; - - # send a ping out on this channel - if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { - if ($dxchan->{nopings} <= 0) { - $dxchan->disconnect; - } else { - addping($main::mycall, $dxchan->call); - $dxchan->{nopings} -= 1; - $dxchan->{lastping} = $t; - } - } - } - - # every ten seconds - if ($t - $last10 >= 10) { - # clean out ephemera - - eph_clean(); - - $last10 = $t; - } - if ($main::systime - 3600 > $last_hour) { $last_hour = $main::systime; } @@ -1334,15 +548,24 @@ sub send_dx_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - + my $pc11; + # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; - $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + if ($line =~ /PC61/ && !($dxchan->is_spider || $dxchan->is_user)) { + unless ($pc11) { + my @f = split /\^/, $line; + $pc11 = join '^', 'PC11', @f[1..7,9]; + } + $dxchan->dx_spot($pc11, $self->{isolate}, @_, $self->{call}); + } else { + $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + } } } @@ -1364,7 +587,8 @@ sub send_prot_line { my ($self, $filter, $hops, $isolate, $line) = @_; my $routeit; - + + if ($hops) { $routeit = $line; $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; @@ -1384,22 +608,10 @@ sub send_wwv_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[6]); - if (@dxcc > 0) { - $wwv_dxcc = $dxcc[1]->dxcc; - $wwv_itu = $dxcc[1]->itu; - $wwv_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[7]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } - + my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]); + # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { @@ -1408,9 +620,8 @@ sub send_wwv_spot my $routeit; my ($filter, $hops); - $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, @dxcc); } - } sub wwv @@ -1419,9 +630,9 @@ sub wwv my $line = shift; my $isolate = shift; my ($filter, $hops); - + if ($self->{wwvfilter}) { - ($filter, $hops) = $self->{wwvfilter}->it(@_); + ($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_]); return unless $filter; } send_prot_line($self, $filter, $hops, $isolate, $line) @@ -1431,29 +642,17 @@ sub send_wcy_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[10]); - if (@dxcc > 0) { - $wcy_dxcc = $dxcc[1]->dxcc; - $wcy_itu = $dxcc[1]->itu; - $wcy_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[11]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } - + my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]); + # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self; - $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc); } } @@ -1468,73 +667,148 @@ sub wcy ($filter, $hops) = $self->{wcyfilter}->it(@_); return unless $filter; } - send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet; + send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet; +} + +# send an announce +sub send_announce +{ + my $self = shift; + my $from_pc9x = shift; + my $line = shift; + my @dxchan = DXChannel::get_all(); + my $dxchan; + my $target = $_[6]; + my $to = 'To '; + my $text = unpad($_[2]); + my $from = $_[0]; + + if ($_[3] eq '*') { # sysops + $target = "SYSOP"; + } elsif ($_[3] gt ' ') { # speciality list handling + my ($name) = split /\./, $_[3]; + $target = "$name"; # put the rest in later (if bothered) + } + + if ($_[5] eq '1') { + $target = "WX"; + $to = ''; + } + $target = "ALL" if !$target; + + + # obtain country codes etc + my @a = Prefix::cty_data($from); + my @b = Prefix::cty_data($_[4]); + if ($self->{inannfilter}) { + my ($filter, $hops) = + $self->{inannfilter}->it(@_, $self->{call}, + @a[0..2], + @b[0..2], $a[3], $b[3]); + unless ($filter) { + dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); + return; + } + } + + # the sysop ('*') thing is an attempt to minimise the damage caused by non-updated PC93 generators + if (AnnTalk::dup($from, $target, $_[2]) || ($_[3] eq '*' && AnnTalk::dup($from, 'ALL', $_[2]))) { + my $dxchan = DXChannel::get($from); + if ($self == $main::me && $dxchan && $dxchan->is_user) { + if ($dxchan->priv < 5) { + $dxchan->send($dxchan->msg('dup')); + return; + } + } else { + dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr'); + return; + } + } + + Log('ann', $target, $from, $text); + + # send it if it isn't the except list and isn't isolated and still has a hop count + # taking into account filtering and so on + foreach $dxchan (@dxchan) { + next if $dxchan == $main::me; + next if $dxchan == $self && $self->is_node; + next if $from_pc9x && $dxchan->{do_pc9x}; + next if $target eq 'LOCAL' && $dxchan->is_node; + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, + @a[0..2], @b[0..2]); + } } -# send an announce -sub send_announce +my $msgid = int rand(1000); + +sub nextchatmsgid +{ + $msgid++; + $msgid = 1 if $msgid > 999; + return $msgid; +} + +# send a chat line +sub send_chat { my $self = shift; + my $from_pc9x = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; - my $target; - my $to = 'To '; + my $target = $_[3]; my $text = unpad($_[2]); - - if ($_[3] eq '*') { # sysops - $target = "SYSOP"; - } elsif ($_[3] gt ' ') { # speciality list handling - my ($name) = split /\./, $_[3]; - $target = "$name"; # put the rest in later (if bothered) - } - - if ($_[5] eq '1') { - $target = "WX"; - $to = ''; - } - $target = "ALL" if !$target; - + my $ak1a_line; + my $from = $_[0]; - # obtain country codes etc - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[0]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[4]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; + # munge the group and recast the line if required + if ($target =~ s/\.LST$//) { + $ak1a_line = $line; } + # obtain country codes etc + my @a = Prefix::cty_data($from); + my @b = Prefix::cty_data($_[4]); if ($self->{inannfilter}) { - my ($filter, $hops) = - $self->{inannfilter}->it(@_, $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, - $org_dxcc, $org_itu, $org_cq); + my ($filter, $hops) = + $self->{inannfilter}->it(@_, $self->{call}, + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; } } - if (AnnTalk::dup($_[0], $_[1], $_[2])) { - dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr'); - return; + if (AnnTalk::dup($from, $target, $_[2], $main::systime + $chatdupeage)) { + my $dxchan = DXChannel::get($from); + if ($self == $main::me && $dxchan && $dxchan->is_user) { + if ($dxchan->priv < 5) { + $dxchan->send($dxchan->msg('dup')); + return; + } + } else { + dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr'); + return; + } } - Log('ann', $target, $_[0], $text); + + Log('chat', $target, $from, $text); # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { - next if $dxchan == $main::me; - next if $dxchan == $self && $self->is_node; - $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + if ($dxchan->is_node) { + next if $dxchan == $main::me; + next if $dxchan == $self; + next if $from_pc9x && $dxchan->do_pc9x; + next unless $dxchan->is_spider && $dxchan->do_pc9x; + next if $target eq 'LOCAL'; + } + + $dxchan->chat($line, $self->{isolate}, $target, $_[1], + $text, @_, $self->{call}, @a[0..2], @b[0..2]); } } @@ -1555,46 +829,191 @@ sub announce send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall; } +sub chat +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my $to = shift; + my $target = shift; + my $text = shift; + my ($filter, $hops); + + if ($self->{annfilter}) { + ($filter, $hops) = $self->{annfilter}->it(@_); + return unless $filter; + } + if (($self->is_spider || $self->is_ak1a) && $_[1] ne $main::mycall) { + send_prot_line($self, $filter, $hops, $isolate, $line); + } +} + sub send_local_config { my $self = shift; - my $n; + + dbg('DXProt::send_local_config') if isdbg('trace'); + + # send our nodes + my $node; my @nodes; my @localnodes; my @remotenodes; - dbg('DXProt::send_local_config') if isdbg('trace'); - - # send our nodes if ($self->{isolate}) { + dbg("send_local_config: isolated"); @localnodes = ( $main::routeroot ); + $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); + } elsif ($self->{do_pc9x}) { + dbg("send_local_config: doing pc9x"); + my $node = Route::Node::get($self->{call}); +# $self->send_last_pc92_config($main::routeroot); +# $self->send(pc92a($main::routeroot, $node)) unless $main::routeroot->last_PC92C =~ /$self->{call}/; + $self->send(pc92a($main::routeroot, $node)); + $self->send(pc92k($main::routeroot)); } else { # create a list of all the nodes that are not connected to this connection # and are not themselves isolated, this to make sure that isolated nodes - # don't appear outside of this node + # don't appear outside of this node + + dbg("send_local_config: traditional"); + + # send locally connected nodes my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; - my @intcalls = map { $_->nodes } @localnodes if @localnodes; + $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); + + my $node; + my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; + my @intcalls; + foreach $node (@rawintcalls) { + push @intcalls, $node if grep $_ && $node != $_, @intcalls; + } my $ref = Route::Node::get($self->{call}); my @rnodes = $ref->nodes; - for my $n (@intcalls) { - push @remotenodes, Route::Node::get($n) unless grep $n eq $_, @rnodes; + foreach $node (@intcalls) { + push @remotenodes, Route::Node::get($node) if grep $_ && $node != $_, @rnodes, @remotenodes; } - unshift @localnodes, $main::routeroot; + $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); } - - send_route($self, \&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes); - # get all the users connected on the above nodes and send them out - foreach $n (@localnodes, @remotenodes) { - if ($n) { - send_route($self, \&pc16, 1, $n, map {my $r = Route::User::get($_); $r ? ($r) : ()} $n->users); + unless ($self->{do_pc9x}) { + foreach $node ($main::routeroot, @localnodes, @remotenodes) { + if ($node) { + my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; + $self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16; + } else { + dbg("sent a null value") if isdbg('chanerr'); + } + } + } +} + +sub gen_my_pc92_config +{ + my $node = shift; + + if ($node->{call} eq $main::mycall) { + clear_pc92_changes(); # remove any slugged data, we are generating it as now + my @dxchan = grep { $_->call ne $main::mycall && !$_->{isolate} } DXChannel::get_all(); + dbg("ROUTE: all dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); + my @localnodes = map { my $r = Route::get($_->{call}); $r ? $r : () } @dxchan; + dbg("ROUTE: localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); + return pc92c($node, @localnodes); + } else { + my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; + return pc92c($node, @rout); + } +} + +sub send_last_pc92_config +{ + my $self = shift; + my $node = shift; + if (my $l = $node->last_PC92C) { + $self->send($l); + } else { + $self->send_pc92_config($node); + } +} + +sub send_pc92_config +{ + my $self = shift; + my $node = shift; + + dbg('DXProt::send_pc92_config') if isdbg('trace'); + + $node->last_PC92C(gen_my_pc92_config($node)); + $self->send($node->last_PC92C); +} + +sub broadcast_pc92_update +{ + my $self = shift; + my $call = shift; + + dbg("ROUTE: broadcast_pc92_update $call") if isdbg('obscount'); + + my $nref = Route::Node::get($call); + unless ($nref) { + cluck("ERROR: broadcast_pc92_update - Route::Node $call disappeared"); + $self->update_pc92_next; + return; + } + my $l = $nref->last_PC92C(gen_my_pc92_config($nref)); + $nref->lastid(last_pc9x_id()); + $main::me->broadcast_route_pc9x($main::mycall, undef, $l, 0); + $self->update_pc92_next; +} + +sub broadcast_pc92_keepalive +{ + my $self = shift; + my $call = shift; + + dbg("ROUTE: broadcast_pc92_keepalive $call") if isdbg('obscount'); + + my $nref = Route::Node::get($call); + unless ($nref) { + cluck("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared"); + $self->update_pc92_keepalive; + return; + } + my $l = pc92k($nref); + $nref->lastid(last_pc9x_id()); + $main::me->broadcast_route_pc9x($main::mycall, undef, $l, 0); + $self->update_pc92_keepalive; +} + +sub time_out_pc92_routes +{ + my @nodes = grep {$_->call ne $main::mycall && ($_->do_pc9x || $_->via_pc92)} Route::Node::get_all(); + my @rdel; + foreach my $n (@nodes) { + my $o = $n->dec_obs; + if ($o <= 0) { + if (my $dxchan = DXChannel::get($n->call)) { + dbg("ROUTE: disconnecting local pc92 $dxchan->{call} on obscount") if isdbg('obscount'); + $dxchan->disconnect; + next; + } + my @parents = map {Route::Node::get($_)} $n->parents; + for (@parents) { + if ($_) { + dbg("ROUTE: deleting pc92 $_->{call} from $n->{call} on obscount") if isdbg('obscount'); + push @rdel, $n->del($_); + } + } } else { - dbg("sent a null value") if isdbg('chanerr'); + dbg("ROUTE: obscount on $n->{call} now $o") if isdbg('obscount'); } } + for (@rdel) { + $main::me->route_pc21($main::mycall, undef, $_) if $_; + } } # @@ -1602,6 +1021,7 @@ sub send_local_config # # is called route(to, pcline); # + sub route { my ($self, $call, $line) = @_; @@ -1612,8 +1032,10 @@ sub route } # always send it down the local interface if available - my $dxchan = DXChannel->get($call); - unless ($dxchan) { + my $dxchan = DXChannel::get($call); + if ($dxchan) { + dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route'); + } else { my $cl = Route::get($call); $dxchan = $cl->dxchan if $cl; if (ref $dxchan) { @@ -1621,8 +1043,10 @@ sub route dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); return; } + dbg("route: $call -> $dxchan->{call} using normal route" ) if isdbg('route'); } } + if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { @@ -1634,7 +1058,7 @@ sub route } # -# obtain the hops from the list for this callsign and pc no +# obtain the hops from the list for this callsign and pc no # sub get_hops @@ -1642,11 +1066,11 @@ sub get_hops my $pcno = shift; my $hops = $DXProt::hopcount{$pcno}; $hops = $DXProt::def_hopcount if !$hops; - return "H$hops"; + return "H$hops"; } -# -# adjust the hop count on a per node basis using the user loadable +# +# adjust the hop count on a per node basis using the user loadable # hop table if available or else decrement an existing one # @@ -1656,8 +1080,8 @@ sub adjust_hops my $s = shift; my $call = $self->{call}; my $hops; - - if (($hops) = $s =~ /\^H(\d+)\^~?$/o) { + + if (($hops) = $s =~ /\^H([-\d]+)\^?~?$/o) { my ($pcno) = $s =~ /^PC(\d\d)/o; confess "$call called adjust_hops with '$s'" unless $pcno; my $ref = $nodehops{$call} if %nodehops; @@ -1666,19 +1090,17 @@ sub adjust_hops return "" if defined $newhops && $newhops == 0; $newhops = $ref->{default} unless $newhops; return "" if defined $newhops && $newhops == 0; - $newhops = $hops if !$newhops; - $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; + $newhops = $hops unless $newhops; + return "" unless $newhops > 0; + $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops != $hops; } else { - # simply decrement it - $hops--; - return "" if !$hops; - $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; + return "" unless $hops > 0; } } return $s; } -# +# # load hop tables # sub load_hops @@ -1687,31 +1109,27 @@ sub load_hops return $self->msg('lh1') unless -e "$main::data/hop_table.pl"; do "$main::data/hop_table.pl"; return $@ if $@; - return 0; -} - - -# add a ping request to the ping queues -sub addping -{ - my ($from, $to) = @_; - my $ref = $pings{$to} || []; - my $r = {}; - $r->{call} = $from; - $r->{t} = [ gettimeofday ]; - route(undef, $to, pc51($to, $main::mycall, 1)); - push @$ref, $r; - $pings{$to} = $ref; + return (); } sub process_rcmd { my ($self, $tonode, $fromnode, $user, $cmd) = @_; if ($tonode eq $main::mycall) { - my $ref = DXUser->get_current($fromnode); + my $ref = DXUser::get_current($fromnode); + unless ($ref && UNIVERSAL::isa($ref, 'DXUser')) { + dbg("DXProt process_rcmd: user $fromnode isn't a reference (check user_asc and tell G1TLH)"); + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!"); + return; + } my $cref = Route::Node::get($fromnode); - Log('rcmd', 'in', $ref->{priv}, $fromnode, $cmd); - if ($cmd !~ /^\s*rcmd/i && $cref && $ref && $cref->call eq $ref->homenode) { # not allowed to relay RCMDS! + unless ($cref && UNIVERSAL::isa($cref, 'Route')) { + dbg("DXProt process_rcmd: Route $fromnode isn't a reference (tell G1TLH)"); + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!"); + return; + } + Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd); + if ($cmd !~ /^\s*rcmd/i && $ref->homenode && $cref->call eq $ref->homenode) { # not allowed to relay RCMDS! if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering $self->{remotecmd} = 1; # for the benefit of any command that needs to know my $oldpriv = $self->{priv}; @@ -1727,7 +1145,7 @@ sub process_rcmd $self->send_rcmd_reply($main::mycall, $fromnode, $user, "your attempt is logged, Tut tut tut...!"); } } else { - my $ref = DXUser->get_current($tonode); + my $ref = DXUser::get_current($tonode); if ($ref && $ref->is_clx) { $self->route($tonode, pc84($fromnode, $tonode, $user, $cmd)); } else { @@ -1742,17 +1160,17 @@ sub process_rcmd_reply if ($tonode eq $main::mycall) { my $s = $rcmds{$fromnode}; if ($s) { - my $dxchan = DXChannel->get($s->{call}); - my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan); + my $dxchan = DXChannel::get($s->{call}); + my $ref = $user eq $tonode ? $dxchan : (DXChannel::get($user) || $dxchan); $ref->send($line) if $ref; delete $rcmds{$fromnode} if !$dxchan; } else { # send unsolicited ones to the sysop - my $dxchan = DXChannel->get($main::myalias); + my $dxchan = DXChannel::get($main::myalias); $dxchan->send($line) if $dxchan; } } else { - my $ref = DXUser->get_current($tonode); + my $ref = DXUser::get_current($tonode); if ($ref && $ref->is_clx) { $self->route($tonode, pc85($fromnode, $tonode, $user, $line)); } else { @@ -1789,7 +1207,7 @@ sub addrcmd $r->{t} = $main::systime; $r->{cmd} = $cmd; $rcmds{$to} = $r; - + my $ref = Route::Node::get($to); my $dxchan = $ref->dxchan; if ($dxchan && $dxchan->is_clx) { @@ -1802,38 +1220,30 @@ sub addrcmd sub disconnect { my $self = shift; - my $pc39flag = shift; + my $pc39flag = shift || 0; my $call = $self->call; return if $self->{disconnecting}++; - - unless ($pc39flag && $pc39flag == 1) { + + unless ($pc39flag == 1) { $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op"))); } - # get rid of any PC16 and 19s - eph_del_regex("^PC16\\^$call"); - eph_del_regex("^PC19\\^.*$call"); + # get rid of any PC16/17/19 + eph_del_regex("^PC1[679]*$call"); - # do routing stuff + # do routing stuff, remove me from routing table my $node = Route::Node::get($call); - my @rout; - if ($node) { - @rout = $node->del($main::routeroot); - } - + + Route::delete_interface($call); + # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - - # broadcast to all other nodes that all the nodes connected to via me are gone - unless ($pc39flag && $pc39flag == 2) { - $self->route_pc21(@rout) if @rout; - } # remove outstanding pings delete $pings{$call}; - + # I was the last node visited $self->user->node($main::mycall); @@ -1843,43 +1253,91 @@ sub disconnect Log('DXProt', $call . " Disconnected"); $self->SUPER::disconnect; + + # here we determine what needs to go out of the routing table + my @rout; + if ($node && $pc39flag != 2) { + dbg('%Route::Node::List = ' . join(',', sort keys %Route::Node::list)) if isdbg('routedisc'); + + @rout = $node->del($main::routeroot); + + dbg('@rout = ' . join(',', sort map {$_->call} @rout)) if isdbg('routedisc'); + + # now we need to see what can't be routed anymore and came + # in via this node (probably). + my $n = 0; + while ($n != @rout) { + $n = @rout; + for (Route::Node::get_all()) { + unless ($_->dxchan) { + push @rout, $_->delete; + } + } + dbg('@rout = ' . join(',', sort map {$_->call} @rout)) if isdbg('routedisc'); + } + + dbg('%Route::Node::List = ' . join(',', sort keys %Route::Node::list)) if isdbg('routedisc'); + + # and all my ephemera as well + for (@rout) { + my $c = $_->call; + eph_del_regex("^PC1[679].*$c"); + } + } + + # broadcast to all other nodes that all the nodes connected to via me are gone + unless ($pc39flag == 2) { + $self->route_pc21($main::mycall, undef, @rout) if @rout; + $self->route_pc92d($main::mycall, undef, $main::routeroot, $node) if $node; + } } -# +# # send a talk message to this thingy # sub talk { my ($self, $from, $to, $via, $line, $origin) = @_; - - $line =~ s/\^/\\5E/g; # remove any ^ characters - $self->send(DXProt::pc10($from, $to, $via, $line, $origin)); - Log('talk', $to, $from, $via?$via:$self->call, $line) unless $origin && $origin ne $main::mycall; + + if ($self->{do_pc9x}) { + $self->send(pc93($to, $from, $via, $line)); + } else { + $self->send(pc10($from, $to, $via, $line, $origin)); + } + Log('talk', $to, $from, '>' . ($via || $origin || $self->call), $line) unless $origin && $origin ne $main::mycall; } # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on + sub send_route { my $self = shift; + my $origin = shift; my $generate = shift; - my $no = shift; # the no of things to filter on + my $no = shift; # the no of things to filter on my $routeit; my ($filter, $hops); my @rin; - + for (; @_ && $no; $no--) { my $r = shift; - + + # don't send messages with $self's call in back to them + if ($r->call eq $self->{call}) { + dbg("PCPROT: trying to send $self->{call} back itself") if isdbg('chanerr'); + next; + } + if (!$self->{isolate} && $self->{routefilter}) { $filter = undef; if ($r) { - ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq); + ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->{state}, $r->{state}); if ($filter) { push @rin, $r; } else { - dbg("DXPROT: $self->{call}/" . $r->call . " rejected by output filter") if isdbg('chanerr'); + dbg("PCPROT: $self->{call}/" . $r->call . " rejected by output filter") if isdbg('filter'); } } else { dbg("was sent a null value") if isdbg('chanerr'); @@ -1897,26 +1355,105 @@ sub send_route $routeit = adjust_hops($self, $line); # adjust its hop count by node name next unless $routeit; } + $self->send($routeit); } } } +# broadcast everywhere sub broadcast_route { my $self = shift; + my $origin = shift; my $generate = shift; + my $line = shift; my @dxchan = DXChannel::get_all_nodes(); my $dxchan; - my $line; - + + if ($line) { + $line =~ /\^H(\d+)\^?\~?$/; + return unless $1 > 0; + } unless ($self->{isolate}) { foreach $dxchan (@dxchan) { - next if $dxchan == $self; - next if $dxchan == $main::me; - next if $dxchan->user->wantnp; - - $dxchan->send_route($generate, @_); + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. + next unless $dxchan->isa('DXProt'); + + $dxchan->send_route($origin, $generate, @_); + } + } +} + +# broadcast to non-pc9x nodes +sub broadcast_route_nopc9x +{ + my $self = shift; + my $origin = shift; + my $generate = shift; + my $line = shift; + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + if ($line) { + $line =~ /\^H(\d+)\^?\~?$/; + return unless $1 > 0; + } + unless ($self->{isolate}) { + foreach $dxchan (@dxchan) { + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. + next unless $dxchan->isa('DXProt'); + next if $dxchan->{do_pc9x}; + if ($generate == \&pc16 || $generate==\&pc17) { + next unless $dxchan->user->wantsendpc16; + } + $dxchan->send_route($origin, $generate, @_); + } + } +} + +# this is only used for next door nodes on init +sub send_route_pc92 +{ + my $self = shift; + + return unless $self->{do_pc9x}; + + my $origin = shift; + my $generate = shift; + my $no = shift; # the no of things to filter on + my $line; + + $line = &$generate(@_); + $self->send($line); +} + +# broadcast only to pc9x nodes +sub broadcast_route_pc9x +{ + my $self = shift; + my $origin = shift; + my $generate = shift; + my $line = shift; + my $no = shift; + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + if ($origin eq $main::mycall && $generate && !$line) { + $line = &$generate(@_); + } + + $line =~ /\^H(\d+)\^\~?$/; + unless ($1 > 0 && $self->{isolate}) { + foreach $dxchan (@dxchan) { + next if $dxchan == $self || $dxchan == $main::me; + next if $origin eq $dxchan->{call}; # don't route some from this call back again. + next unless $dxchan->isa('DXProt'); + next unless $dxchan->{do_pc9x}; + + $dxchan->send($line); } } } @@ -1924,49 +1461,85 @@ sub broadcast_route sub route_pc16 { my $self = shift; - broadcast_route($self, \&pc16, 1, @_); + return unless $self->user->wantpc16; + my $origin = shift; + my $line = shift; + broadcast_route_nopc9x($self, $origin, \&pc16, $line, 1, @_); } sub route_pc17 { my $self = shift; - broadcast_route($self, \&pc17, 1, @_); + return unless $self->user->wantpc16; + my $origin = shift; + my $line = shift; + broadcast_route_nopc9x($self, $origin, \&pc17, $line, 1, @_); } sub route_pc19 { my $self = shift; - broadcast_route($self, \&pc19, scalar @_, @_); + my $origin = shift; + my $line = shift; + broadcast_route_nopc9x($self, $origin, \&pc19, $line, scalar @_, @_); } sub route_pc21 { my $self = shift; - broadcast_route($self, \&pc21, scalar @_, @_); + my $origin = shift; + my $line = shift; + broadcast_route_nopc9x($self, $origin, \&pc21, $line, scalar @_, @_); } sub route_pc24 { my $self = shift; - broadcast_route($self, \&pc24, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc24, $line, 1, @_); } sub route_pc41 { my $self = shift; - broadcast_route($self, \&pc41, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route($self, $origin, \&pc41, $line, 1, @_); } +# this is probably obsolete now sub route_pc50 { my $self = shift; - broadcast_route($self, \&pc50, 1, @_); + my $origin = shift; + my $line = shift; + + broadcast_route($self, $origin, \&pc50, $line, 1, @_); +} + +sub route_pc92c +{ + my $self = shift; + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92c, $line, 1, @_); +} + +sub route_pc92a +{ + my $self = shift; + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92a, $line, 1, @_); } -sub route_pc90 +sub route_pc92d { my $self = shift; - broadcast_route($self, \&pc90, 1, @_); + my $origin = shift; + my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92d, $line, 1, @_); } sub in_filter_route @@ -1974,9 +1547,9 @@ sub in_filter_route my $self = shift; my $r = shift; my ($filter, $hops) = (1, 1); - + if ($self->{inroutefilter}) { - ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq); + ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->state, $r->state); dbg("PCPROT: $self->{call}/" . $r->call . ' rejected by in_filter_route') if !$filter && isdbg('chanerr'); } return $filter; @@ -1992,6 +1565,7 @@ sub eph_dup $s =~ s/\^H\d\d?\^?\~?$//; $r = 1 if exists $eph{$s}; # pump up the dup if it keeps circulating $eph{$s} = $main::systime + $t; + dbg("PCPROT: emphemeral duplicate") if $r && isdbg('chanerr'); return $r; } @@ -2009,7 +1583,7 @@ sub eph_del_regex sub eph_clean { my ($key, $val); - + while (($key, $val) = each %eph) { if ($main::systime >= $val) { delete $eph{$key}; @@ -2032,5 +1606,89 @@ sub run_cmd { goto &DXCommandmode::run_cmd; } + + +# import any msgs in the chat directory +# the messages are sent to the chat group which forms the +# the first part of the name (eg: solar.1243.txt would be +# sent to chat group SOLAR) +# +# Each message found is sent: one non-blank line to one chat +# message. So 4 lines = 4 chat messages. +# +# The special name LOCAL is for local users ANN +# The special name ALL is for ANN/FULL +# The special name SYSOP is for ANN/SYSOP +# +sub import_chat +{ + # are there any to do in this directory? + return unless -d $chatimportfn; + unless (opendir(DIR, $chatimportfn)) { + dbg("can\'t open $chatimportfn $!") if isdbg('msg'); + Log('msg', "can\'t open $chatimportfn $!"); + return; + } + + my @names = readdir(DIR); + closedir(DIR); + my $name; + foreach $name (@names) { + next if $name =~ /^\./; + my $splitit = $name =~ /^split/; + my $fn = "$chatimportfn/$name"; + next unless -f $fn; + unless (open(MSG, $fn)) { + dbg("can\'t open import file $fn $!") if isdbg('msg'); + Log('msg', "can\'t open import file $fn $!"); + unlink($fn); + next; + } + my @msg = map { s/\r?\n$//; $_ } ; + close(MSG); + unlink($fn); + + my @cat = split /\./, $name; + my $target = uc $cat[0]; + + foreach my $text (@msg) { + next unless $text && $text !~ /^\s*#/; + if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP' || $target eq 'WX') { + my $sysop = uc $target eq 'SYSOP' ? '*' : ' '; + my $wx = uc $target eq 'WX' ? '1' : '0'; + my $via = $target; + $via = '*' if $target eq 'ALL' || $target eq 'SYSOP'; + Log('ann', $target, $main::mycall, $text); + $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text)); + } else { + DXCommandmode::send_chats($main::me, $target, $text); + } + } + } +} + +# start a pc92 find operation +sub start_pc92_find +{ + my $dxchan = shift; + my $target = shift; + my $key = "$dxchan->{call}|$target"; + if ($pc92_find{$key}) { + + } +} + +# function (not method) to handle pc92 find returns +sub handle_pc92_find_reply +{ + my ($dxchan, $node, $from, $target, $flag, $ms) = @_; + + $dxchan->print_pc92_find_reply($node, $target, $flag, $ms) if $dxchan->can('print_pc92_find_return'); +} + +sub clean_pc92_find +{ + +} 1; -__END__ +__END__