do work on Spot deduping and rate limiting

diff --git a/Changes b/Changes
index 9b276931f2966b60b051b6edc6e076e4ab4676cf..0938cc577442dc9d510708f47909d5404b4ace1a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+12Mar25======================================================================
+1. Add some spot rate limiting.
+2. Remove some obsolete spot deduping options that have not effectively been
+   changed in several years and simplify the code to just use my preferred
+   options. 
 19Feb25======================================================================
 1. Make sure that the routing table has a number of users as well as a last
    PC92 C records. This will prevent some of the false negatives (just not

diff --git a/cmd/dx.pl b/cmd/dx.pl
index 00ceca4eae94f000c312589a58209903aac50baa..24a21adb0c10d049f67b85e2c1755868cc948e8f 100644 (file)
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -155,7 +155,7 @@ return (1, @out) unless $valid;
 
 # Store it here (but only if it isn't baddx)
 my $t = (int ($main::systime/60)) * 60;
-return (1, $self->msg('dup')) if Spot::dup_find($freq, $spotted, $t, $line, $spotter, $main::mycall);
+#return (1, $self->msg('dup')) if Spot::dup_find($freq, $spotted, $t, $line, $spotter, $main::mycall);
 my @spot = Spot::prepare($freq, $spotted, $t, $line, $spotter, $main::mycall, $ipaddr);
 
 #$DB::single = 1;
@@ -180,14 +180,14 @@ if ($freq =~ /^69/ || $localonly) {
        } else {
                # store in spots database 
                unless (Spot::dup_find(@spot)) {
-                       Spot::dup_add(0, @spot);
-                       Spot::add(@spot);
-                       $self->dx_spot(undef, undef, @spot);
+                       Spot::add_local(@spot);
                        DXProt::send_dx_spot($self, $spot, @spot);
                } else {
-                       push @out, "Duplicate spot: $line";
+#                      push @out, "Duplicate spot: $line";
                        LogDbg("DXCommand", "Spot dupe from $spotter: $line");
-               } 
+               }
+               # put this here so that the spotter does not know that it is a dupe or not
+               $self->dx_spot(undef, undef, @spot);
        }
 }
 

diff --git a/perl/DXCIDR.pm b/perl/DXCIDR.pm
index 680c66ddaa6fd29138d78143dfb5d46203059feb..33d8b9637d9a81efb8e0e362abfda699982454d1 100644 (file)
--- a/perl/DXCIDR.pm
+++ b/perl/DXCIDR.pm
@@ -128,8 +128,8 @@ sub add
        for my $ip (@_) {
                # protect against stupid or malicious
                next unless is_ipaddr($ip);
-               next if $ip =~ /^127\./;
-               next if $ip =~ /^::1$/;
+#              next if $ip =~ /^127\./;
+#              next if $ip =~ /^::1$/;
 #              next if find($ip);
                if ($ip =~ /\./) {
                        eval {$ipv4->add_any($ip)};
@@ -200,8 +200,8 @@ sub list
 {
        return () unless $active;
        my @out;
-       push @out, $ipv4->list if $count4;
-       push @out, $ipv6->list if $count6;
+       push @out, $ipv4->list, $ipv4->list_range if $count4;
+       push @out, $ipv6->list, $ipv6->list_range if $count6;
        return _sort(@out);
 }
 

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index d5cb1607d47cd07a520f624539410ec12b86c2e1..8d5d66dc5914f2143b423321f8e64c52464cfdc9 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -621,7 +621,7 @@ sub process
                        foreach my $ref (@{$dxchan->{sluggedpcs}}) {
                                if ($ref->[0] == 61) {
                                        unless (Spot::dup_find(@{$ref->[2]})) {
-                                               Spot::dup_add(@{$ref->[2]});
+                                               Spot::dup_new(@{$ref->[2]});
                                                DXProt::send_dx_spot($dxchan, $ref->[1], @{$ref->[2]});
                                        } else {
                                                dbg("DXCommand: process slugged spot $ref->[1] is a dupe, ignored" );

diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm
index 61418d003e2f4567a7ba3a5705b2dea4a5801e51..414139dd774e7eb35c34efe0a8ee427254156c08 100644 (file)
--- a/perl/DXDupe.pm
+++ b/perl/DXDupe.pm
@@ -58,7 +58,7 @@ sub add
        return unless $s;
 
        $d{$s} = $t;
-       dbg("DXDupe::add key: $s time: " . ztime($t)) if isdbg('dxdupe');
+       dbg("DXDupe::add key: $s time: " . htime($t)) if isdbg('dxdupe');
 }
 
 sub del
@@ -67,11 +67,11 @@ sub del
        return unless $s;
        
        my $t = $d{$s};
-       dbg("DXDupe::del key: $s time: " . ztime($t)) if isdbg('dxdupe');
+       dbg("DXDupe::del key: $s time: " . htime($t)) if isdbg('dxdupe');
        delete $d{$s};
 }
 
-sub per_minute
+sub clean
 {
        my @del;
        my $count = 0;
@@ -86,13 +86,13 @@ sub per_minute
                }
                ++$count;
                if (isdbg("dxdupeclean")) {
-                       dbg("DXDupe::per_minute key:$flag$left") if isdbg('dxdupeclean');
+                       dbg("DXDupe::clean key:$flag$left") if isdbg('dxdupeclean');
                }
        }
        for (@del) {
                del($_);
        }
-       dbg("DXDupe::per_minute number of records " . scalar keys %d) if isdbg('dxdupe');
+       dbg("DXDupe::clean number of records " . scalar keys %d) if isdbg('dxdupe');
        $lasttime = $main::systime;
 }
 

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ba0e15963833dbd16bc58c8901052c91f353ea9c..2e0ca9815611ab51586eb17a958ee2f038da3693 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -395,7 +395,7 @@ sub start
 sub sendinit
 {
        my $self = shift;
-       $self->send(pc18(($self->{isolate} || !$self->user->wantpc9x) ? "" : " pc9x"));
+       $self->send(pc18(($self->{isolate} || !$self->user->wantpc9x) ? "" : " pc9x 91"));
 }
 
 #

diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index 27042ec921d3146e31591388422d210fc3302e1e..52783ebe4acb38742490f77214dfbb52694774ff 100644 (file)
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -409,7 +409,7 @@ sub handle_11
        #
        #
        
-       if (Spot::dup_add(0, @spot[0..4,7])) {
+       if (Spot::dup_find(@spot[0..4,7])) {
                dbg("PCPROT: Duplicate Spot  $self->{call}: $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot') || isdbg('pc11');
                return;
        }
@@ -449,10 +449,10 @@ sub handle_11
        }
        
        #
-       # Now finally: save the spot itself and send it on its merry way to the users
+       # Now finally: save the spot itself and then send it on its merry way to the users
        #
-       
-       Spot::add(@spot);
+
+       Spot::add_local(@spot);
 
        my $ip = '';
        $ip ||= $spot[14] if exists $spot[14];
@@ -973,8 +973,9 @@ sub handle_18
                } elsif (!$self->user->wantpc9x) {
                        dbg("PC18 $self->{call} pc9x explicitly switched off, using old protocol");
                } else {
+                       $self->{pc91} = $pc->[1] =~ /\b91/;
                        $self->{do_pc9x} = 1;
-                       dbg("PC18 $self->{call} Set do PC9x");
+                       dbg("PC18 $self->{call} Set do " . $self->{pc91} ? "PC9[123]" : "PC9[23]");
                }
        }
 

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 1364c70ad16535a44e100f186fe0277b27a21cf1..167e97df10cd44842f1da984edb056ce0f7efcaa 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -28,7 +28,7 @@ require Exporter;
                         is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
                         is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv
                         diffms _diffms _diffus difft parraydifft is_ztime basecall
-                        normalise_call is_numeric
+                        normalise_call is_numeric htime
             );
 
 
@@ -73,6 +73,16 @@ sub atime
        return $buf;
 }
 
+sub htime
+{
+       my $t = shift;
+       $t = defined $t ? $t : time;
+       my $dst = shift;
+       my ($sec,$min,$hour) = $dst ? localtime($t): gmtime($t);
+       my $buf = sprintf "%02d:%02d:%02d%s", $hour, $min, $sec, ($dst) ? '' : 'Z';
+       return $buf;
+}
+
 # get a zulu time in cluster format (2300Z)
 sub ztime
 {
@@ -596,7 +606,7 @@ sub difft
                        $t = $adds - $b;
                        $adds = shift;
                } else {
-                       $t = $main::systime - $b;
+                       $t = time - $b;
                }
        }
        return '-(ve)' if $t < 0;

diff --git a/perl/Spot.pm b/perl/Spot.pm
index b01bafb0fc576648b98b89de24ceaa32787c5316..b3a29edadf0e475700fbcffad805b9e851b01e1c 100644 (file)
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -76,8 +76,9 @@ our $minselfspotqrg = 1240000;        # minimum freq above which self spotting is allow
 our $readback = $main::is_win ? 0 : 1; # don't read spot files backwards if it's windows
 our $qrggranularity = 1;       # normalise the qrg to this number of khz (default: 25khz), so tough luck if you have a fumble fingers moment
 our $timegranularity = 600;            # ditto to the nearest 100 seconds 
-our $oldstyle = 0;                             # revert to traditional dupe key format
-our $no_node_in_dupe = 1;              # remove the node field from dupe considerations. 
+our $dupebycall = 11*60+5;         # check that call is not spotted by the same callsign too often - this the interval that each (base) call by pair can recur
+our $store_otext = 0;                  # also store the original rather than "normalised" text/info field - now obsolescent
+
 
 if ($readback) {
        $readback = `which tac`;
@@ -258,9 +259,12 @@ sub prepare
        return @out;
 }
 
-sub add
+sub add_local
 {
        my $buf = join('^', @_);
+
+       dup_new(@_);
+
        $fp->writeunix($_[2], $buf);
        if ($spotcachedays > 0) {
                my $now = Julian::Day->new($_[2]);
@@ -421,7 +425,7 @@ sub search
                                last if $count >= $to; # stop after to
                        }
                }
-       }
+7      }
        return ("Spot search error", $@) if $@;
 
        @out = sort {$b->[2] <=> $a->[2]} @out if @out;
@@ -481,7 +485,7 @@ sub dup_add
 {
        my ($just_find, $freq, $call, $d, $text, $by, $node) = @_;
 
-       dbg("Spot::dup: freq=$freq call=$call d=$d text='$text' by=$by node=$node" . ($just_find ? " jf=$just_find" : "")) if isdbg('spotdup');
+       dbg("Spot::add_dup: freq=$freq call=$call d=$d text='$text' by=$by node=$node" . ($just_find ? " JF" : "")) if isdbg('spotdup');
 
        # dump if too old
        return 2 if $d < $main::systime - $dupage;
@@ -492,9 +496,7 @@ sub dup_add
 
        my $nd = nearest($timegranularity, $d);
 
-       # remove SSID or area
-       $by =~ s|[-/]\d+$||;
-       
+
        $freq = sprintf "%.1f", $freq;       # normalise frequency
 #      $freq = int $freq;       # normalise frequency
 
@@ -502,7 +504,14 @@ sub dup_add
        
        $call = substr($call, 0, $maxcalllth) if length $call > $maxcalllth;
 
-       my $dtext ;
+       # remove SSID or area on call, by and node
+       $call = basecall($call);
+       $by = basecall($by);
+       $node = basecall($node);
+
+       my $t = 0;
+       my $ldupkey;
+       my $dtext;
        
        my $l = length $text;
        $dtext = qq{original:'$text'($l)} if isdbg('spottext');
@@ -511,6 +520,7 @@ sub dup_add
        
        $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
        $text = uc unpad($text);
+       $text =~ s/^\s*\d{1,2}[-+.:]\d\d\s+//; # remove anything that looks like a time from the front
 
        $l = length $text;
        $dtext .= qq{->afterhex: '$text'($l)} if isdbg('spottext');
@@ -531,36 +541,57 @@ sub dup_add
        $l = length $text;
        $dtext .= qq{->final:'$text'($l)} if isdbg('spottext');
 
-       my $t = 0;
-       my $ldupkey;
-
-       # new feature: don't include the origin node in Spot dupes
-       # default = true
-       $node = '' if $no_node_in_dupe;
-       $ldupkey = $oldstyle ? "X$call|$by|$freq|$nd|$node|$text" : "X$call|$by|$qrg|$nd|$node|$text";
-       
+       # new feature: don't include the origin node in Spot dupes and use normalised qrg, rather than raw freq
+       # $text = normalised text
+       $ldupkey = "X$call|$by|$qrg|$text";
        $t = DXDupe::find($ldupkey);
-       dbg("Spot::dup ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup');
+       dbg("Spot::add_dup ldupkey $ldupkey" . ($t?(' DUPE=>'.htime($t)) :' NEW')) if isdbg('spotdup');
        $dtext .= ' DUPE' if $t;
        dbg("text transforms: $dtext") if length $text && isdbg('spottext');
-       return 1 if $t > 0;     
-       
+
+       # re-add it to kick the timer down the road. REMEMBER: dupes are in a tied hash so
+       # this is effectively an update
+       if ($t > 0) {
+#              DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+               return 1;       
+       }
        DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+
+       # $otext = slightly edited original text
+       if ($store_otext) {
+               $otext = substr($otext, 0, $duplth) if length $otext > $duplth; 
+               $otext =~ s/\s+$//;
+               if (length $otext && $otext ne $text) {
+                       $ldupkey = "X$call|$by|$qrg|$otext";
+                       $t = DXDupe::find($ldupkey);
+                       dbg("Spot::add_dup (OTEXT) ldupkey $ldupkey". ($t?(' (DUPE=>'.htime($t)) :' NEW')) if isdbg('spotdup');
+                       if (isdbg('spottext')) {
+                               $dtext .= sprintf q{ DUBIOUS '%s'}, join '', @dubious if @dubious;
+                               $dtext .= ' DUPE (OTEXT)' if $t;
+                               dbg("text transforms: $dtext") if length $text;
+                       }
+                       # see above
+                       if ($t > 0) {
+#                              DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+                               return 1;       
+                       }
+                       DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+               }
+       }
        
-       $otext = substr($otext, 0, $duplth) if length $otext > $duplth; 
-       $otext =~ s/\s+$//;
-       if (length $otext && $otext ne $text) {
-               $ldupkey = $oldstyle ? "X$call|$by|$freq|$otext" : "X$call|$by|$qrg|$nd|$otext";
+       if ($dupebycall) {
+           $ldupkey = "X$by|$call";
                $t = DXDupe::find($ldupkey);
-               dbg("Spot::dup (OTEXT) ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup');
-               if (isdbg('spottext')) {
-                       $dtext .= sprintf q{ DUBIOUS '%s'}, join '', @dubious if @dubious;
-                       $dtext .= ' DUPE (OTEXT)' if $t;
-                       dbg("text transforms: $dtext") if length $text;
+               dbg("Spot::add_dup by call $ldupkey" . ($t?(' DUPE=>'.htime($t)) :' NEW')) if isdbg('spotdup');
+               # see above 
+               if ($t > 0) {
+#                      DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+                       return 1;       
                }
-               return 1 if $t > 0;
-               DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find;
+
+               DXDupe::add($ldupkey, $main::systime+$dupebycall) unless $just_find;
        }
+       
        return undef;
 }
 
@@ -569,6 +600,11 @@ sub dup_find
        return dup_add(1, @_);
 }
 
+sub dup_new
+{
+       return dup_add(0, @_);
+}
+
 sub listdups
 {
        return DXDupe::listdups('X', $dupage, @_);

diff --git a/perl/cluster.pl b/perl/cluster.pl
index a4c831aa1293bdf7f6cce6c361e40cb8239d8feb..ac4d652d0f4db5fe9d192fafb800972013530679 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -884,13 +884,12 @@ sub per_sec
 
 sub per_10_sec
 {
-
+       DXDupe::clean();
 }
 
 sub per_minute
 {
        RBN::per_minute();
-       DXDupe::per_minute();
 }
 
 sub per_10_minute