From 3643ef870e040d437448632209039477eac4e52c Mon Sep 17 00:00:00 2001 From: djk Date: Tue, 15 Dec 1998 23:41:32 +0000 Subject: [PATCH] 6. Implemented PC49 delete/full from outside (kill full on the inside) 7. Implemented the client command in connect scripts so that you can have different scripts for the same callsign. 8. Added sh/wwv command --- Changes | 5 ++- cmd/Aliases | 17 ++++++----- cmd/Commands_en.hlp | 14 +++++++++ cmd/kill.pl | 10 ++++++ cmd/show/wwv.pl | 33 ++++++++++++++++++++ connect/gb7tlh | 2 +- perl/DXProt.pm | 24 +++++++++------ perl/Geomag.pm | 74 +++++++++++++++++++++++++++++++++++++++++++++ perl/client.pl | 17 +++++++++-- 9 files changed, 176 insertions(+), 20 deletions(-) diff --git a/Changes b/Changes index 2b81d77a..d8b126bd 100644 --- a/Changes +++ b/Changes @@ -8,7 +8,10 @@ is only done on channels that are in state 'normal'. mods to the callsign, useful for sending manual PC protocol to unstick things. Also for sending anonymous messages to online users. 5. Stopped duplicate messages being stored (it receives them and then bins them) -6. Implemented PC49 delete/full from outside +6. Implemented PC49 delete/full from outside (kill full on the inside) +7. Implemented the client command in connect scripts so that you can have +different scripts for the same callsign. +8. Added sh/wwv command 13Dec98======================================================================== 1. Fixed VS6 lat/long in prefix_data and wpxloc.raw 2. Sorted out last in times for remote users diff --git a/cmd/Aliases b/cmd/Aliases index e187ec88..0d64571e 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -36,6 +36,7 @@ package CmdAlias; ], d => [ '^del', 'kill', 'kill', + '^del.*/fu', 'kill full', 'kill', '^di\w*/a\w*', 'directory all', 'directory', '^di\w*/b\w*', 'directory bulletins', 'directory', '^di\w*/n\w*', 'directory new', 'directory', @@ -81,14 +82,16 @@ package CmdAlias; s => [ '^set/nobe', 'unset/beep', 'unset/beep', '^set/nohe', 'unset/here', 'unset/here', - '^sh/c/n', 'show/configuration nodes', 'show/configuration', - '^sh/c$', 'show/configuration', 'show/configuration', - '^sh/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx', - '^sh/dx/(\d+)', 'show/dx $1', 'show/dx', - '^sh/dx/d(\d+)', 'show/dx from $1', 'show/dx', + '^sh.*/c/n', 'show/configuration nodes', 'show/configuration', + '^sh.*/c$', 'show/configuration', 'show/configuration', + '^sh.*/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx', + '^sh.*/dx/(\d+)', 'show/dx $1', 'show/dx', + '^sh.*/dx/d(\d+)', 'show/dx from $1', 'show/dx', '^sp$', 'send', 'send', - '^sb$', 'send noprivate', 'send', - ], + '^sb$', 'send noprivate', 'send', + '^sh.*/wwv/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv', + '^sh.*/wwv/(\d+)', 'show/wwv $1', 'show/wwv', + ], t => [ ], u => [ diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 95a36b8b..48b2704d 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -82,6 +82,16 @@ Look at the APROPOS command which will search the help database for the you specify and give you a list of likely commands to look at with HELP. +=== 0^KILL [ [^Show last WWV broadcasts +Display the most recent WWV information that has been received by the system + === 5^SHUTDOWN^Shutdown the cluster Shutdown the cluster and disconnect all the users diff --git a/cmd/kill.pl b/cmd/kill.pl index b6d193fe..d3614c36 100644 --- a/cmd/kill.pl +++ b/cmd/kill.pl @@ -13,6 +13,13 @@ my @out; my @body; my $ref; my $call = $self->call; +my $full; + +if ($f[0] =~ /^f/io) { + return (1, $self->msg('e5')) if $self->priv < 5; + $full = 1; + shift @f; +} # $DB::single = 1; @@ -29,6 +36,9 @@ for $msgno (@f) { next; } Log('msg', "Message $ref->{msgno} from $ref->{from} to $ref->{to} deleted by $call"); + if ($full) { + DXProt::broadcast_ak1a(DXProt::pc49($self->call, $ref->{subject}), $DXProt::me); + } $ref->del_msg; push @out, "Message $msgno deleted"; } diff --git a/cmd/show/wwv.pl b/cmd/show/wwv.pl index e69de29b..a8e4992a 100644 --- a/cmd/show/wwv.pl +++ b/cmd/show/wwv.pl @@ -0,0 +1,33 @@ +# +# print out the wwv stats +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; + +my $cmdline = shift; +my @f = split /\s+/, $cmdline; +my $f; +my @out; +my ($from, $to); + +$from = 0; +while ($f = shift @f) { # next field + # print "f: $f list: ", join(',', @list), "\n"; + if (!$from && !$to) { + ($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count? + next if $from && $to > $from; + } + if (!$to) { + ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? + next if $to; + } +} + +$to = 10 if !$to; + +push @out, "Date Hour SFI A K Forecast Logger"; +push @out, Geomag::print($from, $to, $main::systime); +return (1, @out); diff --git a/connect/gb7tlh b/connect/gb7tlh index 18a1ac9b..de20f6e1 100644 --- a/connect/gb7tlh +++ b/connect/gb7tlh @@ -4,4 +4,4 @@ connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh 'Connect' '' 'Connect' 'cluster' 'Connect' -client /usr/bin/perl /spider/perl/client.pl gb7tlh ax25 +client gb7tlh ax25 diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7bccfcb9..f50b1e14 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -161,7 +161,7 @@ sub normal my @list; if ($field[4] eq '*') { # sysops - $target = "Sysops"; + $target = "SYSOP"; @list = map { $_->priv >= 5 ? $_ : () } get_all_users(); } elsif ($field[4] gt ' ') { # speciality list handling my ($name) = split /\./, $field[4]; @@ -270,6 +270,8 @@ sub normal if (!$user) { $user = DXUser->new($call); $user->sort('A'); + $user->priv(1); # I have relented and defaulted nodes + $self->{priv} = 1; # to user RCMDs allowed $user->homenode($call); $user->node($call); } @@ -334,15 +336,19 @@ sub normal if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering - $self->{remotecmd} = 1; # for the benefit of any command that needs to know - my @in = (DXCommandmode::run_cmd($self, $field[3])); - for (@in) { - s/\s*$//og; - $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); - Log('rcmd', 'out', $field[2], $_); + unless ($field[3] =~ /rcmd/i) { # not allowed to relay RCMDS! + if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering + $self->{remotecmd} = 1; # for the benefit of any command that needs to know + my @in = (DXCommandmode::run_cmd($self, $field[3])); + for (@in) { + s/\s*$//og; + $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); + Log('rcmd', 'out', $field[2], $_); + } + delete $self->{remotecmd}; } - delete $self->{remotecmd}; + } else { + $self->send(pc35($main::mycall, $field[2], "$main::mycall:Tut tut tut...!")); } } else { route($field[1], $line); diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 0fc16d06..a63d19b6 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -135,5 +135,79 @@ sub forecast @_ ? $forecast = shift : $forecast ; } +# +# print some items from the log backwards in time +# +# This command outputs a list of n lines starting from line $from to $to +# +sub print +{ + my $self = $fp; + my $from = shift; + my $to = shift; + my @date = $self->unixtoj(shift); + my $pattern = shift; + my $search; + my @in; + my @out; + my $eval; + my $count; + + $search = 1; + $eval = qq( + my \$c; + my \$ref; + for (\$c = \$#in; \$c >= 0; \$c--) { + \$ref = \$in[\$c]; + if ($search) { + \$count++; + next if \$count < $from; + push \@out, print_item(\$ref); + last LOOP if \$count >= \$to; # stop after n + } + } + ); + + $self->close; # close any open files + + my $fh = $self->open(@date); +LOOP: + while ($count < $to) { + my @spots = (); + if ($fh) { + while (<$fh>) { + chomp; + push @in, [ split '\^' ] if length > 2; + } + eval $eval; # do the search on this file + return ("Spot search error", $@) if $@; + } + $fh = $self->openprev(); # get the next file + last if !$fh; + } + + return @out; +} + +# +# the standard log printing interpreting routine. +# +# every line that is printed should call this routine to be actually visualised +# +# Don't really know whether this is the correct place to put this stuff, but where +# else is correct? +# +# I get a reference to an array of items +# +sub print_item +{ + my $r = shift; + my @ref = @$r; + my $d = cldate($ref[1]); + my ($t) = (gmtime($ref[1]))[2]; + + return sprintf("$d %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]); +} + 1; __END__; diff --git a/perl/client.pl b/perl/client.pl index a2a690ca..cc185a17 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -374,6 +374,15 @@ if ($loginreq) { } } +# handle callsign and connection type firtling +sub doclient +{ + my $line = shift; + my @f = split /\s+/, $line; + $call = uc $f[0] if $f[0]; + $csort = $f[1] if $f[1]; +} + # is this an out going connection? if ($connsort eq "connect") { my $mcall = lc $call; @@ -391,10 +400,14 @@ if ($connsort eq "connect") { doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io; doabort($1) if /^\s*a\w*\s+(.*)/io; dotimeout($1) if /^\s*t\w*\s+(\d+)/io; - dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io; + if (/\s*cl\w+\s+(.*)/io) { + doclient($1); + last; + } } - dbg('connect', "Connected to $call, starting normal protocol"); + dbg('connect', "Connected to $call ($csort), starting normal protocol"); dbgsub('connect'); # if we get here we are connected -- 2.34.1