6. Implemented PC49 delete/full from outside (kill full on the inside) R_1_12
authordjk <djk>
Tue, 15 Dec 1998 23:41:32 +0000 (23:41 +0000)
committerdjk <djk>
Tue, 15 Dec 1998 23:41:32 +0000 (23:41 +0000)
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
cmd/Aliases
cmd/Commands_en.hlp
cmd/kill.pl
cmd/show/wwv.pl
connect/gb7tlh
perl/DXProt.pm
perl/Geomag.pm
perl/client.pl

diff --git a/Changes b/Changes
index 2b81d77a34bdbc5ca4b5898ea9cef3b5ceb956fb..d8b126bdbb85c0c8ba08fa3e6deed14cc065f626 100644 (file)
--- 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
index e187ec88f3222a741ec88198dfd7efc097911c42..0d64571e56309b0b48316046af8b2e20e3511592 100644 (file)
@@ -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 => [
index 95a36b8b3e225f7f2e2bc34a98229381b56cc0f5..48b2704d860c6bb0b3f2f1bc42dd855e55cbbad1 100644 (file)
@@ -82,6 +82,16 @@ Look at the APROPOS <string> command which will search the help database
 for the <string> you specify and give you a list of likely commands
 to look at with HELP.
 
+=== 0^KILL <msgno> [<msgno..]^Delete a message from the local system
+Delete a message from the local system. You will only be able to delete messages
+that you have originated or been sent (unless you are the sysop).
+
+=== 5^KILL FULL <msgno> [<msgno..]^Delete a message from the whole cluster
+Delete a message (usually a 'bulletin') from the whole cluster system. 
+
+This uses the subject field, so any messages that have exactly the same subject
+will be deleted. Beware!
+
 === 9^LOAD/ALIASES^Reload the command alias table
 Reload the /spider/cmd/Aliases file after you have editted it. You will need to
 do this if you change this file whilst the cluster is running in order for the
@@ -312,6 +322,10 @@ together with the internal country no, the CQ and ITU regions.
 
 See also SHOW/DXCC
 
+=== 0^SHOW/WWV^Show last 10 WWV broadcasts
+=== 0^SHOW/WWV <n>^Show last <n> 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 
 
index b6d193fe48f276ac9b2b40a116c5074b6adfefa5..d3614c3632f4dd5e4e1ca40623ba23b8db54f5dc 100644 (file)
@@ -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";
 }
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..a8e4992a9e896a30f66cab9d35c51225dd97cbe3 100644 (file)
@@ -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);
index 18a1ac9b32a5027ae6e1c86c45aa38f401d195d7..de20f6e16414ad647a1d23311d0a05591f54bcde 100644 (file)
@@ -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
index 7bccfcb9acb3dfebd1f12760c4168aa51cc79b5f..f50b1e14907ea67133bf96b408ad1f89ed47d7c0 100644 (file)
@@ -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);
index 0fc16d06a83f934b913d291b6e8805c62c32e536..a63d19b66bbdef6d473e19b0a675eedd802c11a9 100644 (file)
@@ -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__;
index a2a690cad22a1bd362c7b1cb5b6818b5687d7344..cc185a17838622f4c2631464ca4ea5554947b39a 100755 (executable)
@@ -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