From 3634fba90a64fe488d237f438d9945d81158da52 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 3 Sep 2001 09:26:42 +0000 Subject: [PATCH] 1. make spot dups look back 5 mins. 2. strip the top off each character in any text field of a Spot for duping. 3. Try to make the routing tables more accurate for users that login to more than one node. 4. Make PC50s come out in one heap on all channels every 14 mins, instead of on the 14th minute in the connection time for each channel. This should reduce (slightly) the dups that are dumped. --- Changes | 11 ++++++++++- perl/DXChannel.pm | 1 + perl/DXCommandmode.pm | 10 ++++++++-- perl/DXDupe.pm | 15 +++++++++++++-- perl/DXProt.pm | 37 ++++++++++++++++++++++--------------- perl/Route.pm | 25 +++++++++++++++++++------ perl/Route/Node.pm | 41 ++++++++++++++++++++++++----------------- perl/Route/User.pm | 5 ++--- perl/Spot.pm | 9 ++++++++- 9 files changed, 107 insertions(+), 47 deletions(-) diff --git a/Changes b/Changes index b77d74c0..bf1412d6 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +03Sep01======================================================================= +1. make spot dups look back 5 mins. +2. strip the top off each character in any text field of a Spot for duping. +3. Try to make the routing tables more accurate for users that login to +more than one node. +4. Make PC50s come out in one heap on all channels every 14 mins, instead of +on the 14th minute in the connection time for each channel. This should +reduce (slightly) the dups that are dumped. 01Sep01======================================================================= 1. Change build number calc (hopefully for the last time) 27Aug01======================================================================= @@ -9,7 +17,8 @@ privilege is 1 or less and which isn't mentioned as an argument to the command on the command line. 3. make set/node, set/spider and their friends unlock a node as well as make them one. -4. Make sh/log et al more efficient / less memory hungry +4. Make sh/log et al more efficient / less memory hungry (and the display +the correct way round!) 24Aug01======================================================================= 1. Allow badmsg to reject on interface callsign ('I') 20Aug01======================================================================= diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 30a78970..15bd6d2b 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -447,6 +447,7 @@ sub tell_login my $dxchan; foreach $dxchan (@dxchan) { next if $dxchan == $self; + next if $dxchan->{call} eq $main::mycall; $dxchan->send($dxchan->msg($m, $self->{call})) if $dxchan->{logininfo}; } } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index f0016329..96ccc0a4 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -425,8 +425,14 @@ sub disconnect my $call = $self->call; delete $self->{senddbg}; - my @rout = $main::routeroot->del_user($call); - dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + my $uref = Route::User::get($call); + my @rout; + if ($uref) { + @rout = $main::routeroot->del_user($uref); + dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + } else { + confess "trying to disconnect a non existant user $call"; + } # issue a pc17 to everybody interested DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout; diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index 5a01bee9..bcc0f7b0 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -40,10 +40,21 @@ sub finish sub check { my ($s, $t) = @_; - return 1 if exists $d{$s}; + return 1 if find($s); + add($s, $t); + return 0; +} + +sub find +{ + return 1 if exists $d{$_[0]}; +} + +sub add +{ + my ($s, $t) = @_; $t = $main::systime + $default unless $t; $d{$s} = $t; - return 0; } sub del diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 310a3e87..c5f4384c 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -41,7 +41,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; $main::build += $VERSION; $main::branch += $BRANCH; -use vars qw($me $pc11_max_age $pc23_max_age +use vars qw($me $pc11_max_age $pc23_max_age $last_pc50 $last_hour $last10 %eph %pings %rcmds %nodehops $baddx $badspotter $badnode $censorpc $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -59,7 +59,7 @@ $censorpc = 1; # Do a BadWords::check on text fields and reject things $baddx = new DXHash "baddx"; $badspotter = new DXHash "badspotter"; $badnode = new DXHash "badnode"; -$last10 = time; +$last10 = $last_pc50 = time; @checklist = ( @@ -578,7 +578,7 @@ sub normal $r->flags($flags); push @rout, $r; } - $r->addparent($ncall); + $r->addparent($parent); } else { push @rout, $parent->add_user($call, $flags); } @@ -626,11 +626,17 @@ sub normal dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); return; } + my $uref = Route::User::get($ucall); + unless ($uref) { + dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); + return; + } + # input filter if required return unless $self->in_filter_route($parent); - - my @rout = $parent->del_user($ucall); + + my @rout = $parent->del_user($uref); if (eph_dup($line)) { dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); @@ -1122,20 +1128,22 @@ sub process my $t = time; my @dxchan = DXChannel->get_all(); my $dxchan; + my $pc50s; + # send out a pc50 on EVERY channel all at once + if ($t >= $last_pc50 + $DXProt::pc50_interval) { + $pc50s = pc50($me, scalar DXChannel::get_all_users); + eph_dup($pc50s); + $last_pc50 = $t; + } + foreach $dxchan (@dxchan) { next unless $dxchan->is_node(); next if $dxchan == $me; - - # send a pc50 out on this channel - $dxchan->{pc50_t} = $main::systime unless exists $dxchan->{pc50_t}; - if ($t >= $dxchan->{pc50_t} + $DXProt::pc50_interval) { - my $s = pc50($me, scalar DXChannel::get_all_users); - eph_dup($s); - $dxchan->send($s); - $dxchan->{pc50_t} = $t; - } + # send the pc50 + $dxchan->send($pc50s) if $pc50s; + # send a ping out on this channel if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { if ($dxchan->{nopings} <= 0) { @@ -1727,7 +1735,6 @@ sub disconnect my $node = Route::Node::get($call); my @rout; if ($node) { -# @rout = $node->del_nodes; # at the next level @rout = $node->del($main::routeroot); } diff --git a/perl/Route.pm b/perl/Route.pm index 6a4f96f6..7276c697 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -92,28 +92,41 @@ sub _addlist { my $self = shift; my $field = shift; + my @out; foreach my $c (@_) { - my $call = _getcall($c); - unless (grep {$_ eq $call} @{$self->{$field}}) { + confess "Need a ref here" unless ref($c); + + my $call = $c->{call}; + unless (grep $_ eq $call, @{$self->{$field}}) { push @{$self->{$field}}, $call; dbg(ref($self) . " adding $call to " . $self->{call} . "->\{$field\}") if isdbg('routelow'); + push @out, $c; } } - return $self->{$field}; + return @out; } sub _dellist { my $self = shift; my $field = shift; + my @out; foreach my $c (@_) { - my $call = _getcall($c); - if (grep {$_ eq $call} @{$self->{$field}}) { + confess "Need a ref here" unless ref($c); + my $call = $c->{call}; + if (grep $_ eq $call, @{$self->{$field}}) { $self->{$field} = [ grep {$_ ne $call} @{$self->{$field}} ]; dbg(ref($self) . " deleting $call from " . $self->{call} . "->\{$field\}") if isdbg('routelow'); + push @out, $c; } } - return $self->{$field}; + return @out; +} + +sub is_empty +{ + my $self = shift; + return @{$self->{$_[0]}} == 0; } # diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 6a2e2eaa..08b74c73 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -44,6 +44,7 @@ sub count sub max { + count(); return $max; } @@ -66,12 +67,12 @@ sub add confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; my $self = get($call); if ($self) { - $self->_addparent($parent->{call}); - $parent->_addnode($call); + $self->_addparent($parent); + $parent->_addnode($self); return undef; } - $parent->_addnode($call); $self = $parent->new($call, @_); + $parent->_addnode($self); return $self; } @@ -88,14 +89,13 @@ sub del my $pref = shift; # delete parent from this call's parent list - my $pcall = $pref->{call}; - my $ncall = $self->{call}; - $pref->_delnode($ncall);; - my $ref = $self->_delparent($pcall); + $pref->_delnode($self); + my @ref = $self->_delparent($pref); my @nodes; + my $ncall = $self->{call}; # is this the last connection, I have no parents anymore? - unless (@$ref) { + unless (@ref) { foreach my $rcall (@{$self->{nodes}}) { next if grep $rcall eq $_, @_; my $r = Route::Node::get($rcall); @@ -137,16 +137,17 @@ sub add_user confess "Trying to add NULL User call to routing tables" unless $ucall; - $self->_adduser($ucall); - - $self->{usercount} = scalar @{$self->{users}}; my $uref = Route::User::get($ucall); my @out; if ($uref) { - $uref->addparent($self->{call}); + @out = $uref->addparent($self); } else { - @out = Route::User->new($ucall, $self->{call}, @_); + $uref = Route::User->new($ucall, $self->{call}, @_); + @out = $uref; } + $self->_adduser($uref); + $self->{usercount} = scalar @{$self->{users}}; + return @out; } @@ -154,10 +155,16 @@ sub add_user sub del_user { my $self = shift; - my $ucall = shift; - my $ref = Route::User::get($ucall); - $self->_deluser($ucall); - my @out = $ref->del($self) if $ref; + my $ref = shift; + my @out; + + if ($ref) { + @out = $self->_deluser($ref); + $ref->del($self); + } else { + confess "tried to delete non-existant $ref->{call} from $self->{call}"; + } + $self->{usercount} = scalar @{$self->{users}}; return @out; } diff --git a/perl/Route/User.pm b/perl/Route/User.pm index bc28dbef..e510a165 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -39,6 +39,7 @@ sub count sub max { + count(); return $max; } @@ -62,9 +63,7 @@ sub del { my $self = shift; my $pref = shift; - my $ref = $self->delparent($pref->{call}); - return () if @$ref; - my @out = delete $list{$self->{call}}; + my @out = $self->delparent($pref); return @out; } diff --git a/perl/Spot.pm b/perl/Spot.pm index 78d2eda5..69a67b9e 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -314,9 +314,16 @@ sub dup $text = substr($text, 0, $duplth) if length $text > $duplth; unpad($text); $text =~ s/[\\\%]\d+//g; + $text = pack("C*", map {$_ & 127} unpack("C*", $text)); $text =~ s/[^a-zA-Z0-9]//g; + for (0,60,120,180,240,300) { + my $dt = $d - $_; + my $dupkey = "X$freq|$call|$dt|\L$text"; + return 1 if DXDupe::find($dupkey); + } my $dupkey = "X$freq|$call|$d|\L$text"; - return DXDupe::check($dupkey, $main::systime+$dupage); + DXDupe::add($dupkey, $main::systime+$dupage); + return 0; } sub listdups -- 2.43.0