try to make set/isolate more bombproof.

Add a set/wantpc9x (default = on) command. It is likely
that (apart from mistakes) you will want to unset it mostly.
If either this flag == 0 or the node is isolated then pc9x
will not be offered on the PC18 and PC9x's will be ignored.

diff --git a/Changes b/Changes
index e60161c4c656eacdbf1d48aa43e02718715284f5..8c03986485c21d1fd06e6444648158650f9d3405 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+29Jun07=======================================================================
+1. If a node is set/isolated then make sure that a) pc9x is not advertised
+and b) pc9x is ignored.
+2. Add (un)set/wantpc9x command (but please don't use them without talking
+to me first), here be dragons!!
 25Jun07=======================================================================
 1. make sure that a C record is sent for node call every update period.
 2. make announces work again (probably).

diff --git a/cmd/set/wantpc9x.pl b/cmd/set/wantpc9x.pl
new file mode 100644 (file)
index 0000000..a705cc5
--- /dev/null
+++ b/cmd/set/wantpc9x.pl
@@ -0,0 +1,28 @@
+#
+# set the wantPC9x flag
+#
+# Copyright (c) 2007 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $call;
+my @out;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+       return (1, $self->msg('e12')) unless is_callsign($call);
+
+       my $user = DXUser->get_current($call);
+       if ($user) {
+               $user->wantpc9x(1);
+               $user->put;
+               push @out, $self->msg('wpc9xs', $call);
+       } else {
+               push @out, $self->msg('e3', "set/wantpc9x", $call);
+       }
+}
+return (1, @out);

diff --git a/cmd/unset/wantpc9x.pl b/cmd/unset/wantpc9x.pl
new file mode 100644 (file)
index 0000000..0c14ca2
--- /dev/null
+++ b/cmd/unset/wantpc9x.pl
@@ -0,0 +1,28 @@
+#
+# unset the wantpc9x flag
+#
+# Copyright (c) 2007 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $call;
+my @out;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+       return (1, $self->msg('e12')) unless is_callsign($call);
+
+       my $user = DXUser->get_current($call);
+       if ($user) {
+               $user->wantpc9x(0);
+               $user->put;
+               push @out, $self->msg('wpc9xu', $call);
+       } else {
+               push @out, $self->msg('e3', "unset/wantpc9x", $call);
+       }
+}
+return (1, @out);

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 61693f330ed1659bd37223805efa8a7f80c1cf2e..ec6f5b0400a6b309d0da0b398a5235260373b5cf 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -351,7 +351,7 @@ sub start
 sub sendinit
 {
        my $self = shift;
-       $self->send(pc18());
+       $self->send(pc18(($self->{isolate} || !$self->user->wantpc9x) ? "" : " pc9x"));
 }
 
 #

diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index b4d80ab09957fccdea84ccceeaa7d5ef077a587e..7d2968cedb626ccdc85be4a3e656eacdade0da57 100644 (file)
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -582,7 +582,9 @@ sub handle_18
 #              $self->{handle_xml}++ if DXXml::available() && $_[1] =~ /\bxml/;
                if ($_[1] =~ /\bpc9x/) {
                        if ($self->{isolate}) {
-                               dbg("pc9x recognised, but is isolated, using old protocol");
+                               dbg("pc9x recognised, but $self->{call} is isolated, using old protocol");
+                       } elsif (!$self->user->wantpc9x) {
+                               dbg("pc9x explicitly switched off on $self->{call}, using old protocol");
                        } else {
                                $self->{do_pc9x} = 1;
                                dbg("Do px9x set on $self->{call}");
@@ -1462,9 +1464,17 @@ sub handle_92
        }
 
        if ($pcall eq $self->{call} && $self->{state} eq 'init') {
-               $self->state('init92');
-               $self->{do_pc9x} = 1;
-               dbg("Do pc9x set on $pcall");
+               if ($self->{isolate}) {
+                       dbg("PC9x received, but $pcall is isolated, ignored");
+                       return;
+               } elsif (!$self->user->wantpc9x) {
+                       dbg("PC9x explicitly switched off on $pcall, ignored");
+                       return;
+               } else {
+                       $self->state('init92');
+                       $self->{do_pc9x} = 1;
+                       dbg("Do pc9x set on $pcall");
+               }
        }
        unless ($self->{do_pc9x}) {
                dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
@@ -1677,6 +1687,12 @@ sub handle_93
                dbg("PCPROT: invalid callsign string '$_[1]', ignored") if isdbg('chanerr');
                return;
        }
+
+       unless ($self->{do_pc9x}) {
+               dbg("PCPROT: PC9x come in from non-PC9x node, ignored") if isdbg('chanerr');
+               return;
+       }
+
        my $t = $_[2];
        my $parent = check_pc9x_t($pcall, $t, 93, 1) || return;
 

diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm
index 7e841ea599f190b86ae71e967dfc265f385bbe87..c024724f44ee51f8ac48d5f092c6a85dbdae41d2 100644 (file)
--- a/perl/DXProtout.pm
+++ b/perl/DXProtout.pm
@@ -117,8 +117,7 @@ sub pc17
 # Request init string
 sub pc18
 {
-       my $flags = " pc9x";
-       $flags .= " xml" if DXXml::available();
+       my $flags = shift;
        return "PC18^DXSpider Version: $main::version Build: $main::subversion.$main::build$flags^$DXProt::myprot_version^";
 }
 

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 06075151fc97520b12a4104cb28a62d5405b19d5..c4e3996b35b5e90a0ebde9688de582e6a86b3839 100644 (file)
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -80,6 +80,7 @@ $v3 = 0;
                  wantdxcq => '0,Show CQ Zone,yesno',
                  wantdxitu => '0,Show ITU Zone,yesno',
                  wantgtk => '0,Want GTK interface,yesno',
+                 wantpc9x => '0,Want PC9X interface,yesno',
                  lastoper => '9,Last for/oper,cldatetime',
                  nothere => '0,Not Here Text',
                  registered => '9,Registered?,yesno',
@@ -716,6 +717,11 @@ sub wantgtk
        return _want('gtk', @_);
 }
 
+sub wantpc9x
+{
+       return _want('pc9x', @_);
+}
+
 sub wantlogininfo
 {
        my $self = shift;

diff --git a/perl/Messages b/perl/Messages
index 323c8603d78be50808d802ea467c068ff3582148..694d61cccb0ac10857c24321cffc1da32bf78e54 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -338,8 +338,8 @@ package DXM;
                                wpc16u => 'Allow PC16 from $_[0] disabled',
                                wpc19s => 'Route PC19 for $_[0] enabled',
                                wpc19u => 'Route PC19 for $_[0] disabled',
-                               wpc90s => 'PC90 for $_[0] enabled',
-                               wpc90u => 'PC90 for $_[0] disabled',
+                               wpc9xs => 'PC9X for $_[0] enabled',
+                               wpc9xu => 'PC9X for $_[0] disabled',
                                wwv1 => '$_[0] is missing or out of range',
                                wwv2 => 'Duplicate WWV',
                                wwv3 => 'Date        Hour   SFI   A   K Forecast                               Logger',

diff --git a/perl/Version.pm b/perl/Version.pm
index 28aa8a64328acd5433b6dcbd9e40d4bf93894bd1..68f113ea87e4944bce4b6747368cd3ab6e202ecd 100644 (file)
--- a/perl/Version.pm
+++ b/perl/Version.pm
@@ -11,6 +11,6 @@ use vars qw($version $subversion $build);
 
 $version = '1.54';
 $subversion = '0';
-$build = '95';
+$build = '96';
 
 1;