From 07ea293f3919d2da76220b5fbc55b734008ed44c Mon Sep 17 00:00:00 2001 From: djk Date: Sat, 20 Jun 1998 23:32:43 +0000 Subject: [PATCH] fleshed out some commands (particularly flag setting and unsetting) added some more messages - more needed --- cmd/Notes.txt | 22 ++++++++++-- cmd/set/announce.pl | 26 +++++++++++++++ cmd/set/debug.pl | 6 ++-- cmd/set/dx.pl | 26 +++++++++++++++ cmd/set/here.pl | 26 +++++++++++++++ cmd/set/homebbs.pl | 0 cmd/set/talk.pl | 26 +++++++++++++++ cmd/set/wwv.pl | 26 +++++++++++++++ cmd/show/channel.pl | 24 ++++++------- cmd/show/dx.pl | 0 cmd/show/user.pl | 26 +++++---------- cmd/unset/announce.pl | 26 +++++++++++++++ cmd/unset/debug.pl | 10 +++--- cmd/unset/dx.pl | 26 +++++++++++++++ cmd/unset/here.pl | 26 +++++++++++++++ cmd/unset/talk.pl | 26 +++++++++++++++ cmd/unset/wwv.pl | 26 +++++++++++++++ perl/DXChannel.pm | 20 +++++------ perl/DXCluster.pm | 19 +++++++---- perl/DXCommandmode.pm | 6 ++-- perl/DXM.pm | 28 ++++++++++++---- perl/DXProt.pm | 12 ++++++- perl/DXUser.pm | 40 ++++++++++++++-------- perl/DXUtil.pm | 78 ++++++++++++++++++++++++++++++++++++++++++- perl/DXVars.pm | 6 ++++ perl/client.pl | 15 +++++++-- perl/cluster.pl | 12 +++++-- 27 files changed, 497 insertions(+), 87 deletions(-) create mode 100644 cmd/set/homebbs.pl create mode 100644 cmd/show/dx.pl diff --git a/cmd/Notes.txt b/cmd/Notes.txt index 3768d2c3..16b2a25c 100644 --- a/cmd/Notes.txt +++ b/cmd/Notes.txt @@ -43,12 +43,13 @@ Programming Notes ($Id$) * slash characters are replaced by '_' so the equivalent name for 'show/qth' is 'Emb_show_qth'. -* you would normally do a 'my $self = shift;' as the first thing. There +* you would normally do a 'my ($self, $line) = @_;' as the first thing. There are a complete set of accessors for DXUser, DXCommandmode and DXChannel classes and these are the recommended way of getting at these classes. A fairly standard start might be:- - $self = shift; + my ($self, $line) = @_; + @args = split /\s+/, $line; $call = $self->call; $user = $self->user; @@ -79,6 +80,23 @@ Programming Notes ($Id$) of an element (the client will put the correct one in if required [but see below]). +* As this is perl and it is very easy to alter stuff to get it correct, + I would like to see some intelligent argument processing, e.g. if + you can have one callsign, you can have several. Interpret your + arguments; so for example:- + + set/locator jo02lq - sets your own locator to JO02LQ + set/locator g1tlh jo02lq - sets G1TLH's locator (if you are allowed) + + or + + show/locator - displays your locator (and other info?) + show/locator in92jo - displays the bearing and distance to + IN92JO using your lat/long or locator + show/locator jn56in in92jo - bearing and distance between two + locators + show/locator gb7dxc - bearing and distance to gb7dxc if poss. + * Anything you output with a > as the last character is taken to mean that this is a prompt and will not have a \r or \n appended to it. diff --git a/cmd/set/announce.pl b/cmd/set/announce.pl index e69de29b..8fce45ca 100644 --- a/cmd/set/announce.pl +++ b/cmd/set/announce.pl @@ -0,0 +1,26 @@ +# +# set the announce flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->ann(1); + push @out, DXM::msg('anns', $call); + } else { + push @out, DXM::msg('e3', "Set Announce", $call); + } +} +return (1, @out); diff --git a/cmd/set/debug.pl b/cmd/set/debug.pl index e5c4658b..f88434e2 100644 --- a/cmd/set/debug.pl +++ b/cmd/set/debug.pl @@ -4,12 +4,10 @@ # $Id$ # -use DXDebug; - -$self = shift; +my ($self, $line) = @_; return (0) if $self->priv < 9; -dbgadd(split); +dbgadd(split /\s+/, $line); my $set = join ' ', dbglist(); return (1, "Debug Levels now: $set"); diff --git a/cmd/set/dx.pl b/cmd/set/dx.pl index e69de29b..00ea0328 100644 --- a/cmd/set/dx.pl +++ b/cmd/set/dx.pl @@ -0,0 +1,26 @@ +# +# set the dx flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->dx(1); + push @out, DXM::msg('dxs', $call); + } else { + push @out, DXM::msg('e3', "Set DX Spots", $call); + } +} +return (1, @out); diff --git a/cmd/set/here.pl b/cmd/set/here.pl index e69de29b..acccbcc4 100644 --- a/cmd/set/here.pl +++ b/cmd/set/here.pl @@ -0,0 +1,26 @@ +# +# set the here flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->here(1); + push @out, DXM::msg('heres', $call); + } else { + push @out, DXM::msg('e3', "Set Here", $call); + } +} +return (1, @out); diff --git a/cmd/set/homebbs.pl b/cmd/set/homebbs.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/set/talk.pl b/cmd/set/talk.pl index e69de29b..8c4d3ac4 100644 --- a/cmd/set/talk.pl +++ b/cmd/set/talk.pl @@ -0,0 +1,26 @@ +# +# set the talk flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->talk(1); + push @out, DXM::msg('talks', $call); + } else { + push @out, DXM::msg('e3', "Set Talk", $call); + } +} +return (1, @out); diff --git a/cmd/set/wwv.pl b/cmd/set/wwv.pl index e69de29b..2e403cec 100644 --- a/cmd/set/wwv.pl +++ b/cmd/set/wwv.pl @@ -0,0 +1,26 @@ +# +# set the wwv flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->wwv(1); + push @out, DXM::msg('wwvs', $call); + } else { + push @out, DXM::msg('e3', "Set WWV", $call); + } +} +return (1, @out); diff --git a/cmd/show/channel.pl b/cmd/show/channel.pl index 4b4a7920..e1ef7610 100644 --- a/cmd/show/channel.pl +++ b/cmd/show/channel.pl @@ -4,25 +4,21 @@ # $Id$ # -my $self = shift; -#return (0) if ($self->priv < 9); # only console users allowed -my @list = split; # generate a list of callsigns -@list = ($self->call) if !@list; # my channel if no callsigns +my ($self, $line) = @_; +my @list = /\s+/, $line; # generate a list of callsigns +@list = ($self->call) if (!@list || $self->priv < 9); # my channel if no callsigns my $call; my @out; foreach $call (@list) { + $call = uc $call; my $ref = DXChannel->get($call); - return (0, "Channel: $call not found") if !$ref; - - my @fields = $ref->fields; - my $field; - push @out, "User Information $call"; - foreach $field (@fields) { - my $prompt = $ref->field_prompt($field); - my $val = $ref->{$field}; - push @out, "$prompt: $val"; - } + if ($ref) { + @out = print_all_fields($self, $ref, "Channe Information $call"); + } else { + return (0, "Channel: $call not found") if !$ref; + } + push @out, "" if @list > 1; } return (1, @out); diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/show/user.pl b/cmd/show/user.pl index 919fda66..3b277774 100644 --- a/cmd/show/user.pl +++ b/cmd/show/user.pl @@ -4,29 +4,21 @@ # $Id$ # -my $self = shift; -#return (0) if ($self->priv < 9); # only console users allowed -my @list = split; # generate a list of callsigns +my ($self, $line) = @_; +my @list = split /\s+/, $line; # generate a list of callsigns @list = ($self->call) if !@list; # my channel if no callsigns my $call; my @out; foreach $call (@list) { + $call = uc $call; my $ref = DXUser->get($call); - return (0, "User: $call not found") if !$ref; - - my @fields = $ref->fields; - my $field; - push @out, "User Information $call"; - foreach $field (@fields) { - my $prompt = $ref->field_prompt($field); - my $val = $ref->{$field}; - push @out, "$prompt: $val"; - } + if ($ref) { + @out = print_all_fields($self, $ref, "User Information $call"); + } else { + push @out, "User: $call not found"; + } + push @out, "" if @list > 1; } return (1, @out); - - - - diff --git a/cmd/unset/announce.pl b/cmd/unset/announce.pl index e69de29b..cf750e25 100644 --- a/cmd/unset/announce.pl +++ b/cmd/unset/announce.pl @@ -0,0 +1,26 @@ +# +# unset the announce flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->ann(0); + push @out, DXM::msg('annu', $call); + } else { + push @out, DXM::msg('e3', "Unset Announce", $call); + } +} +return (1, @out); diff --git a/cmd/unset/debug.pl b/cmd/unset/debug.pl index 78a82527..9dafb31d 100644 --- a/cmd/unset/debug.pl +++ b/cmd/unset/debug.pl @@ -1,15 +1,15 @@ # -# add a debug level +# remove a debug level +# +# Copyright (c) 1998 - Dirk Koopman # # $Id$ # -use DXDebug; - -$self = shift; +my ($self, $line) = @_; return (0) if $self->priv < 9; -dbgsub(split); +dbgsub(split /\s+/, $line); my $set = join ' ', dbglist(); return (1, "Debug Levels now: $set"); diff --git a/cmd/unset/dx.pl b/cmd/unset/dx.pl index e69de29b..0ae6cc97 100644 --- a/cmd/unset/dx.pl +++ b/cmd/unset/dx.pl @@ -0,0 +1,26 @@ +# +# unset the dx flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->dx(0); + push @out, DXM::msg('dxu', $call); + } else { + push @out, DXM::msg('e3', "Unset DX Spots", $call); + } +} +return (1, @out); diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl index e69de29b..76adeeac 100644 --- a/cmd/unset/here.pl +++ b/cmd/unset/here.pl @@ -0,0 +1,26 @@ +# +# unset the here flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->here(0); + push @out, DXM::msg('hereu', $call); + } else { + push @out, DXM::msg('e3', "Unset Here", $call); + } +} +return (1, @out); diff --git a/cmd/unset/talk.pl b/cmd/unset/talk.pl index e69de29b..a3df8fa1 100644 --- a/cmd/unset/talk.pl +++ b/cmd/unset/talk.pl @@ -0,0 +1,26 @@ +# +# unset the talk flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->talk(0); + push @out, DXM::msg('talku', $call); + } else { + push @out, DXM::msg('e3', "Unset Talk", $call); + } +} +return (1, @out); diff --git a/cmd/unset/wwv.pl b/cmd/unset/wwv.pl index e69de29b..6495235f 100644 --- a/cmd/unset/wwv.pl +++ b/cmd/unset/wwv.pl @@ -0,0 +1,26 @@ +# +# unset the wwv flag +# +# Copyright (c) 1998 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, $line; +my $call; +my @out; + +@args = $self->call if (!@args || $self->priv < 9); + +foreach $call (@args) { + $call = uc $call; + my $user = ($call eq $self->call) ? $self->user : DXUser->get($call); + if ($user) { + $user->wwv(0); + push @out, DXM::msg('wwvu', $call); + } else { + push @out, DXM::msg('e3', "Unset WWV", $call); + } +} +return (1, @out); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index cfa3d150..36a84aa1 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -33,16 +33,16 @@ use DXDebug; %channels = undef; %valid = ( - call => 'Callsign', - conn => 'Msg Connection ref', - user => 'DXUser ref', - t => 'Time', - priv => 'Privilege', - state => 'Current State', - oldstate => 'Last State', - list => 'Dependant DXChannels list', - name => 'User Name', - connsort => 'Connection Type' + call => '0,Callsign', + conn => '9,Msg Conn ref', + user => '9,DXUser ref', + t => '0,Time,atime', + priv => '9,Privilege', + state => '0,Current State', + oldstate => '5,Last State', + list => '9,Dep Chan List', + name => '0,User Name', + consort => '9,Connection Type' ); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 2b412cd3..2dad1cb6 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -53,14 +53,21 @@ sub delcluster; } %valid = ( - mynode => 'Parent Node', - call => 'Callsign', - confmode => 'Conference Mode', - here => 'Here?', - dxprot => 'Channel ref', - version => 'Node Version', + mynode => '0,Parent Node', + call => '0,Callsign', + confmode => '5,Conference Mode,yesno', + here => '5,Here?,yesno', + dxprot => '5,Channel ref', + version => '5,Node Version', ); +# return a prompt for a field +sub field_prompt +{ + my ($self, $ele) = @_; + return $valid{$ele}; +} + sub AUTOLOAD { my $self = shift; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6a3603ab..2ae7a060 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -32,10 +32,10 @@ sub start my ($self, $line) = @_; my $user = $self->{user}; my $call = $self->{call}; - my $name = $self->{name}; - $name = $call if !defined $name; + my $name = $user->{name}; - $self->msg('l2',$name); + $self->{name} = $name ? $name : $call; + $self->msg('l2',$self->{name}); $self->send_file($main::motd) if (-e $main::motd); $self->msg('pr', $call); $self->state('prompt'); # a bit of room for further expansion, passwords etc diff --git a/perl/DXM.pm b/perl/DXM.pm index 9be30989..80b2fbc7 100644 --- a/perl/DXM.pm +++ b/perl/DXM.pm @@ -21,13 +21,30 @@ require Exporter; @EXPORT = qw(msg); %msgs = ( + addr => 'Address set to: $_[0]', + anns => 'Announce flag set on $_[0]', + annu => 'Announce flag unset on $_[0]', + conother => 'Sorry $_[0] you are connected on another port', + concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster', + dxs => 'DX Spots flag set on $_[0]', + dxu => 'DX Spots flag unset on $_[0]', + e1 => 'Invalid command', + e2 => 'Error: $_[0]', + e3 => '$_[0]: $_[1] not found', + email => 'E-mail address set to: $_[0]', + heres => 'Here set on $_[0]', + hereu => 'Here unset on $_[0]', + homebbs => 'Home BBS set to: $_[0]', + homenode => 'Home Node set to: $_[0]', l1 => 'Sorry $_[0], you are already logged on on another channel', l2 => 'Hello $_[0], this is $main::mycall located in $main::myqth', + m2 => '$_[0] Information: $_[1]', pr => '$_[0] de $main::mycall $main::cldate $main::ztime >', - e1 => 'Invalid command', - e2 => 'Error: $_[0]', - conother => 'Sorry $_[0] you are connected on another port', - concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster', + prx => '$main::$mycall >', + talks => 'Talk flag set on $_[0]', + talku => 'Talk flag unset on $_[0]', + wwvs => 'WWV flag set on $_[0]', + wwvu => 'WWV flag unset on $_[0]', ); sub msg @@ -35,7 +52,6 @@ sub msg my $self = shift; my $s = $msgs{$self}; return "unknown message '$self'" if !defined $s; - - return eval '"'. $s . '"'; + return eval qq("$s"); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 92e3b0d0..1f224766 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -26,7 +26,6 @@ sub start my $call = $self->call; # do we have him connected on the cluster somewhere else? - if (DXCluster->get $self->pc38(); $self->pc18(); $self->{state} = 'incoming'; @@ -61,5 +60,16 @@ sub finish # All the various PC routines # +sub pc18 +{ + +} + +sub pc38 +{ + +} + + 1; __END__ diff --git a/perl/DXUser.pm b/perl/DXUser.pm index f5f7e049..b593a6b2 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -20,19 +20,27 @@ $filename = undef; # hash of valid elements and a simple prompt %valid = ( - call => 'Callsign', - alias => 'Real Callsign', - name => 'Name', - qth => 'Home QTH', - lat => 'Latitude', - long => 'Longtitude', - qra => 'Locator', - email => 'E-mail Address', - priv => 'Privilege Level', - lastin => 'Last Time in', - passwd => 'Password', - addr => 'Full Address', - 'sort' => 'Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS + call => '0,Callsign', + alias => '0,Real Callsign', + name => '0,Name', + qth => '0,Home QTH', + lat => '0,Latitude,slat', + long => '0,Longitude,slong', + qra => '0,Locator', + email => '0,E-mail Address', + priv => '9,Privilege Level', + lastin => '0,Last Time in,cldatetime', + passwd => '9,Password', + addr => '0,Full Address', + sort => '0,Type of User', # A - ak1a, U - User, S - spider cluster, B - BBS + wwv => '0,Want WWV,yesno', + talk => '0,Want Talk,yesno', + ann => '0,Want Announce,yesno', + here => '0,Here Status,yesno', + xpert => '0,Expert Status,yesno', + bbs => '0,Home BBS', + node => '0,Home Node', + dx => '0,DX Spots,yesno', ); sub AUTOLOAD @@ -44,7 +52,11 @@ sub AUTOLOAD $name =~ s/.*:://o; die "Non-existant field '$AUTOLOAD'" if !$valid{$name}; - @_ ? $self->{$name} = shift : $self->{$name} ; + if (@_) { + $self->{$name} = shift; + $self->put(); + } + return $self->{$name}; } # diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 3ce68498..44ef7312 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -10,7 +10,8 @@ package DXUtil; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(atime ztime cldate +@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf + print_all_fields ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @@ -46,4 +47,79 @@ sub cldate return $buf; } +# return a cluster style date time +sub cldatetime +{ + my $t = shift; + my $date = cldate($t); + my $time = ztime($t); + return "$date $time"; +} + +# turn a latitude in degrees into a string +sub slat +{ + my $n = shift; + my ($deg, $min, $let); + $let = $n >= 0 ? 'N' : 'S'; + $n = abs $n; + $deg = int $n; + $min = int (($n - $deg) * 60); + return "$deg $min $let"; +} +# turn a longitude in degrees into a string +sub slong +{ + my $n = shift; + my ($deg, $min, $let); + $let = $n >= 0 ? 'E' : 'W'; + $n = abs $n; + $deg = int $n; + $min = int (($n - $deg) * 60); + return "$deg $min $let"; +} + +# turn a true into 'yes' and false into 'no' +sub yesno +{ + my $n = shift; + return $n ? $main::yes : $main::no; +} + +# format a prompt with its current value and return it with its privilege +sub promptf +{ + my ($line, $value) = @_; + my ($priv, $prompt, $action) = split ',', $line; + + # if there is an action treat it as a subroutine and replace $value + if ($action) { + my $q = qq{\$value = $action(\$value)}; + eval $q; + } + $prompt = sprintf "%15s: %s", $prompt, $value; + return ($priv, $prompt); +} + +# print all the fields for a record according to privilege +# +# The prompt record is of the format ',[,' +# and is expanded by promptf above +# +sub print_all_fields +{ + my $self = shift; # is a dxchan + my $ref = shift; # is a thingy with field_prompt and fields methods defined + my @out = @_; + + my @fields = $ref->fields; + my $field; + my @out; + + foreach $field (sort @fields) { + my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); + push @out, $ans if ($self->priv >= $priv); + } + return @out; +} diff --git a/perl/DXVars.pm b/perl/DXVars.pm index 39549e64..5baf3a67 100644 --- a/perl/DXVars.pm +++ b/perl/DXVars.pm @@ -59,6 +59,12 @@ $debugfn = "/tmp/debug_cluster"; # the version of DX cluster (tm) software I am masquerading as $myprot = "5447"; +# your favorite way to say 'Yes' +$yes = 'Yes'; + +# your favorite way to say 'No' +$no = 'No'; + # default hopcount to use - note this will override any incoming hop counts, if they are greater $def_hopcount = 7; diff --git a/perl/client.pl b/perl/client.pl index c3efad34..c5b4bbec 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -118,7 +118,7 @@ $call = uc shift @ARGV; $call = uc $mycall if !$call; $connsort = lc shift @ARGV; $connsort = 'local' if !$connsort; -$mode = ($connsort =~ /^ax/) ? 1 : 2; +$mode = ($connsort =~ /^ax/o) ? 1 : 2; setmode(); #select STDOUT; $| = 1; @@ -131,5 +131,16 @@ $SIG{'HUP'} = \&sig_term; $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket); $conn->send_now("A$call|$connsort"); Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); -Msg->event_loop(); + +$lasttime = time; +for (;;) { + my $t; + Msg->event_loop(1, 0.010); + $t = time; + if (t > $lasttime+660 && $connsort =~ /^ax/o) { # every e + print pack('xx'); + STDOUT->fflush(); + $lasttime = $t; + } +} diff --git a/perl/cluster.pl b/perl/cluster.pl index 435d0087..79c5b5c8 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -56,8 +56,9 @@ sub rec if (!defined $dxchan) { my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; my $user = DXUser->get($call); - $user = DXUser->new($call) if !defined $user; - $user->sort('U') if (!$user->sort()); + if (!defined $user) { + $user = DXUser->new($call); + } my $sort = $user->sort(); # is there one already connected? @@ -80,6 +81,13 @@ sub rec return; } + # set some necessary flags on the user if they are connecting + $user->wwv(1) if !$user->wwv(); + $user->talk(1) if !$user->talk(); + $user->ann(1) if !$user->ann(); + $user->here(1) if !$user->here(); + $user->sort('U') if !$user->sort(); + # create the channel $dxchan = DXCommandmode->new($call, $conn, $user) if ($sort eq 'U'); $dxchan = DXProt->new($call, $conn, $user) if ($sort eq 'A'); -- 2.43.0