1. did some work on making talk more intelligent and fixed a>b problem.
authorminima <minima>
Thu, 13 Sep 2001 14:09:00 +0000 (14:09 +0000)
committerminima <minima>
Thu, 13 Sep 2001 14:09:00 +0000 (14:09 +0000)
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
perl/DXCommandmode.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/ExtMsg.pm
perl/Filter.pm
perl/Messages
perl/Spot.pm

diff --git a/Changes b/Changes
index a2b0354dcc368c85f0742f5f5fd09efae7d0dfd1..071292191a6e9c305825b0fd3a1184372c72d0ea 100644 (file)
--- 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=======================================================================
index 5e6c722646867868d7eb47171fc0fbdab6ab9fb5..18367bdfa76982c2b207cdc27b77b5bf1f75ba83 100644 (file)
@@ -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 <call> ' or '<call> ' 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;
index e78d9a7a20fb0e2f2afe27e671e2cae00c430954..ca6e4728466d2febcb7f12639235f38c30373632 100644 (file)
@@ -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 <call>' 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
index 8edc0831eb327df41a1f81ea1655953b48142dee..a2b69a67a9f4dfbba796dfaa5c17e7dde67aa184 100644 (file)
@@ -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) 
index 146604169096a658270ec2e2681024f04911c00e..ae0e218b25c8575a73b71efeb0d4ed2cffbd3a56 100644 (file)
@@ -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');
index fdc06d1ae87454d3f9a81772fd403c6c80e82c7e..2c32bf025981465e9ae9b8f374fddeb2fa53527c 100644 (file)
@@ -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);
                }
        }
index 69db53864cfc465bffaf0658e31d7f4d0e91aa08..d762e7e9516e6917cbec7a8b4c0c38af459b7ab3 100644 (file)
@@ -242,6 +242,7 @@ package DXM;
                                talku => 'Talk flag unset on $_[0]',
                                talkend => 'Finished talking to you',
                                talkinst => 'Entering Talkmode, /EX to end, /<cmd> 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 ***',
index 06bf86557b5763d4637a4f93302190897c51a1af..ae773e12f53cd5dfc34c1574603e28ba452e52c5 100644 (file)
@@ -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;