From fe4f4e3751da3786d25df2fe2fba104523de095d Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 12 Jan 2005 20:41:30 +0000 Subject: [PATCH] add user startup script maintenance --- Changes | 3 +++ cmd/Commands_en.hlp | 30 ++++++++++++++++++++++----- cmd/send.pl | 1 + cmd/set/startup.pl | 24 ++++++++++++++++++++++ cmd/show/startup.pl | 16 +++++++++++++++ cmd/unset/startup.pl | 16 +++++++++++++++ perl/DXCommandmode.pm | 48 +++++++++++++++++++++++++++++++++++++++++++ perl/Messages | 7 +++++-- perl/Script.pm | 43 ++++++++++++++++++++++++++++++++++++-- 9 files changed, 179 insertions(+), 9 deletions(-) create mode 100644 cmd/set/startup.pl create mode 100644 cmd/show/startup.pl create mode 100644 cmd/unset/startup.pl diff --git a/Changes b/Changes index a2d22cd3..155e5d04 100644 --- a/Changes +++ b/Changes @@ -15,6 +15,9 @@ as before. comment to be recorded. 6. Fix bug counting backwards over a leap year in Julian.pm which meant that sh/dxstats doesn't start at 'yesterday' anymore. +7. Added set/startup and show/startup commands to allow users and sysops +to create and display startup scripts. There is also an unset/startup to +remove a script. 27Dec04======================================================================= 1. add improved VE data from Charlie K1XX. You should update usdb as well. 22Dec04======================================================================= diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index eaa862ef..3aecaab0 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -1724,10 +1724,6 @@ The standard prompt is defined as: UNSET/PROMPT will undo the SET/PROMPT command and set your prompt back to normal. -=== 5^SET/SPIDER [..]^Make the callsign an DXSpider node -Tell the system that the call(s) are to be treated as DXSpider node and -fed new style DX Protocol rather normal user commands. - === 9^SET/SYS_QRA ^Set your cluster QRA Grid locator === 0^SET/QRA ^Set your QRA Grid locator Tell the system what your QRA (or Maidenhead) locator is. If you have not @@ -1755,7 +1751,27 @@ cannot use DX, ANN etc. The only exception to this is that a non-registered user can TALK or SEND messages to the sysop. - + +=== 6^SET/STARTUP ^Create a user startup script +=== 0^SET/STARTUP^Create your own startup script +=== 6^UNSET/STARTUP ^Remove a user startup script +=== 0^UNSET/STARTUP^Remove your own startup script +Create a startup script of DXSpider commands which will be executed +everytime that you login into this node. You can only input the whole +script afresh, it is not possible to 'edit' it. Inputting a new script is +just like typing in a message using SEND. To finish inputting type: /EX +on a newline, to abandon the script type: /ABORT. + +You may find the (curiously named) command BLANK useful to break +up the output. If you simply want a blank line, it is easier to +input one or more spaces and press the key. + +You can remove your startup script with UNSET/STARTUP. + +=== 5^SET/SPIDER [..]^Make the callsign an DXSpider node +Tell the system that the call(s) are to be treated as DXSpider node and +fed new style DX Protocol rather normal user commands. + === 0^SET/TALK^Allow TALK messages to come out on your terminal === 0^UNSET/TALK^Stop TALK messages coming out on your terminal @@ -2285,6 +2301,10 @@ So for example:- SH/SAT AO-10 SH/SAT FENGYUN1 12 2 +=== 6^SHOW/STARTUP ^View a user startup script +=== 0^SHOW/STARTUP^View your own startup script +View the contents of a startup script created with SET/STARTUP. + === 6^SHOW/STATION ALL []^Show list of users in the system === 0^SHOW/STATION [ ..]^Show information about a callsign Show the information known about a callsign and whether (and where) diff --git a/cmd/send.pl b/cmd/send.pl index e78aabd3..722200b7 100644 --- a/cmd/send.pl +++ b/cmd/send.pl @@ -18,6 +18,7 @@ # my ($self, $line) = @_; return (1, $self->msg('e5')) if $self->remotecmd; +return (1, $self->msg('e36')) unless $self->state =~ /^prompt/; my @out; my $loc = $self->{loc} = {}; diff --git a/cmd/set/startup.pl b/cmd/set/startup.pl new file mode 100644 index 00000000..0c0c24b9 --- /dev/null +++ b/cmd/set/startup.pl @@ -0,0 +1,24 @@ +# +# create or replace a startup script +# +# Copyright (c) 2005 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->remotecmd; +return (1, $self->msg('e5')) if $line && $self->priv < 6; +return (1, $self->msg('e36')) unless $self->state =~ /^prompt/; + +my @out; +my $loc = $self->{loc} = { call => ($line || $self->call), + endaction => "store_startup_script", + lines => [], + }; +# find me and set the state and the function on my state variable to +# keep calling me for every line until I relinquish control +$self->func("do_entry_stuff"); +$self->state('enterbody'); +push @out, $self->msg('m8'); +return (1, @out); + diff --git a/cmd/show/startup.pl b/cmd/show/startup.pl new file mode 100644 index 00000000..1f160c1b --- /dev/null +++ b/cmd/show/startup.pl @@ -0,0 +1,16 @@ +# +# print a startup script +# +# Copyright (c) 2005 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->remotecmd; +return (1, $self->msg('e5')) if $line && $self->priv < 5; + +my @out; + +my $s = Script->new($line || $self->call); +push @out, $s->lines if $s; +return (1, @out); diff --git a/cmd/unset/startup.pl b/cmd/unset/startup.pl new file mode 100644 index 00000000..36ee830d --- /dev/null +++ b/cmd/unset/startup.pl @@ -0,0 +1,16 @@ +# +# remove a startup script +# +# Copyright (c) 2005 Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->remotecmd; +return (1, $self->msg('e5')) if $line && $self->priv < 5; + +my @out; + +Script::erase($line || $self->call); +push @out, $self->msg('done'); +return (1, @out); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 10045442..7b69ad22 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -948,6 +948,54 @@ sub broadcast_debug } } +sub do_entry_stuff +{ + my $self = shift; + my $line = shift; + my @out; + + if ($self->state eq 'enterbody') { + my $loc = $self->{loc} || confess "local var gone missing" ; + if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") { + no strict 'refs'; + push @out, $loc->{endaction}($self); + $self->func(undef); + $self->state('prompt'); + } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") { + push @out, $self->msg('m10'); + delete $loc->{lines}; + delete $self->{loc}; + $self->func(undef); + $self->state('prompt'); + } else { + push @{$loc->{lines}}, length($line) > 0 ? $line : " "; + # i.e. it ain't and end or abort, therefore store the line + } + } else { + confess "Invalid state $self->{state}"; + } + return @out; +} + +sub store_startup_script +{ + my $self = shift; + my $loc = $self->{loc} || confess "local var gone missing" ; + my @out; + my $call = $loc->{call} || confess "callsign gone missing"; + confess "lines array gone missing" unless ref $loc->{lines}; + my $r = Script::store($call, $loc->{lines}); + if (defined $r) { + if ($r) { + push @out, $self->msg('m19', $call, $r); + } else { + push @out, $self->msg('m20', $call); + } + } else { + push @out, "error opening startup script $call $!"; + } + return @out; +} 1; __END__ diff --git a/perl/Messages b/perl/Messages index a79debbc..e20adbd2 100644 --- a/perl/Messages +++ b/perl/Messages @@ -98,6 +98,7 @@ package DXM; e33 => '$_[0] is not a number of days or a valid date', e34 => 'Need a GROUP and some text', e35 => 'You are not a member of $_[0], join $_[0]', + e36 => 'You can only do this in normal user prompt state', echoon => 'Echoing enabled', echooff => 'Echoing disabled', @@ -171,9 +172,9 @@ package DXM; m5 => 'Sorry, I need a message number', m6 => 'Reply to: $_[0]', m7 => 'Subject : $_[0]', - m8 => 'Enter Message /EX to send or /ABORT to exit', + m8 => 'Enter lines of text, /EX to send or /ABORT to exit', m9 => 'New mail has arrived for you', - m10 => 'Message Aborted', + m10 => 'Message/Script Aborted', m11 => 'Message no $_[0] saved and directed to $_[1]', m12 => 'Message no $_[0] deleted', m13 => 'Message no $_[0] missing', @@ -182,6 +183,8 @@ package DXM; m16 => 'Need a Message number', m17 => 'Sorry, cannot send messages in $_[0] mode', m18 => 'Sorry, message $_[0] is currently set to KEEP', + m19 => 'Startup Script for $_[0] saved, $_[1] lines', + m20 => 'Empty Startup Script for $_[0] deleted', msg1 => 'Bulletin Messages Queued', msg2 => 'Private Messages Queued', msg3 => 'Msg $_[0]: $_[1] changed from $_[2] to $_[3]', diff --git a/perl/Script.pm b/perl/Script.pm index 3128dcde..8fdd8064 100644 --- a/perl/Script.pm +++ b/perl/Script.pm @@ -25,10 +25,17 @@ $main::branch += $BRANCH; my $base = "$main::root/scripts"; +sub clean +{ + my $s = shift; + $s =~ s/[^-\w\.]//g; + return $s; +} + sub new { my $pkg = shift; - my $script = shift; + my $script = clean(lc shift); my $fn = "$base/$script"; my $fh = new IO::File $fn; @@ -41,7 +48,7 @@ sub new } $fh->close; $self->{lines} = \@lines; - return $self; + return bless $self, $pkg; } sub run @@ -60,3 +67,35 @@ sub run } } } + +sub store +{ + my $call = clean(lc shift); + my @out; + my $ref = ref $_[0] ? shift : \@_; + my $count; + my $fn = "$base/$call"; + + rename $fn, "$fn.o" if -e $fn; + my $f = IO::File->new(">$fn") || return undef; + for (@$ref) { + $f->print("$_\n"); + $count++; + } + $f->close; + unlink $fn unless $count; + return $count; +} + +sub lines +{ + my $self = shift; + return @{$self->{lines}}; +} + +sub erase +{ + my $call = clean(lc shift); + my $fn = "$base/$call"; + unlink $fn; +} -- 2.43.0