From 3065f0dd2c80cd59b7a2b17d397a343b6521b1f4 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 29 Jun 2007 14:29:13 +0100 Subject: [PATCH] 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. --- Changes | 5 +++++ cmd/set/wantpc9x.pl | 28 ++++++++++++++++++++++++++++ cmd/unset/wantpc9x.pl | 28 ++++++++++++++++++++++++++++ perl/DXProt.pm | 2 +- perl/DXProtHandle.pm | 24 ++++++++++++++++++++---- perl/DXProtout.pm | 3 +-- perl/DXUser.pm | 6 ++++++ perl/Messages | 4 ++-- perl/Version.pm | 2 +- 9 files changed, 92 insertions(+), 10 deletions(-) create mode 100644 cmd/set/wantpc9x.pl create mode 100644 cmd/unset/wantpc9x.pl diff --git a/Changes b/Changes index e60161c4..8c039864 100644 --- 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 index 00000000..a705cc56 --- /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 index 00000000..0c14ca23 --- /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 61693f33..ec6f5b04 100644 --- 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 b4d80ab0..7d2968ce 100644 --- 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 7e841ea5..c024724f 100644 --- 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 06075151..c4e3996b 100644 --- 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 323c8603..694d61cc 100644 --- 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 28aa8a64..68f113ea 100644 --- 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; -- 2.34.1