From 8e45a3dac2e136dc0c9d6f1e78f8c048a8d7ba21 Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 30 Jul 2000 11:16:12 +0000 Subject: [PATCH] 1. Added talk mode so that I don't have to keep typing T all the time. 2. fiddled around with storing of Debug messages a bit more. 3. bomb proofed the type command. 4. started the objectifying for talk, dx and announcements. --- Changes | 3 ++ cmd/Commands_en.hlp | 23 ++++++++- cmd/talk.pl | 73 ++++++++++++++------------- cmd/type.pl | 5 +- perl/AnnTalk.pm | 1 + perl/DXChannel.pm | 3 +- perl/DXCommandmode.pm | 113 +++++++++++++++++++++++++++++++++++------- perl/DXDebug.pm | 30 +++++++---- perl/DXProt.pm | 22 ++++++-- perl/DXProtout.pm | 12 ++++- perl/Messages | 4 ++ perl/client.pl | 2 +- 12 files changed, 214 insertions(+), 77 deletions(-) diff --git a/Changes b/Changes index d35eb5a5..441d9623 100644 --- a/Changes +++ b/Changes @@ -6,6 +6,9 @@ count of 1. sequentially reading the data directly and only 'get'ting the ones that are nodes. 3. did the same for show/isolate and show/lockout. +4. Added talk mode so that I don't have to keep typing T all the time. +5. fiddled around with storing of Debug messages a bit more. +6. bomb proofed the type command. 28Jul00======================================================================= 1. fixed watchdbg midnight rollover loop and removed the date part of the date/time translation to leave just the time. diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 5ef9126f..47645f9e 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -911,8 +911,8 @@ They will all match. If there is no password you will still be offered numbers but nothing will happen when you input a string. Any match is case sensitive. -=== 0^TALK ^Send a text message to another station -=== 0^TALK > ^Send a text message to another station via a node +=== 0^TALK []^Send a text message to another station +=== 0^TALK > []^Send a text message to another station via a node Send a short message to any other station that is visible on the cluster system. You can send it to anyone you can see with a SHOW/CONFIGURATION command, they don't have to be connected locally. @@ -925,6 +925,25 @@ If you know that G3JNB is likely to be present on GB7TLH, but you can only see GB7TLH in the SH/C list but with no users, then you would use the second form of the talk message. +If you want to have a ragchew with someone you can leave the text message +out and the system will go into 'Talk' mode. What this means is that a +short message is sent to the recipient telling them that you are in a +'Talking' frame of mind and then you just type - everything you send will +go to the station that you asked for. + +All the usual announcements, spots and so on will still come out on your +terminal. + +If you want to do something (such as send a spot) you preceed the normal +command with a '/' character, eg:- + + /DX 14001 G1TLH What's a B class licensee doing on 20m CW? + /HELP talk + +To leave talk mode type: + + /EX + === 0^TYPE /^Look at the contents of a file in one of the fileareas Type out the contents of a file in a filearea. So, for example, in filearea 'bulletins' you want to look at file 'arld051' you would diff --git a/cmd/talk.pl b/cmd/talk.pl index fa7ade22..9cdd1c58 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -6,51 +6,54 @@ # $Id$ # -my ($self, $line) = @_; -my @argv = split /\s+/, $line; # generate an argv -my $to = uc $argv[0]; +my ($self, $inline) = @_; +my $to; my $via; -my $from = $self->call(); +my $line; +my $from = $self->call; my @out; -# have we a callsign and some text? -return (1, $self->msg('e8')) if @argv < 2; +# analyse the line there are four situations... +# 1) talk call +# 2) talk call +# 3) talk call>node +# 4) talk call>node text +# -if ($argv[1] eq '>') { - $via = uc $argv[2]; - $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//; +($to, $via, $line) = $inline =~ /^\s*([A-Za-z0-9\-]+)\s*>([A-Za-z0-9\-]+)(.*)$/; +if ($via) { + $line =~ s/\s+// if $line; } else { - $line =~ s/^$argv[0]\s*//; + ($to, $line) = split /\s+/, $inline, 2; } +$to = uc $to if $to; +$via = uc $via if $via; my $call = $via ? $via : $to; -my $ref = DXCluster->get_exact($call); # try an exact call -$ref = DXCluster->get($call) unless $ref; # try one ignoring SSID -$ref = DXChannel->get($call) unless $ref; # is it local? - -# if we haven't got an explicit via and we can't see them, try their node -unless ($ref || $via) { - my $user = DXUser->get_current($call); - $ref = DXCluster->get_exact($user->node) if $user; +my $clref = DXCluster->get_exact($call); # try an exact call +my $dxchan = $clref->dxchan if $clref; +return (1, $self->msg('e7', $call)) unless $dxchan; + +# if there is a line send it, otherwise add this call to the talk list +# and set talk mode for command mode +if ($line) { + $dxchan->talk($self->call, $to, $via, $line) if $dxchan; +} else { + my $s = "$to>" . $dxchan->call; + my $ref = $self->talklist; if ($ref) { - $via = $user->node; - push @out, "trying via $via.."; + unless (grep { $_ eq $s } @$ref) { + $dxchan->talk($self->call, $to, $via, $self->msg('talkstart')); + $self->state('talk'); + push @$ref, $s; + } + } else { + $self->talklist([ $s ]); + $dxchan->talk($self->call, $to, $via, $self->msg('talkstart')); + push @out, $self->msg('talkinst'); + $self->state('talk'); } -} -return (1, "$call not visible on the cluster") if !$ref; - -# change ^ into : for transmission -$line =~ s/\^/:/og; - -my $dxchan = DXCommandmode->get($to); # is it for us? -if ($dxchan && $dxchan->is_user) { - $dxchan->send("$to de $from $line") if $dxchan->talk; - Log('talk', $to, $from, $main::mycall, $line); -} else { - $line =~ s/\^//og; # remove any ^ characters - my $prot = DXProt::pc10($from, $to, $via, $line); - DXProt::route(undef,$via?$via:$to, $prot); - Log('talk', $to, $from, $via?$via:$main::mycall, $line); + push @out, $self->talk_prompt; } return (1, @out); diff --git a/cmd/type.pl b/cmd/type.pl index e525f94e..df289e69 100644 --- a/cmd/type.pl +++ b/cmd/type.pl @@ -16,9 +16,8 @@ my @slot; if (@f) { my $fn = lc $f[0]; - $fn =~ s/\\/\//og; - $fn =~ s/\.//og; - $fn =~ s/^\///og; + $fn =~ s([^A-Za-z0-9_/])()g; + $fn =~ s(^/+)(); $root = "$root/$fn"; } diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index faa644a3..5bd44fd4 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -53,5 +53,6 @@ sub listdups return @out; } + 1; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 2758e64d..8b71dbff 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -86,6 +86,7 @@ use vars qw(%channels %valid); pingtime => '5,Ping totaltime,parray', pingave => '0,Ping ave time', logininfo => '9,Login info req,yesno', + talklist => '0,Talk List,parray', ); # object destruction @@ -361,7 +362,7 @@ sub state dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n"); # if there is any queued up broadcasts then splurge them out here - if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'convers')) { + if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'talk')) { $self->send (@{$self->{delayed}}); delete $self->{delayed}; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 60626ef4..ab82d904 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -177,30 +177,88 @@ sub normal } delete $self->{passwd}; $self->state('prompt'); - } else { - @ans = run_cmd($self, $cmdline); # if length $cmdline; - - if ($self->{pagelth} && @ans > $self->{pagelth}) { - my $i; - for ($i = $self->{pagelth}; $i-- > 0; ) { - my $line = shift @ans; - $line =~ s/\s+$//o; # why am having to do this? - $self->send($line); + } elsif ($self->{state} eq 'talk') { + if ($cmdline =~ m{^(?:/EX|/ABORT)}i) { + for (@{$self->{talklist}}) { + my $ent = $_; + my ($to, $via) = $ent =~ /(\S+)>(\S+)/; + my $dxchan = DXChannel->get($via); + $dxchan->talk($self->{call}, $to, $via, $self->msg('talkend')) if $dxchan; } - $self->{pagedata} = \@ans; - $self->state('page'); - $self->send($self->msg('page', scalar @ans)); - } else { - for (@ans) { - $self->send($_) if $_; + $self->state('prompt'); + delete $self->{talklist}; + } elsif ($cmdline =~ m(^/\w+)) { + $cmdline =~ s(^/)(); + $self->send_ans(run_cmd($self, $cmdline)); + $self->send($self->talk_prompt); + } elsif ($self->{talklist} && @{$self->{talklist}}) { + # send what has been said to whoever is in this person's talk list + for (@{$self->{talklist}}) { + my $ent = $_; + my ($to, $via) = $ent =~ /(\S+)>(\S+)/; + my $dxchan = DXChannel->get($via); + if ($dxchan && DXCluster->get_exact($to)) { + $dxchan->talk($self->{call}, $to, $via, $cmdline); + } else { + $self->send($self->msg('disc2', $via ? $via : $to)); + my @l = grep { $_ ne $ent } @{$self->{talklist}}; + if (@l) { + $self->{talklist} = \@l; + } else { + delete $self->{talklist}; + $self->state('prompt'); + } + } } - } + $self->send($self->talk_prompt) if $self->{state} eq 'talk'; + } else { + # for safety + $self->state('prompt'); + } + } else { + $self->send_ans(run_cmd($self, $cmdline)); } # send a prompt only if we are in a prompt state $self->prompt() if $self->{state} =~ /^prompt/o; } +sub talk_prompt +{ + my $self = shift; + my @call; + for (@{$self->{talklist}}) { + my ($to, $via) = /(\S+)>(\S+)/; + push @call, $to; + } + return $self->msg('talkprompt', join(',', @call)); +} + +# +# send a load of stuff to a command user with page prompting +# and stuff +# + +sub send_ans +{ + my $self = shift; + + if ($self->{pagelth} && @_ > $self->{pagelth}) { + my $i; + for ($i = $self->{pagelth}; $i-- > 0; ) { + my $line = shift @_; + $line =~ s/\s+$//o; # why am having to do this? + $self->send($line); + } + $self->{pagedata} = \@_; + $self->state('page'); + $self->send($self->msg('page', scalar @_)); + } else { + for (@_) { + $self->send($_) if $_; + } + } +} # # this is the thing that runs the command, it is done like this for the # benefit of remote command execution @@ -272,7 +330,7 @@ sub run_cmd }; if ($@) { - cluck($@); + #cluck($@); return (DXDebug::shortmess($@)); }; } @@ -559,5 +617,26 @@ sub find_cmd_name { return $package; } +# send a talk message here +sub talk +{ + my ($self, $from, $to, $via, $line) = @_; + $line =~ s/\\5E/\^/g; + $self->send("$to de $from $line") if $self->{talk}; + Log('talk', $to, $from, $main::mycall, $line); +} + +# send an announce +sub announce +{ + +} + +# send a dx spot +sub dx_spot +{ + +} + 1; __END__ diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index b42db66d..a1c63407 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -18,7 +18,7 @@ use vars qw(%dbglevel $fp); use DXUtil; use DXLog (); -use Carp; +use Carp qw(cluck); %dbglevel = (); $fp = DXLog::new('debug', 'dat', 'd'); @@ -28,13 +28,13 @@ $fp = DXLog::new('debug', 'dat', 'd'); if (!defined $DB::VERSION) { local $^W=0; eval qq( sub confess { - \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::_store(Carp::longmess(\@_)); - exit(-1); + \$SIG{__DIE__} = 'DEFAULT'; + DXDebug::_store(\$@, Carp::shortmess(\@_)); + exit(-1); } - sub confess { + sub croak { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::_store(Carp::shortmess(\@_)); + DXDebug::_store(\$@, Carp::longmess(\@_)); exit(-1); } sub carp { DXDebug::_store(Carp::shortmess(\@_)); } @@ -42,15 +42,23 @@ if (!defined $DB::VERSION) { ); CORE::die(Carp::shortmess($@)) if $@; -} +} else { + eval qq( sub confess { Carp::confess(\@_); }; + sub cluck { Carp::cluck(\@_); }; + ); +} sub _store { my $t = time; for (@_) { - $fp->writeunix($t, "$t^$_"); - print STDERR $_; + chomp; + my @l = split /\n/; + for (@l) { + print "$_\n" if defined \*STDOUT; + $fp->writeunix($t, "$t^$_"); + } } } @@ -58,8 +66,8 @@ sub dbginit { # add sig{__DIE__} handling if (!defined $DB::VERSION) { - $SIG{__WARN__} = sub { _store(Carp::shortmess(@_)); }; - $SIG{__DIE__} = sub { _store(Carp::shortmess(@_)); }; + $SIG{__WARN__} = sub { _store($@, Carp::shortmess(@_)); }; + $SIG{__DIE__} = sub { _store($@, Carp::longmess(@_)); }; } } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index a2f77347..65ad93f9 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -996,7 +996,7 @@ sub send_dx_spot } elsif ($dxchan->is_user && $dxchan->{dx}) { my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]); $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1040,7 +1040,7 @@ sub send_wwv_spot } elsif ($dxchan->is_user && $dxchan->{wwv}) { my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1083,7 +1083,7 @@ sub send_wcy_spot } elsif ($dxchan->is_user && $dxchan->{wcy}) { my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1147,7 +1147,7 @@ sub send_announce next if $target eq 'SYSOP' && $dxchan->{priv} < 5; my $buf = "$to$target de $_[0]: $text"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1298,7 +1298,7 @@ sub broadcast_list $s =~ s/\a//og unless $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($s); } else { $dxchan->delay($s); @@ -1408,5 +1408,17 @@ sub disconnect $self->SUPER::disconnect; } + +# +# send a talk message to this thingy +# +sub talk +{ + my ($self, $from, $to, $via, $line) = @_; + + $line =~ s/\^/\\5E/g; # remove any ^ characters + $self->send(DXProt::pc10($from, $to, $via, $line)); + Log('talk', $self->call, $from, $via?$via:$main::mycall, $line); +} 1; __END__ diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 3d3a46bc..8cc5137f 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -27,8 +27,16 @@ use strict; sub pc10 { my ($from, $to, $via, $text) = @_; - my $user2 = $via ? $to : ' '; - my $user1 = $via ? $via : $to; + my ($user1, $user2); + if ($via && $via ne $to) { + $user1 = $via; + $user2 = $to; + } else { + $user2 = ' '; + $user1 = $to; + } +# my $user2 = $via ? $to : ' '; +# my $user1 = $via ? $via : $to; $text = unpad($text); $text = ' ' if !$text; return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; diff --git a/perl/Messages b/perl/Messages index 56fcb345..7918a6e1 100644 --- a/perl/Messages +++ b/perl/Messages @@ -187,6 +187,10 @@ package DXM; time3 => '$_[0] $_[1]', talks => 'Talk flag set on $_[0]', talku => 'Talk flag unset on $_[0]', + talkend => 'Finished talking to you', + talkinst => 'Entering Talkmode, /EX to end, / to run a command', + talkprompt => 'Talk ($_[0])>', + talkstart => 'Starting talking to you', usernf => '*** User record for $_[0] not found ***', wwvs => 'WWV flag set on $_[0]', wwvu => 'WWV flag unset on $_[0]', diff --git a/perl/client.pl b/perl/client.pl index 7a539cf2..740a9e72 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -289,7 +289,7 @@ sub dochat $line =~ s/\r/\n/g; chomp; } - dbg('connect', "received \"$line\""); + dbg('connect', map { "received \"$_\"" } split /\n/, $line); if ($abort && $line =~ /$abort/i) { dbg('connect', "aborted on /$abort/"); cease(11); -- 2.43.0