X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=5c6ca1fb928abd18426cce68525fedbcb3e20cf6;hb=4c60d18d0d58ece2406680d4afd4ff016532c11c;hp=7fd9e7ef14673100d48ace457c124b7264af1f65;hpb=25140d3e8633cbf9e25b6528248405ec8ed125e3;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7fd9e7ef..5c6ca1fb 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -27,12 +27,14 @@ 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 Investigate; +use RouteDB; + use strict; @@ -44,15 +46,16 @@ $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 - $pingint $obscount %pc19list $chatdupeage + $pingint $obscount %pc19list $chatdupeage $chatimportfn + $investigation_int $pc19_version $myprot_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck - $allowzero $decode_dk0wcy $send_opernam @checklist); + $allowzero $decode_dk0wcy $send_opernam @checklist + $handle_xml); $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 @@ -71,6 +74,10 @@ $eph_pc34_restime = 30; $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60 * 60; +$chatimportfn = "$main::root/chat_import"; +$investigation_int = 12*60*60; # time between checks to see if we can see this node +$pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 +$handle_xml = 0; # handle XML sentences @checklist = ( @@ -199,6 +206,21 @@ 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; } # @@ -227,7 +249,10 @@ 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 ||= "unknown"; + Log('DXProt', "$call connected from $host"); # remember type of connection @@ -274,7 +299,7 @@ sub start $self->{pingave} = 999; $self->{metric} ||= 100; $self->{lastping} = $main::systime; - + # send initialisation string unless ($self->{outbound}) { $self->sendinit; @@ -301,63 +326,18 @@ sub sendinit $self->send(pc18()); } -sub removepc90 -{ - $_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//; -} - -sub removepc91 -{ - $_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//; -} - -sub send -{ - my $self = shift; - while (@_) { - my $line = shift; - if ($self->user->wantpc90) { - $line = mungepc90($line); - } else { - removepc91($line); - removepc90($line); - } - $self->SUPER::send($line); - } -} - -my $pc90msgid = 0; - -sub nextpc90 -{ - $pc90msgid = 0 if $pc90msgid > 9999; - return $pc90msgid++; -} - -sub mungepc90 -{ - unless ($_[0] =~ /^PC9\d/) { - my $id = nextpc90(); - return "PC90^$main::mycall^$id^" . $_[0]; - } - return $_[0]; -} - -sub mungepc91 -{ - unless ($_[1] =~ /^PC9\d/) { - my $id = nextpc90(); - return "PC91^$main::mycall^$id^$_[0]^" . $_[1]; - } - return $_[1]; -} - # # This is the normal pcxx despatcher # sub normal { my ($self, $line) = @_; + + if ($line =~ '^<\w+\s') { + DXXml::normal($self, $line); + return; + } + my @field = split /\^/, $line; return unless @field; @@ -380,68 +360,7 @@ sub normal return; } - # handle PC90 frames in a special way. - # - # PC90 frames are normal frames that that are wrapped in inside a PC90 - # The extra fields are "originating node" and a sequence number. - # The sequence number is checked against the nodes 'last one' to see if - # it is a duplicate and, if so, is dropped at this stage; before any - # other processing. - # - # This is done here simply for efficiency. Adding another function would - # add more copying and so on. - # - my $origin = $self->{call}; - - if ($pcno >= 90) { - $origin = $field[1]; - if ($origin eq $main::mycall) { - dbg("PCPROT: loop dupe") if isdbg('chanerr'); - return; - } - $self->user->wantpc90(1) unless $self->user->wantpc90 || $origin ne $self->{call}; - my $seq = $field[2]; - my $node = Route::Node::get($origin); - if ($node) { - if (my $lid = $node->lid) { - my $cmp = $seq >= $lid ? $seq : $seq + 9999; - if ($cmp <= $lid) { - dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr'); - return; - } - } - $node->lid($seq); - } - - # do a recheck on the contents of the PC90 - if ($pcno >= 90) { - shift @field; - shift @field; - shift @field; - $origin = shift @field if $pcno == 91; - - ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number - unless (defined $pcno && $pcno >= 10 && $pcno <= 89) { - dbg("PCPROT: unknown protocol") if isdbg('chanerr'); - return; - } - - # check for and dump bad protocol messages - my $n = check($pcno, @field); - if ($n) { - dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr'); - return; - } - } - } else { - if ($pcno == 16 || $pcno == 17 || $pcno == 19 || $pcno == 21) { - $line = mungepc91($origin, $line); - } else { - $line = mungepc90($line); - } - } - no strict 'subs'; my $sub = "handle_$pcno"; @@ -504,9 +423,13 @@ sub handle_10 } } + # remember a route to this node and also the node on which this user is + RouteDB::update($_[6], $self->{call}); +# RouteDB::update($to, $_[6]); + # it is here and logged on - $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall; - $dxchan = DXChannel->get($to) unless $dxchan; + $dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall; + $dxchan = DXChannel::get($to) unless $dxchan; if ($dxchan && $dxchan->is_user) { $_[3] =~ s/\%5E/^/g; $dxchan->talk($from, $to, $via, $_[3]); @@ -524,6 +447,8 @@ sub handle_10 return; } + # can we see an interface to send it down? + # not visible here, send a message of condolence $vref = undef; $ref = Route::get($from); @@ -552,6 +477,18 @@ sub handle_11 # rsfp check # return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]); + + # is the spotted callsign blank? This should really be trapped earlier but it + # could break other protocol sentences. Also check for lower case characters. + if ($_[2] =~ /^\s*$/) { + dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr'); + return; + } + if ($_[2] =~ /[a-z]/) { + dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr'); + return; + } + # if this is a 'nodx' node then ignore it if ($badnode->in($_[7])) { @@ -596,8 +533,11 @@ sub handle_11 } } - - my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]); + # remember a route +# RouteDB::update($_[7], $self->{call}); +# RouteDB::update($_[6], $_[7]); + + my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $nossid, $_[7]); # global spot filtering on INPUT if ($self->{inspotsfilter}) { my ($filter, $hops) = $self->{inspotsfilter}->it(@spot); @@ -610,7 +550,7 @@ sub handle_11 # 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($_[1], $_[2], $d, $_[5], $_[6])) { + if (Spot::dup(@spot[0..4,5])) { dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr'); return; } @@ -722,12 +662,17 @@ sub handle_12 return; } + my $dxchan; - if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){ + if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){ $self->send_chat($line, @_[1..6]); } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) { + # remember a route +# RouteDB::update($_[5], $self->{call}); +# RouteDB::update($_[1], $_[5]); + # ignore something that looks like a chat line coming in with sysop # flag - this is a kludge... if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') { @@ -764,17 +709,12 @@ sub handle_16 my $line = shift; my $origin = shift; - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } - # general checks my $dxchan; my $ncall = $_[1]; my $newline = "PC16^"; - # do I want users from this channel? + # dos I want users from this channel? unless ($self->user->wantpc16) { dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); return; @@ -784,6 +724,24 @@ sub handle_16 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; } + + RouteDB::update($ncall, $self->{call}); + + # do we believe this call? + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr'); + } + return; + } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + my $parent = Route::Node::get($ncall); # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, @@ -823,7 +781,7 @@ sub handle_16 } } $user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route - $user->lastin($main::systime) unless DXChannel->get($ncall); + $user->lastin($main::systime) unless DXChannel::get($ncall); $user->put; # route the pc19 - this will cause 'stuttering PC19s' for a while @@ -894,7 +852,7 @@ sub handle_16 $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->lastin($main::systime) unless DXChannel::get($call); $user->put; } $self->route_pc16($origin, $line, $parent, @rout) if @rout; @@ -923,33 +881,47 @@ sub handle_17 return; } + RouteDB::delete($ncall, $self->{call}); + + # do we believe this call? + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $ncall on $self->{call}") 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; + $dxchan = $parent->dxchan if $parent; 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); + # input filter if required and then remove user if present + if ($parent) { +# return unless $self->in_filter_route($parent); + $parent->del_user($uref) if $uref; + } else { + $parent = Route->new($ncall); # throw away + } if (eph_dup($line)) { dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); return; } + $uref = Route->new($ucall) unless $uref; # throw away $self->route_pc17($origin, $line, $parent, $uref); } @@ -973,6 +945,7 @@ sub handle_18 $self->user->put; $self->sort('S'); } + $self->{handle_xml}++ if $main::do_xml && $_[1] =~ /\bxml\b/; } else { $self->version(50.0); $self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/; @@ -998,13 +971,10 @@ sub handle_19 my $i; my $newline = "PC19^"; - if (eph_dup($line)) { - dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); - return; - } - # new routing list my @rout; + + # first get the INTERFACE node my $parent = Route::Node::get($self->{call}); unless ($parent) { dbg("DXPROT: my parent $self->{call} has disappeared"); @@ -1012,6 +982,26 @@ sub handle_19 return; } + # if the origin isn't the same as the INTERFACE, then reparent, creating nodes as necessary + if ($origin ne $self->call) { + my $op = Route::Node::get($origin); + unless ($op) { + $op = $parent->add($origin, 5000, Route::here(1)); + my $user = DXUser->get_current($origin); + if (!$user) { + $user = DXUser->new($origin); + $user->priv(1); # I have relented and defaulted nodes + $user->lockout(1); + $user->homenode($origin); + $user->node($origin); + $user->wantroutepc19(1); + } + $user->sort('A') unless $user->is_node; + $user->put; + } + $parent = $op; + } + # parse the PC19 for ($i = 1; $i < $#_-1; $i += 4) { my $here = $_[$i]; @@ -1029,7 +1019,7 @@ sub handle_19 next if $call eq $main::mycall; # check that this PC19 isn't trying to alter the wrong dxchan - my $dxchan = DXChannel->get($call); + 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; @@ -1039,12 +1029,35 @@ sub handle_19 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->sort('A') unless $user->is_node; + + RouteDB::update($call, $self->{call}); + + # do we believe this call? + my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; + unless ($call eq $self->{call} || $self->is_believed($call)) { + my $pt = $user->lastping($self->{call}) || 0; + if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) { + my $ivp = Investigate->new($call, $self->{call}); + $ivp->version($ver); + $ivp->here($here); + $ivp->store_pcxx($pcno,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]); + } else { + dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr'); + } + $user->put; + next; + } + + if (eph_dup($genline)) { + dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr'); + next; + } my $r = Route::Node::get($call); my $flags = Route::here($here)|Route::conf($conf); @@ -1088,7 +1101,7 @@ sub handle_19 my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - $user->lastin($main::systime) unless DXChannel->get($call); + $user->lastin($main::systime) unless DXChannel::get($call); $user->put; } @@ -1127,6 +1140,18 @@ sub handle_21 return; } + RouteDB::delete($call, $self->{call}); + + # check if we believe this + unless ($call eq $self->{call} || $self->is_believed($call)) { + if (my $ivp = Investigate::get($call, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } else { + dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr'); + } + return; + } + # check to see if we are in the pc19list, if we are then don't bother with any of # this routing table manipulation, just remove it from the list and dump it my @rout; @@ -1145,7 +1170,7 @@ sub handle_21 my $node = Route::Node::get($call); if ($node) { - my $dxchan = DXChannel->get($call); + 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; @@ -1193,7 +1218,10 @@ sub handle_23 } } - return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]); + # only do a rspf check on PC23 (not 27) + if ($pcno == 23) { + return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]) + } # do some de-duping my $d = cltounix($_[1], sprintf("%02d18Z", $_[2])); @@ -1206,13 +1234,24 @@ sub handle_23 dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr'); return; } - if (Geomag::dup($d,$sfi,$k,$i,$_[6])) { + + # global wwv filtering on INPUT + my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]); + if ($self->{inwwvfilter}) { + my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc); + unless ($filter) { + dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr'); + return; + } + } + $_[7] =~ s/-\d+$//o; # remove spotter's ssid + if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) { dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr'); return; } - $_[7] =~ s/-\d+$//o; # remove spotter's ssid - my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r); + # note this only takes the first one it gets + Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r); my $rep; eval { @@ -1349,7 +1388,13 @@ sub handle_37 my $pcno = shift; my $line = shift; my $origin = shift; - DXDb::process($self, $line); + if ($_[1] eq $main::mycall) { + no strict 'refs'; + my $sub = "DXDb::handle_$pcno"; + &$sub($self, @_); + } else { + $self->route($_[1], $line) unless $self->is_clx; + } } # node connected list from neighbour @@ -1483,6 +1528,9 @@ sub handle_50 my $origin = shift; my $call = $_[1]; + + RouteDB::update($call, $self->{call}); + my $node = Route::Node::get($call); if ($node) { return unless $node->call eq $self->{call}; @@ -1512,44 +1560,13 @@ sub handle_51 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 || $obscount; - 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 - } - } - } - } + DXXml::Ping::handle_ping_reply($self, $from); } } else { - if ($line !~ /^PC90/ && eph_dup($line)) { + + RouteDB::update($from, $self->{call}); + + if (eph_dup($line)) { dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); return; } @@ -1656,7 +1673,7 @@ sub handle_default sub process { my $t = time; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $pc50s; @@ -1668,7 +1685,8 @@ sub process } foreach $dxchan (@dxchan) { - next unless $dxchan->is_node(); + next unless $dxchan->is_node; + next if $dxchan->handle_xml; next if $dxchan == $main::me; # send the pc50 @@ -1679,18 +1697,23 @@ sub process if ($dxchan->{nopings} <= 0) { $dxchan->disconnect; } else { - addping($main::mycall, $dxchan->call); + DXXml::Ping::add($main::me, $dxchan->call); $dxchan->{nopings} -= 1; $dxchan->{lastping} = $t; + $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; } } } + Investigate::process(); + # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera eph_clean(); + import_chat(); + $last10 = $t; } @@ -1713,7 +1736,7 @@ sub send_dx_spot { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; # send it if it isn't the except list and isn't isolated and still has a hop count @@ -1764,22 +1787,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) { @@ -1788,7 +1799,7 @@ 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); } } @@ -1800,7 +1811,7 @@ sub wwv 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) @@ -1810,21 +1821,9 @@ 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 @@ -1832,7 +1831,7 @@ sub send_wcy_spot 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); } } @@ -1855,7 +1854,7 @@ sub send_announce { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $target; my $to = 'To '; @@ -1876,28 +1875,13 @@ sub send_announce # obtain country codes etc - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my ($ann_state, $org_state) = ("", ""); - my @dxcc = Prefix::extract($_[0]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq; - $ann_state = $dxcc[1]->state; - } - @dxcc = Prefix::extract($_[4]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - $org_state = $dxcc[1]->state; - } - + my @a = Prefix::cty_data($_[0]); + 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, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1916,7 +1900,8 @@ sub send_announce 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); + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, + @a[0..2], @b[0..2]); } } @@ -1934,7 +1919,7 @@ sub send_chat { my $self = shift; my $line = shift; - my @dxchan = DXChannel->get_all(); + my @dxchan = DXChannel::get_all(); my $dxchan; my $target = $_[3]; my $text = unpad($_[2]); @@ -1946,28 +1931,13 @@ sub send_chat } # obtain country codes etc - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my ($ann_state, $org_state) = ("", ""); - my @dxcc = Prefix::extract($_[0]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq; - $ann_state = $dxcc[1]->state; - } - @dxcc = Prefix::extract($_[4]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - $org_state = $dxcc[1]->state; - } - + my @a = Prefix::cty_data($_[0]); + 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, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1997,7 +1967,8 @@ sub send_chat } } - $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], + $text, @_, $self->{call}, @a[0..2], @b[0..2]); } } @@ -2037,7 +2008,7 @@ sub send_local_config # send our nodes if ($self->{isolate}) { @localnodes = ( $main::routeroot ); - $self->send_route(\&pc19, 1, $main::routeroot, $main::routeroot); + $self->send_route($main::mycall, \&pc19, 1, $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 @@ -2049,31 +2020,19 @@ sub send_local_config $self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes); my $node; - if ($self->user->wantpc90) { - for $node (@localnodes) { - my @nodes = map {my $r = Route::Node::get($_); $r ? $r : ()} $node->nodes; - $self->send_route($node->call, \&pc19, scalar(@nodes)+1, @nodes); - for my $r (@nodes) { - push @remotenodes, $r unless grep $r eq $_, @remotenodes; - } - } - } else { - my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; - my @intcalls; - for $node (@rawintcalls) { - push @intcalls, $node unless grep $node eq $_, @intcalls; - } - my $ref = Route::Node::get($self->{call}); - my @rnodes = $ref->nodes; - for $node (@intcalls) { - push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; - } - $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); + my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; + my @intcalls; + for $node (@rawintcalls) { + push @intcalls, $node unless grep $node eq $_, @intcalls; + } + my $ref = Route::Node::get($self->{call}); + my @rnodes = $ref->nodes; + for $node (@intcalls) { + push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; } + $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); } - - # get all the users connected on the above nodes and send them out foreach $node ($main::routeroot, @localnodes, @remotenodes) { if ($node) { @@ -2090,6 +2049,7 @@ sub send_local_config # # is called route(to, pcline); # + sub route { my ($self, $call, $line) = @_; @@ -2100,8 +2060,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) { @@ -2109,8 +2071,23 @@ 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'); } } + + # try the backstop method + unless ($dxchan) { + my $rcall = RouteDB::get($call); + if ($rcall) { + if ($self && $rcall eq $self->{call}) { + dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); + return; + } + $dxchan = DXChannel::get($rcall); + dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan; + } + } + if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { @@ -2178,20 +2155,6 @@ sub load_hops return (); } - -# 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; -} - sub process_rcmd { my ($self, $tonode, $fromnode, $user, $cmd) = @_; @@ -2230,13 +2193,13 @@ 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 { @@ -2314,6 +2277,8 @@ sub disconnect eph_del_regex("^PC1[679].*$c"); } } + + RouteDB::delete_interface($call); # remove them from the pc19list as well while (my ($k,$v) = each %pc19list) { @@ -2406,7 +2371,6 @@ sub send_route next unless $routeit; } - $routeit = mungepc91($origin, $routeit) if $self->user->wantpc90; $self->send($routeit); } } @@ -2428,11 +2392,7 @@ sub broadcast_route next unless $dxchan->isa('DXProt'); next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; - if ($self->user->wantpc90 && $line) { - $dxchan->send(mungepc91($origin, $line)); - } else { - $dxchan->send_route($origin, $generate, @_); - } + $dxchan->send_route($origin, $generate, @_); } } } @@ -2516,9 +2476,9 @@ sub eph_dup # chop the end off $s =~ s/\^H\d\d?\^?\~?$//; - removepc90($s); $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; } @@ -2559,5 +2519,69 @@ 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') { + my $sysopflag = $target eq 'SYSOP' ? '*' : ' '; + if ($target ne 'LOCAL') { + send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0'); + } else { + Log('ann', 'LOCAL', $main::mycall, $text); + DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all()); + } + } else { + my $msgid = nextchatmsgid(); + $text = "#$msgid $text"; + send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0'); + } + } + } +} + 1; __END__