See Changes

diff --git a/Changes b/Changes
index 629dd0ff2ed9314f08a68c9895f787dd08ffc5d8..1a646f842769208309fc8e4db74fafddcfbc059c 100644 (file)
--- 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 5a2f7d41a66f3073c3b054d37d4414566400fe04..05a9d07ac9ba95e0f81567a5cd7f52e91433b6e5 100644 (file)
--- 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 <callsign>\nSHOW/425 CAL\nSHOW/425 BULL <bulletin number>\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 dcd7b909bf25af8983044ace748da460efb896eb..240142c65107a80e6979fa417935f247fd4f1866 100644 (file)
--- 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 46d2b1d38bd4d450f0f95b0fbda2e7b37281f274..9b3a371b092a8e9cd651025153e26ca9c642a71d 100644 (file)
--- 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 f79424c7fbf4134343bee5836e449d0909fbb85a..dcd1bf4fb6051d09308cc8a65565d1e0bfa35636 100644 (file)
--- 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 c82c4ec5bb00a8aaa39c6396caa95d75258edddc..f10cb5e7b68d35953600850b058e985bdfa286a7 100644 (file)
--- 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 792aa2e79e122c0ea8de7d777881d2994c0bbcee..2adce5429b0cc4b02c86c950a79eb4310a087c77 100644 (file)
--- 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;