fix sh/dx by call and missing files

Add a basic implimentation of allowing callsigns like PA0/G1TLH
to login as normal users that are completely distinct from their
(apparent) parent callsign. PA0/G1TLH has no connection with
G1TLH despite appearances.

diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index e3173bfd11c7b8f6c5f85874f8f41f5fc6e5e27f..c5d629ecd57e308a4cf2898bad59a6021ba9a6d4 100644 (file)
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -59,11 +59,6 @@ sub handle
                        $dofilter = 1 if $self && $self->spotsfilter;
                        next;
                }
-               if (lc $f eq 'spotter') {
-                       dbg("sh/dx by") if isdbg('sh/dx');
-                       push @flist, 'by';
-                       next;
-               }
                if (lc $f eq 'qsl') {
                        dbg("sh/dx qsl") if isdbg('sh/dx');
                        push @flist, "info {QSL|VIA}";
@@ -88,7 +83,7 @@ sub handle
                        dbg("sh/dx qra") if isdbg('sh/dx');
                        next;
                }
-               if (grep {lc $f eq $_} qw(zone byzone by_zone itu byitu by_itu state bystate by_state info on) ) {
+               if (grep {lc $f eq $_} qw(zone byzone by_zone itu byitu by_itu state bystate by_state info on spotter by) ) {
                        $f =~ s/^by(\w)/by_$1/;
                        push @flist, $f;
                        push @flist, shift @list if @list;

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index e93d7ab4e6d87bd37e1d07c88f4e0fd748dc8c64..20837f2f6494f1f5d7645e3d96c41c4a5d46eb8d 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -383,8 +383,8 @@ sub unpad
 sub is_callsign
 {
        return $_[0] =~ m!^
-                                         (?:\d?[A-Z]{1,2}\d*/)?    # out of area prefix /  
-                                         (?:\d?[A-Z]{1,2}\d+)      # main prefix one (required) 
+                                         (?:\d?[A-Z]{1,2}\d{0,2}/)?    # out of area prefix /  
+                                         (?:\d?[A-Z]{1,2}\d{1,2})      # main prefix one (required) 
                                          [A-Z]{1,5}                # callsign letters (required)
                                          (?:-(?:\d{1,2}))?         # - nn possibly (eg G8BPQ-8)
                                          (?:/[0-9A-Z]{1,7})?       # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index ffa16bb711e92257ba185aef822b95b00236a480..44846c53312f12a370b2babd6cd5acd888605c4d 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -37,7 +37,7 @@ sub enqueue
 {
        my ($conn, $msg) = @_;
        unless ($msg =~ /^[ABZ]/) {
-               if ($msg =~ /^E[-\w]+\|([01])/ && $conn->{csort} eq 'telnet') {
+               if ($msg =~ m{^E[-\w\/]+\|([01])} && $conn->{csort} eq 'telnet') {
                        $conn->{echo} = $1;
                        if ($1) {
 #                              $conn->send_raw("\xFF\xFC\x01");
@@ -45,7 +45,7 @@ sub enqueue
 #                              $conn->send_raw("\xFF\xFB\x01");
                        }
                } else {
-                       $msg =~ s/^[-\w]+\|//;
+                       $msg =~ s{^[-\w\/]+\|}{};
                        push (@{$conn->{outqueue}}, $msg . $conn->{lineend});
                }
        }
@@ -99,18 +99,23 @@ sub dequeue
                                &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
                        } elsif ($conn->{state} eq 'WL' ) {
                                $msg = uc $msg;
-                               if (is_callsign($msg) && $msg !~ m|/| ) {
-                                       my $sort = $conn->{csort};
-                                       $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1';
-                                       my $uref;
-                                       if ($main::passwdreq || ($uref = DXUser::get_current($msg)) && $uref->passwd ) {
-                                               $conn->conns($msg);
-                                               $conn->{state} = 'WP';
-                                               $conn->{decho} = $conn->{echo};
-                                               $conn->{echo} = 0;
-                                               $conn->send_raw('password: ');
+                               if (is_callsign($msg)) {
+                                       if ($main::allowslashcall || $msg !~ m|/|) {
+                                               my $sort = $conn->{csort};
+                                               $sort = 'local' if $conn->{peerhost} =~ /127\.\d+\.\d+\.\d+$/ || $conn->{peerhost} eq '::1';
+                                               my $uref;
+                                               if ($main::passwdreq || ($uref = DXUser::get_current($msg)) && $uref->passwd ) {
+                                                       $conn->conns($msg);
+                                                       $conn->{state} = 'WP';
+                                                       $conn->{decho} = $conn->{echo};
+                                                       $conn->{echo} = 0;
+                                                       $conn->send_raw('password: ');
+                                               } else {
+                                                       $conn->to_connected($msg, 'A', $sort);
+                                               }
                                        } else {
-                                               $conn->to_connected($msg, 'A', $sort);
+                                               $conn->send_now("Sorry $msg is an invalid callsign");
+                                               $conn->disconnect;
                                        }
                                } else {
                                        $conn->send_now("Sorry $msg is an invalid callsign");

diff --git a/perl/Messages b/perl/Messages
index 4efde147e5556d1d9702a2bc2d2dd7a83f0443b3..08a79251f230c24d839e5e8c201b4474b1bbc93e 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -128,6 +128,7 @@ package DXM;
                                filter4 => '$_[0]$_[1] Filter $_[2] deleted for $_[3]',
                                filter5 => 'need some filter commands...',
                                filter6 => '$_[0]$_[1] Filter for $[2] not found',
+                               filter7 => '$_[0] parse error $_[1] on $_[2]', 
                                grayline1 => '                                                 Beg of               End of',
                                grayline2 => 'Location                              dd/mm/yyyy Dawn   Rise   Set    Dusk',
                                grids => 'DX Grid enabled for $_[0]',