From 4c3cc05e14f37272ed4f305ee05d6ce5834451a7 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 28 Jan 2025 14:35:46 +0000 Subject: [PATCH] Fix duping, ccluster pc18s, watchdbg Also prevent informational sentences (like PC11/61 etc) being accepted from nodes that have not yet properly initialised. --- Changes | 32 ++++++++++++++++++++++++++++++++ perl/DXDupe.pm | 21 ++++++++++++++++++--- perl/DXProtHandle.pm | 38 +++++++++++++++++++++++++++++++++++++- perl/Route.pm | 1 + perl/Spot.pm | 6 +++--- perl/watchdbg | 2 +- 6 files changed, 92 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index 91319982..d0b453d1 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,35 @@ +27Jan25====================================================================== +1. Make SURE that spot dupe checks do not add yet more dupe (dupe) records + to the dupe file. +2. Fix the retention of dupe records (of whatever sort) long after they have + expired. Also move the dupe cleaning process to once a minute for all + dupe records. This has been a veeeeerrrrry long standing bug. + + Thank you to those that pointed out both this and the previous item. + + P.S. If you enjoy watching paint dry then you can see this in action by + entering 'set/debug dxdupe' on a console and running 'watchdbg dxdupe' in + another shell window. + +3. Set a new default dupe expiry time ($DXDupe::default = 3600+120). This may + change (back upwards). NOTE: this is a default for all dupe storage that + does not explicitly set one (thing like announces etc). Specifically: + Spots have their own default ($Spot::dupage). + + NOTE: Spots have a hard limit that prevents exactly repeating spots being + emitted faster than one minute. + +4. Add an attempt to stop incoming CCCLuster connections from creating + protocol loops by ignoring any PC18s that they send. +5. Try to fix watchdbg so that it works on the latest debian/ubuntu text + io routines. +6. Check that a node channel is fully initialised (meaning that the full + node startup chitchat is completed) before allowing informational + sentences like (PC11, PC10, PC12, PC61, PC93 etc) to be transferred. + + It turns out that it was possible to connect to a node with a node + callsign and send things like PC11 / PC61 without being "visible" in the + network as a whole. It would just be visible locally. 17Jun24====================================================================== 1. Reduce the default spot dupe qrg granularity to 25Khz. 14Jun24====================================================================== diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index c5b4b2a0..61418d00 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -13,7 +13,7 @@ use DXDebug; use DXUtil; use DXVars; -use vars qw{$lasttime $dbm %d $default $fn}; +use vars qw{$dbm %d $default $fn}; $default = 2*24*60*60; $lasttime = 0; @@ -74,10 +74,25 @@ sub del sub per_minute { my @del; + my $count = 0; while (($k, $v) = each %d) { - push @del, $k if $main::systime >= $v; + my $flag = ''; + my $left = $v - $main::systime; + if ($left <= 0) { + push @del, $k; + $flag = " $k (deleted secs left: $left v: $v systime: $main::systime)"; + } else { + $left = " $k time left: $left v: $v systime: $main::systime"; + } + ++$count; + if (isdbg("dxdupeclean")) { + dbg("DXDupe::per_minute key:$flag$left") if isdbg('dxdupeclean'); + } } - del($k) for @del; + for (@del) { + del($_); + } + dbg("DXDupe::per_minute number of records " . scalar keys %d) if isdbg('dxdupe'); $lasttime = $main::systime; } diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 868723fc..766819dc 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -94,6 +94,11 @@ sub handle_10 return; } + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } + # is it for me or one of mine? my ($from, $to, $via, $call, $dxchan); @@ -162,6 +167,11 @@ sub handle_11 my $pc = shift; my $recurse = shift || 0; + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } + # route 'foreign' pc26s if ($pcno == 26) { if ($pc->[7] ne $main::mycall) { @@ -573,6 +583,11 @@ sub handle_12 my $origin = shift; my $pc = shift; + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } + # announce duplicate checking $pc->[3] =~ s/^\s+//; # remove leading blanks @@ -874,6 +889,12 @@ sub handle_18 my $origin = shift; my $pc = shift; + my $conn = $self->conn; + unless ($self->outbound) { + dbg("PC18 on startup an incoming connection from $self->{call} ignored as iappropriate"); + return; + } + $self->state('init'); my $parent = Route::Node::get($self->{call}); @@ -1471,6 +1492,11 @@ sub handle_41 my $origin = shift; my $pc = shift; + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } + my $call = $pc->[1]; my $sort = $pc->[2]; my $val = $pc->[3]; @@ -1703,6 +1729,11 @@ sub handle_84 my $origin = shift; my $pc = shift; + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } + $self->process_rcmd($pc->[1], $pc->[2], $pc->[3], $pc->[4]); } @@ -2408,7 +2439,12 @@ sub handle_93 my $origin = shift; my $pc = shift; -# $self->{do_pc9x} ||= 1; + # $self->{do_pc9x} ||= 1; + + unless ($self->state eq 'normal') { + dbg("PC$pcno sent from $self->{call} ignored as this channel is not yet initialised (state: $self-{state})"); + return; + } my $pcall = $pc->[1]; # this is now checked earlier diff --git a/perl/Route.pm b/perl/Route.pm index 99b4b2b1..39f714c0 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -34,6 +34,7 @@ use vars qw(%list %valid $filterdef $maxlevel); itu => '0,ITU Zone', parent => '0,Parent Calls,parray', state => '0,State', + lastseen => '0,Last Seen,cldatetime', ); $filterdef = bless ([ diff --git a/perl/Spot.pm b/perl/Spot.pm index a63bcd10..d0b3cb1d 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -34,7 +34,7 @@ $defaultspots = 10; # normal number of spots to return $maxdays = 100; # normal maximum no of days to go back $dirprefix = "spots"; $duplth = 15; # the length of text to use in the deduping -$dupage = 1*3600; # the length of time to hold spot dups +$dupage = 10*60; # the length of time to hold spot dups $maxcalllth = 12; # the max length of call to take into account for dupes $filterdef = bless ([ # tag, sort, field, priv, special parser @@ -537,7 +537,7 @@ sub dup_add # 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|$node|$d|$text" : "X$call|$by|$qrg|$node|$nd|$text"; + $ldupkey = $oldstyle ? "X$call|$by|$freq|$nd|$node|$text" : "X$call|$by|$qrg|$nd|$node|$text"; $t = DXDupe::find($ldupkey); dbg("Spot::dup ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup'); @@ -550,7 +550,7 @@ sub dup_add $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|$otext"; + $ldupkey = $oldstyle ? "X$call|$by|$freq|$otext" : "X$call|$by|$qrg|$nd|$otext"; $t = DXDupe::find($ldupkey); dbg("Spot::dup (OTEXT) ldupkey $ldupkey t '$t'" . ($t?' DUPE':' NEW')) if isdbg('spotdup'); if (isdbg('spottext')) { diff --git a/perl/watchdbg b/perl/watchdbg index 5fa7ebb2..9d4b07f1 100755 --- a/perl/watchdbg +++ b/perl/watchdbg @@ -54,7 +54,6 @@ while (@ARGV) { # seek to end of file $fh->seek(0, 2); for (;;) { - $fh->seek(0, 1); my $line = $fh->getline; if ($line) { if (@patt) { @@ -94,6 +93,7 @@ for (;;) { $today = $now; } } + $fh->seek(0, 1); } sub printit -- 2.43.0