From 4c3cc05e14f37272ed4f305ee05d6ce5834451a7 Mon Sep 17 00:00:00 2001
From: Dirk Koopman <djk@tobit.co.uk>
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