From 72568e838d146250a78fea19bd4bbafc760e6a49 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 13 Sep 2001 14:09:00 +0000 Subject: [PATCH] 1. did some work on making talk more intelligent and fixed a>b problem. 2. fixed a nasty problem on input when being hit with full buffers of data (eg at init time with large lists of node/users on fast links). 3. fixed realtime input filter changing. 4. added announce->talk conversion for routable calls when announces of the form 'to g1tlh hello' or 'g1tlh hello' appear. This also suppresses similar announces for users whose callsign is not the one in the announce. --- Changes | 8 ++++ perl/DXCommandmode.pm | 9 +++- perl/DXProt.pm | 106 ++++++++++++++++++++++++++---------------- perl/DXProtout.pm | 5 +- perl/ExtMsg.pm | 2 +- perl/Filter.pm | 5 +- perl/Messages | 1 + perl/Spot.pm | 4 +- 8 files changed, 92 insertions(+), 48 deletions(-) diff --git a/Changes b/Changes index a2b0354d..07129219 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +13Sep01======================================================================= +1. did some work on making talk more intelligent and fixed a>b problem. +2. fixed a nasty problem on input when being hit with full buffers of +data (eg at init time with large lists of node/users on fast links). +3. fixed realtime input filter changing. +4. added announce->talk conversion for routable calls when announces of the +form 'to g1tlh hello' or 'g1tlh hello' appear. This also suppresses similar +announces for users whose callsign is not the one in the announce. 11Sep01======================================================================= 1. added IP address logging of connections 10Sep01======================================================================= diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 5e6c7226..18367bdf 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -32,7 +32,7 @@ use Sun; use Internet; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $suppress_ann_to_talk); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -40,6 +40,8 @@ $errstr = (); # error string from eval %aliases = (); # aliases for (parts of) commands $scriptbase = "$main::root/scripts"; # the place where all users start scripts go $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection +$suppress_ann_to_talk = 1; # don't announce 'to ' or ' ' type announcements + use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -703,6 +705,11 @@ sub announce my $text = shift; my ($filter, $hops); + if ($suppress_ann_to_talk) { + my ($to, $call) = $text =~ /^\s*([\w-]+)[\s:]+([\w-]+)/; + return if ($to && $call && ((uc $to eq 'TO' && is_callsign(uc $call)) || is_callsign($call = uc $to))); + } + if ($self->{annfilter}) { ($filter, $hops) = $self->{annfilter}->it(@_ ); return unless $filter; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e78d9a7a..ca6e4728 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -42,7 +42,7 @@ $main::build += $VERSION; $main::branch += $BRANCH; use vars qw($me $pc11_max_age $pc23_max_age $last_pc50 - $last_hour $last10 %eph %pings %rcmds + $last_hour $last10 %eph %pings %rcmds $ann_to_talk %nodehops $baddx $badspotter $badnode $censorpc $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -60,6 +60,7 @@ $baddx = new DXHash "baddx"; $badspotter = new DXHash "badspotter"; $badnode = new DXHash "badnode"; $last10 = $last_pc50 = time; +$ann_to_talk = 1; @checklist = ( @@ -322,18 +323,39 @@ sub normal # is it for me or one of mine? my ($to, $via, $call, $dxchan); if ($field[5] gt ' ') { - $call = $via = $field[2]; + $via = $field[2]; $to = $field[5]; } else { - $call = $to = $field[2]; + $to = $field[2]; } - $dxchan = DXChannel->get($main::myalias) if $call eq $main::mycall; - $dxchan = DXChannel->get($call) unless $dxchan; + + # 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($field[1], $to, $via, $field[3]); - } else { - $self->route($field[2], $line); # relay it on its way + 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($field[1], $to, $vref ? $via : undef, $field[3], $field[6]); + return; + } + + # not visible here, send a message of condolence + $vref = undef; + $ref = Route::get($field[1]); + $vref = $ref = Route::Node::get($field[6]) unless $ref; + if ($ref) { + $dxchan = $ref->dxchan; + $dxchan->talk($main::mycall, $field[1], $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); } return; } @@ -491,38 +513,30 @@ sub normal return; } } - + if ($field[2] eq '*' || $field[2] eq $main::mycall) { - - # global ann filtering on INPUT - if ($self->{inannfilter}) { - my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($field[1]); - if (@dxcc > 0) { - $ann_dxcc = $dxcc[1]->dxcc; - $ann_itu = $dxcc[1]->itu; - $ann_cq = $dxcc[1]->cq(); - } - @dxcc = Prefix::extract($field[5]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq(); - } - my ($filter, $hops) = $self->{inannfilter}->it(@field[1..6], $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); - unless ($filter) { - dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); - return; + + + # 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 ($to, $call) = $field[3] =~ /^\s*([\w-]+)[\s:]+([\w-]+)/; + if ($to && $call) { + if ((uc $to eq 'TO' && is_callsign(uc $call)) || is_callsign($call = uc $to)) { + my $ref = Route::get($call); + if ($ref) { + $ref->dxchan->talk($field[1], $call, undef, $field[3], $field[5]); + return; + } + } } } - + # send it $self->send_announce($line, @field[1..6]); } else { $self->route($field[2], $line); } - return; } @@ -1260,13 +1274,13 @@ sub send_wwv_spot 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($_[7]); + 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($_[8]); + @dxcc = Prefix::extract($_[7]); if (@dxcc > 0) { $org_dxcc = $dxcc[1]->dxcc; $org_itu = $dxcc[1]->itu; @@ -1307,13 +1321,13 @@ sub send_wcy_spot 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($_[11]); + 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($_[12]); + @dxcc = Prefix::extract($_[11]); if (@dxcc > 0) { $org_dxcc = $dxcc[1]->dxcc; $org_itu = $dxcc[1]->itu; @@ -1367,8 +1381,7 @@ sub send_announce $to = ''; } $target = "ALL" if !$target; - - Log('ann', $target, $_[0], $text); + # obtain country codes etc my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); @@ -1385,6 +1398,19 @@ sub send_announce $org_cq = $dxcc[1]->cq; } + if ($self->{inannfilter}) { + my ($filter, $hops) = + $self->{inannfilter}->it(@_, $self->{call}, + $ann_dxcc, $ann_itu, $ann_cq, + $org_dxcc, $org_itu, $org_cq); + unless ($filter) { + dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); + return; + } + } + + Log('ann', $target, $_[0], $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) { @@ -1792,11 +1818,11 @@ sub disconnect # sub talk { - my ($self, $from, $to, $via, $line) = @_; + my ($self, $from, $to, $via, $line, $origin) = @_; $line =~ s/\^/\\5E/g; # remove any ^ characters - $self->send(DXProt::pc10($from, $to, $via, $line)); - Log('talk', $self->call, $from, $via?$via:$main::mycall, $line); + $self->send(DXProt::pc10($from, $to, $via, $line, $origin)); + Log('talk', $self->call, $from, $via?$via:$main::mycall, $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 diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 8edc0831..a2b69a67 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -32,7 +32,7 @@ $main::branch += $BRANCH; # create a talk string ($from, $to, $via, $text) sub pc10 { - my ($from, $to, $via, $text) = @_; + my ($from, $to, $via, $text, $origin) = @_; my ($user1, $user2); if ($via && $via ne $to) { $user1 = $via; @@ -41,10 +41,11 @@ sub pc10 $user2 = ' '; $user1 = $to; } + $origin ||= $main::mycall; $text = unpad($text); $text = ' ' unless $text && length $text > 0; $text =~ s/\^/%5E/g; - return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; + return "PC10^$from^$user1^$text^*^$user2^$origin^~"; } # create a dx message (call, freq, dxcall, text) diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 14660416..ae0e218b 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -83,7 +83,7 @@ sub dequeue if ($conn->{msg} =~ /\cJ$/) { delete $conn->{msg}; } else { - $conn->{msg} = pop @lines; + $conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g; } while (defined ($msg = shift @lines)) { dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect'); diff --git a/perl/Filter.pm b/perl/Filter.pm index fdc06d1a..2c32bf02 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -226,7 +226,7 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { - my $args = join '\',\'', @_; + my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @_; my $true = $r ? "OK " : "REJ"; my $sort = $self->{sort}; my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; @@ -310,8 +310,9 @@ sub install } foreach $dxchan (@dxchan) { my $n = "$in$sort" . "filter"; + my $i = $in ? 'IN_' : ''; my $ref = $dxchan->$n(); - if (!$ref || ($ref && uc $ref->{name} eq "$name.PL")) { + if (!$ref || ($ref && uc $ref->{name} eq "$i$name.PL")) { $dxchan->$n($remove ? undef : $self); } } diff --git a/perl/Messages b/perl/Messages index 69db5386..d762e7e9 100644 --- a/perl/Messages +++ b/perl/Messages @@ -242,6 +242,7 @@ package DXM; talku => 'Talk flag unset on $_[0]', talkend => 'Finished talking to you', talkinst => 'Entering Talkmode, /EX to end, / to run a command', + talknh => 'Sorry $_[0] is not online at the moment', talkprompt => 'Talk ($_[0])>', talkstart => 'Starting talking to you', usernf => '*** User record for $_[0] not found ***', diff --git a/perl/Spot.pm b/perl/Spot.pm index 06bf8655..ae773e12 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -123,12 +123,12 @@ sub prepare # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call my @dxcc = Prefix::extract($out[1]); - my $spotted_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0; + my $spotted_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 666; my $spotted_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0; my $spotted_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0; push @out, $spotted_dxcc; @dxcc = Prefix::extract($out[4]); - my $spotter_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 0; + my $spotter_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 666; my $spotter_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0; my $spotter_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0; push @out, $spotter_dxcc; -- 2.43.0