make callsign checking more rigorous

diff --git a/Changes b/Changes
index df398943873d3f2d8176e9ed83f49ff655610f42..72f2d4723485edaa01dcd0ec4c19ef50dffaddbc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,7 @@
 last port of call).
 3. ignore deleted messages for queuing purposes
 4. store deleted status across restarts!
 last port of call).
 3. ignore deleted messages for queuing purposes
 4. store deleted status across restarts!

+5. make callsign checking more rigorous

 03Oct01=======================================================================
 1. don't allow @WWW to become a 'TO' field...
 2. handle @gb7tlh.#35.eu type addresses as well
 03Oct01=======================================================================
 1. don't allow @WWW to become a 'TO' field...
 2. handle @gb7tlh.#35.eu type addresses as well

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 9d475ed89c8f2f17713b3aabdc9aa6c79d93d4df..018a404a6249baa43fe2987ff24520c25cf33d59 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -333,7 +333,7 @@ sub unpad
 # check that a field only has callsign characters in it
 sub is_callsign
 {
 # check that a field only has callsign characters in it
 sub is_callsign
 {

-       return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]+(?:-\d{1,2}|\/[A-Z0-9]+)?$/;
+       return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/;

 }
 
 # check that a PC protocol field is valid text
 }
 
 # check that a PC protocol field is valid text

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index ae0e218b25c8575a73b71efeb0d4ed2cffbd3a56..75b025f397cf34f553799460ed57318584c01490 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -95,7 +95,7 @@ sub dequeue
                                &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
                        } elsif ($conn->{state} eq 'WL' ) {
                                $msg = uc $msg;
                                &{$conn->{rproc}}($conn, "I$conn->{call}|$msg");
                        } elsif ($conn->{state} eq 'WL' ) {
                                $msg = uc $msg;

-                               if (is_callsign($msg)) {
+                               if (is_callsign($msg) && $msg !~ m|/| ) {

                                        my $sort = $conn->{csort};
                                        $sort = 'local' if $conn->{peerhost} eq "127.0.0.1";
                                        $conn->to_connected($msg, 'A', $sort);
                                        my $sort = $conn->{csort};
                                        $sort = 'local' if $conn->{peerhost} eq "127.0.0.1";
                                        $conn->to_connected($msg, 'A', $sort);