From b9e57057d60a952bd43acdbeb2420ad7964b96f8 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 1 Mar 2023 23:10:07 +0000 Subject: [PATCH] See Changes --- Changes | 5 ++++- cmd/show/425.pl | 2 +- perl/DXChannel.pm | 2 +- perl/DXCommandmode.pm | 15 +++++++++------ perl/Internet.pm | 2 +- perl/Messages | 3 ++- perl/Spot.pm | 19 +++++++++++++------ 7 files changed, 31 insertions(+), 17 deletions(-) diff --git a/Changes b/Changes index 629dd0ff..1a646f84 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ 01Mar23======================================================================= -1. Revert PC92 A D and PC92 C record flags back to defaults +1. Revert PC92 A D and PC92 C record flags back to defaults. +2. Deal with users that send gibberish. +3. Fix show/425 (default) URL. +4. Improve Spot deduping. 28Feb23======================================================================= 1. Default ip addresses ON in PC92 C records, disable PC92 A D record output. 2. Add CTY-3308 prefixes. diff --git a/cmd/show/425.pl b/cmd/show/425.pl index 5a2f7d41..05a9d07a 100644 --- a/cmd/show/425.pl +++ b/cmd/show/425.pl @@ -17,7 +17,7 @@ sub handle return (1, $self->msg('e24')) unless $Internet::allow; return (1, "SHOW/425 \nSHOW/425 CAL\nSHOW/425 BULL \n e.g. SH/425 IQ5BL, SH/425 CAL, SH/425 BUL 779\n") unless @list; - my $target = $Internet::dx425_url || 'www.425dxn.org'; + my $target = $Internet::dx425_url || 'https://www.425dxn.org'; my $port = 80; dbg('sh/425: args=' . join('|', @list)) if isdbg('425'); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index dcd7b909..240142c6 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -135,7 +135,7 @@ $count = 0; wx => '0,Want WX,yesno', ); -$maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection +$maxerrors = 5; # the maximum number of concurrent errors allowed before disconnection # object destruction sub DESTROY diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 46d2b1d3..9b3a371b 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -50,6 +50,7 @@ use DXCIDR; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers + $maxcmdlth ); %Cache = (); # cache of dynamically loaded routine's mod times @@ -64,6 +65,8 @@ $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing com $users = 0; # no of users on this node currently $maxusers = 0; # max no users on this node for this run +$maxcmdlth = 512; # max length of incoming cmd line (including the command and any arguments + # # obtain a new connection this is derived from dxchannel # @@ -534,15 +537,15 @@ sub run_cmd if ($cmd) { - # check cmd - if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) { + # strip out // on command only + $cmd =~ s|//+|/|g; + + # check for length of whole command line and any invalid characters + if (length $cmdline > $maxcmdlth || $cmd =~ m|\.| || $cmd !~ m|^\w+(?:/\w+){0,1}$|) { LogDbg('DXCommand', "cmd: $self->{call} - invalid characters in '$cmd'"); - return $self->_error_out('e1'); + return $self->_error_out('e40'); } - # strip out // on command only - $cmd =~ s|//|/|g; - my ($path, $fcmd); dbg("cmd: $cmd") if isdbg('command'); diff --git a/perl/Internet.pm b/perl/Internet.pm index f79424c7..dcd1bf4f 100644 --- a/perl/Internet.pm +++ b/perl/Internet.pm @@ -69,7 +69,7 @@ $wm7d_url = 'www.wm7d.net'; # used by show/wm7d $db0sdx_url = 'www.qslinfo.de'; # used by show/db0sdx $db0sdx_path = '/qslinfo'; $db0sdx_suffix = '.asmx'; -$dx425_url = 'www.iz5fsa.net'; # used by show/425 +$dx425_url = 'https://www.425dxn.org/'; # used by show/425 #$contest_host = 'www.sk3bg.se'; # used by show/contest #$contest_url = "/contest/text"; # used by show/contest diff --git a/perl/Messages b/perl/Messages index c82c4ec5..f10cb5e7 100644 --- a/perl/Messages +++ b/perl/Messages @@ -76,7 +76,7 @@ package DXM; dxituu => q{DX ITU Zones disabled for $_[0]}, dxs => q{DX Spots enabled for $_[0]}, dxu => q{DX Spots disabled for $_[0]}, - e1 => q{Invalid command}, + e1 => q{Unknown command}, e2 => q{Error: $_[0]}, e3 => q{$_[0]: $_[1] not found}, e4 => q{Need at least a prefix or callsign}, @@ -115,6 +115,7 @@ package DXM; e37 => q{Need at least a callsign}, e38 => q{This is not a valid regex}, e39 => q{Sorry $_[0] is not a valid argument}, + e40 => q{Cmd too long or has invalid characters}, echoon => q{Echoing enabled}, echooff => q{Echoing disabled}, diff --git a/perl/Spot.pm b/perl/Spot.pm index 792aa2e7..2adce542 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -75,7 +75,7 @@ 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 = 100000; # normalise the qrg to this number of hz (default: 100khz), so tough luck if you have a fumble fingers moment -our $timegranularity = 600; # ditto to the nearest second +our $timegranularity = 600; # ditto to the nearest 100 seconds our $oldstyle = 0; # revert to traditional dupe key format @@ -480,25 +480,30 @@ sub formatl # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($freq, $call, $d, $text, $by, $node, $just_find) = @_; + my ($freq, $call, $d, $text, $by, $node, $just_find) = @_; + + dbg("Spot::dup: freq=$freq call=$call d=$d text='$text' by=$by node=$node" . ($just_find ? " jf=$just_find" : "")) if isdbg('spotdup'); # dump if too old return 2 if $d < $main::systime - $dupage; - my $nd = nearest_floor($d, $timegranularity); - # turn the time into minutes (should be already but...) $d = int ($d / 60); $d *= 60; + my $nd = nearest($timegranularity, $d); + # remove SSID or area $by =~ s|[-/]\d+$||; # $freq = sprintf "%.1f", $freq; # normalise frequency $freq = int $freq; # normalise frequency - my $qrg = nearest_floor($freq, $qrggranularity); # to the nearest however many hz + + my $qrg = nearest($qrggranularity, $freq); # to the nearest however many hz + $call = substr($call, 0, $maxcalllth) if length $call > $maxcalllth; + chomp $text; $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; $text = uc unpad($text); @@ -508,8 +513,10 @@ sub dup $text =~ s/\s{2,}[\dA-Z]?[A-Z]\d?$// if length $text > 24; $text =~ s/[\W\x00-\x2F\x7B-\xFF]//g; # tautology, just to make quite sure! $text = substr($text, 0, $duplth) if length $text > $duplth; - my $ldupkey = $oldstyle ? "X|$call|$by|$node|$freq|$d|$text" : "X|$call|$by|$qrg|$nd|$text"; + my $ldupkey = $oldstyle ? "X|$call|$by|$node|$freq|$d|$text" : "X|$call|$by|$node|$qrg|$nd|$text"; + dbg("Spot::dup ldupkey $ldupkey") if isdbg('spotdup'); + my $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; -- 2.43.0