From: Dirk Koopman Date: Thu, 13 Mar 2025 14:13:15 +0000 (+0000) Subject: do work on Spot deduping and rate limiting X-Git-Url: http://dxspider.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=6d13c3f5114633479481582829568c6a96efac90;p=spider.git do work on Spot deduping and rate limiting --- diff --git a/Changes b/Changes index 9b276931..0938cc57 100644 --- 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 00ceca4e..24a21adb 100644 --- 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 680c66dd..33d8b963 100644 --- 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 d5cb1607..8d5d66dc 100644 --- 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 61418d00..414139dd 100644 --- 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 ba0e1596..2e0ca981 100644 --- 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 27042ec9..52783ebe 100644 --- 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 1364c70a..167e97df 100644 --- 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 b01bafb0..b3a29eda 100644 --- 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 a4c831aa..ac4d652d 100755 --- 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