added set/page and paging
authordjk <djk>
Sun, 29 Nov 1998 15:14:48 +0000 (15:14 +0000)
committerdjk <djk>
Sun, 29 Nov 1998 15:14:48 +0000 (15:14 +0000)
added logging for wwv, talk and announce

14 files changed:
cmd/Aliases
cmd/announce.pl
cmd/read.pl
cmd/set/page.pl [new file with mode: 0644]
cmd/show/cluster.pl [new file with mode: 0644]
cmd/show/log.pl [new file with mode: 0644]
cmd/talk.pl
perl/DXChannel.pm
perl/DXCluster.pm
perl/DXCommandmode.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/Messages
perl/cluster.pl

index 6089171fdfef31750bdc7d597a50727e036649d3..8c44c4028e790477284344cc51e63deafa9a6c0e 100644 (file)
@@ -56,6 +56,9 @@ package CmdAlias;
        k => [
        ],
        l => [
+         '^l$', 'directory', 'directory',
+         '^ll$', 'directory', 'directory',
+         '^ll/(\d+)', 'directory $1', 'directory',
        ],
        m => [
        ],
@@ -69,8 +72,10 @@ package CmdAlias;
          '^q', 'bye', 'bye',
        ],
        r => [
+         '^r$', 'read', 'read',
        ],
        s => [
+         '^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',
index 1f2d24ab397873b8ea3471a024e0ce89febb452d..f9d3fc4b285b8640c0cf04100ba49600634de184 100644 (file)
@@ -35,6 +35,7 @@ if ($sort eq "FULL") {
   $to = "LOCAL";
 }
 
+Log('ann', $to, $from, $line);
 DXProt::broadcast_list("To $to de $from <$t>: $line", @locals);
 if ($to ne "LOCAL") {
   $line =~ s/\^//og;    # remove ^ characters!
index a1352724bb486a95997cea6e3bb1ab90a60da767..e21a77e6eaf5d891791aa725ab081d2de665d73d 100644 (file)
@@ -24,16 +24,16 @@ if (@f == 0) {
   }
 }
 
-return (1, "Sorry, no new messages for you") if @f == 0;
+return (1, $self->msg('read1')) if @f == 0;
 
 for $msgno (@f) {
   $ref = DXMsg::get($msgno);
   if (!$ref) {
-    push @out, "Msg $msgno not found";
+    push @out, $self->msg('read2', $msgno);
        next;
   }
   if ($self->priv < 5 && $ref->private && $ref->to ne $self->call && $ref->from ne $self->call ) {
-    push @out, "Msg $msgno not available";
+    push @out, $self->msg('read3', $msgno);
        next;
   }
   push @out, sprintf "Msg: %d From: %s Date: %6.6s %5.5s Subj: %-30.30s", $msgno,
diff --git a/cmd/set/page.pl b/cmd/set/page.pl
new file mode 100644 (file)
index 0000000..f7dc64d
--- /dev/null
@@ -0,0 +1,13 @@
+#
+# set the page length for this invocation of the client
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+my $l = shift;
+$l = 20 if $l = 0;
+$l = 10 if $l < 10;
+$self->pagelth($l);
+return (1);
diff --git a/cmd/show/cluster.pl b/cmd/show/cluster.pl
new file mode 100644 (file)
index 0000000..6fe9b35
--- /dev/null
@@ -0,0 +1,4 @@
+#
+# show some statistics
+#
+return (1, DXCluster::cluster() );
diff --git a/cmd/show/log.pl b/cmd/show/log.pl
new file mode 100644 (file)
index 0000000..e69de29
index 23efabfc5e2b64999ecfe0345fe325ab013ece98..a53b213e1f756a07e7e340dc32c7e22fe41b2e8a 100644 (file)
@@ -26,10 +26,12 @@ return (1, "$call not visible on the cluster") if !$ref;
 my $dxchan = DXCommandmode->get($to);         # is it for us?
 if ($dxchan && $dxchan->is_user) {
   $dxchan->send("$to de $from $line");
+  Log('talk', $to, $from, $main::mycall, $line);
 } else {
   $line =~ s/\^//og;            # remove any ^ characters
   my $prot = DXProt::pc10($from, $to, $via, $line);
   DXProt::route($via?$via:$to, $prot);
+  Log('talk', $to, $from, $via?$via:$main::mycall, $line);
 }
 
 return (1, ());
index eb306e672a85aa4a77ef726025945d6f1d8474e6..58dc3b867741fcf13d5a105a901a4f150936dfde 100644 (file)
@@ -66,6 +66,8 @@ use vars qw(%channels %valid);
   pc34to => '9,last rcmd call',
   pc34t => '9,last rcmd time,atime',
   pings => '9,out/st pings',
+  pagelth => '0,Page Length',
+  pagedata => '9,Page Data Store',
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
index 98ceafa9c0d55170c1b220b9fcceda9b87842965..6daf65a3874a5ebfd29ba8326e45b13b733854d0 100644 (file)
@@ -92,6 +92,15 @@ sub showcall
   return $self->{call};
 }
 
+# the answer required by show/cluster
+sub cluster
+{
+       my $users = DXCommandmode::get_all();
+       my $uptime = main::uptime();
+       
+       return " $DXNode::nodes nodes, $users local / $DXNode::users total users  Max users $DXNode::maxusers  Uptime $uptime";
+}
+
 sub DESTROY
 {
   my $self = shift;
@@ -122,9 +131,6 @@ package DXNodeuser;
 use DXDebug;
 
 use strict;
-use vars qw($users);
-
-$users = 0;
 
 sub new 
 {
@@ -135,7 +141,6 @@ sub new
   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
   $self->{mynode} = $node;
   $node->{list}->{$call} = $self;     # add this user to the list on this node
-  $users++;
   dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
   $node->update_users;
   return $self;
@@ -151,12 +156,11 @@ sub del
   delete $DXCluster::cluster{$call};     # remove me from the cluster table
   dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
   $node->update_users;
-  $users-- if $users > 0;
 }
 
 sub count
 {
-  return $users;                 # + 1 for ME (naf eh!)
+  return $DXNode::users;                 # + 1 for ME (naf eh!)
 }
 
 no strict;
@@ -172,9 +176,12 @@ package DXNode;
 use DXDebug;
 
 use strict;
-use vars qw($nodes);
+use vars qw($nodes $users $maxusers);
 
 $nodes = 0;
+$users = 0;
+$maxusers = 0;
+
 
 sub new 
 {
@@ -217,11 +224,14 @@ sub update_users
 {
   my $self = shift;
   my $count = shift;
+  $users -= $self->{users};
   if ((keys %{$self->{list}})) {
     $self->{users} = (keys %{$self->{list}});
   } else {
     $self->{users} = $count;
   }
+  $users += $self->{users};
+  $maxusers = $users+$nodes if $users+$nodes > $maxusers;
 }
 
 sub count
index 8af394b8898d4852b6e9ca0656a3a1c5014e3313..ab8d9573dd4c4f8e446472cd71737f23bd889d67 100644 (file)
@@ -51,14 +51,17 @@ sub start
   my $user = $self->{user};
   my $call = $self->{call};
   my $name = $user->{name};
-
+  my $info = DXCluster::cluster();
+  
   $self->{name} = $name ? $name : $call;
   $self->send($self->msg('l2',$self->{name}));
   $self->send_file($main::motd) if (-e $main::motd);
+  $self->send("Cluster:$info");
   $self->send($self->msg('pr', $call));
   $self->state('prompt');                  # a bit of room for further expansion, passwords etc
   $self->{priv} = $user->priv;
   $self->{lang} = $user->lang;
+  $self->{pagelth} = 20;
   $self->{priv} = 0 if $line =~ /^(ax|te)/;     # set the connection priv to 0 - can be upgraded later
   $self->{consort} = $line;                # save the connection type
 
@@ -86,9 +89,56 @@ sub normal
 {
        my $self = shift;
        my $cmdline = shift;
+       my @ans;
+       
+       # remove leading and trailing spaces
+       $cmdline =~ s/^\s*(.*)\s*$/$1/;
        
-       my @ans = run_cmd($self, $cmdline);
-       $self->send(@ans) if @ans > 0;
+       if ($self->{state} eq 'prompt') {
+               @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);
+                       }
+                       $self->{pagedata} =  \@ans;
+                       $self->state('page');
+                       $self->send($self->msg('page', scalar @ans));
+               } else {
+                       for (@ans) {
+                               s/\s+$//o;                     # why ?????????
+                               $self->send($_);
+                       }
+               } 
+       } elsif ($self->{state} eq 'page') {
+               my $i = $self->{pagelth};
+               my $ref = $self->{pagedata};
+               my $tot = @$ref;
+               
+               # abort if we get a line starting in with a
+               if ($cmdline =~ /^a/io) {
+                       undef $ref;
+                       $i = 0;
+               }
+        
+               # send a tranche of data
+               while ($i-- > 0 && @$ref) {
+                       my $line = shift @$ref;
+                       $line =~ s/\s+$//o;            # why am having to do this? 
+                       $self->send($line);
+               }
+
+               # reset state if none or else chuck out an intermediate prompt
+               if ($ref && @$ref) {
+                       $tot -= $self->{pagelth};
+                       $self->send($self->msg('page', $tot));
+               } else {
+                       $self->state('prompt');
+               }
+       }
        
        # send a prompt only if we are in a prompt state
        $self->prompt() if $self->{state} =~ /^prompt/o;
@@ -118,10 +168,10 @@ sub run_cmd
   } else {
 
     # special case only \n input => " "
-    if ($cmdline eq " ") {
-         $self->prompt();
-         return;
-       }
+#    if ($cmdline eq " ") {
+#        $self->prompt();
+#        return;
+#      }
        
     # strip out //
     $cmdline =~ s|//|/|og;
@@ -167,7 +217,7 @@ sub run_cmd
                @ans = $self->msg('e1');
        }
   }
-  return @ans;
+  return (@ans);
 }
 
 #
index 18fafa82170ed24318cf20f050f519078d889e45..d1352b8c6f1bac886960dd04925e684c23f9357b 100644 (file)
@@ -106,6 +106,7 @@ sub normal
                my $text = unpad($field[3]);
                my $ref = DXChannel->get($call);
                $ref->send("$call de $field[1]: $text") if $ref;
+               Log('talk', $call, $field[1], $field[6], $text);
          } else {
            route($field[2], $line);       # relay it on its way
          }
@@ -151,24 +152,29 @@ sub normal
         # strip leading and trailing stuff
            my $text = unpad($field[3]);
                my $target;
+               my $to = 'To ';
                my @list;
                
            if ($field[4] eq '*') {          # sysops
-                 $target = "To Sysops";
+                 $target = "Sysops";
                  @list = map { $_->priv >= 5 ? $_ : () } get_all_users();
                } elsif ($field[4] gt ' ') {     # speciality list handling
                  my ($name) = split /\./, $field[4]; 
-          $target = "To $name";          # put the rest in later (if bothered) 
+          $target = "$name";          # put the rest in later (if bothered) 
         } 
                
-        $target = "WX" if $field[6] eq '1';
-               $target = "To All" if !$target;
+               if ($field[6] eq '1') {
+                       $target = "WX"; 
+                       $to = '';
+               }
+               $target = "All" if !$target;
                
                if (@list > 0) {
-                 broadcast_list("$target de $field[1]: $text", @list);
+                 broadcast_list("$to$target de $field[1]: $text", @list);
                } else {
                  broadcast_users("$target de $field[1]: $text");
                }
+               Log('ann', $target, $field[1], $text);
                
                return if $field[2] eq $main::mycall;   # it's routed to me
          } else {
@@ -300,11 +306,15 @@ sub normal
        
     if ($pcno == 34 || $pcno == 36) {   # remote commands (incoming)
                if ($field[1] eq $main::mycall) {
-                       if ($self->{priv}) {        # you have to have SOME privilege, the commands have further filtering
+                       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
-                               for (DXCommandmode::run_cmd($self, $field[3])) {
+                               my @in = (DXCommandmode::run_cmd($self, $field[3]));
+                               for (@in) {
                                        s/\s*$//og;
-                                       $self->send(pc35($main::mycall, $self->{call}, "$main::mycall:$_"));
+                                       $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_"));
+                                       Log('rcmd', 'out', $field[2], $_);
                                }
                                delete $self->{remotecmd};
                        }
index 555bc0c7cff445a30c118b546f8dcb5f58b75e27..07d5a0e98baeb9f51173797efd3101f1412d0a7e 100644 (file)
@@ -93,7 +93,8 @@ sub pc17
 # Request init string
 sub pc18
 {
-  return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
+       my $info = DXCluster::cluster;
+       return "PC18^$info^$DXProt::myprot_version^~";
 }
 
 #
index 4ef03985a74187ccf877446962be29d32faa69ed..aacef797e60d20bb90c96cef91b7ef498c7852a7 100644 (file)
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 # 
 # this file contains the system messages. Don't forget to reload them
-# if you change them
+# if you change them (load/messages)
 #
 # $Id$
 #
@@ -38,9 +38,13 @@ package DXM;
                                node => '$_[0] set as AK1A style Node',
                                nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
                                ok => 'Operation successful',
+                               page => 'Press Enter to continue, A to abort ($_[0] lines) >',
                                pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
                                priv => 'Privilege level changed on $_[0]',
                                prx => '$main::mycall >',
+                               read1 => 'Sorry, no new messages for you',
+                               read2 => 'Msg $_[0] not found',
+                               read3 => 'Msg $_[0] not available',
                                shutting => '$main::mycall shutting down...',
                                talks => 'Talk flag set on $_[0]',
                                talku => 'Talk flag unset on $_[0]',
index 8e88884214b0b3b239d003d31f2982cbb7b14265..d783bff33fa553deb411d410752bca80b51e87ef 100755 (executable)
@@ -48,7 +48,8 @@ package main;
 @inqueue = ();                                 # the main input queue, an array of hashes
 $systime = 0;                                  # the time now (in seconds)
 $version = 1.5;                                        # the version no of the software
-
+$starttime = 0;                 # the starting time of the cluster   
 # handle disconnections
 sub disconnect
 {
@@ -171,13 +172,23 @@ sub process_inqueue
        }
 }
 
+sub uptime
+{
+       my $t = $systime - $starttime;
+       my $days = int $t / 86400;
+       $t -= $days * 86400;
+       my $hours = int $t / 3600;
+       $t -= $hours * 3600;
+       my $mins = int $t / 60;
+       return sprintf "%d %02d:%02d", $days, $hours, $mins;
+}
 #############################################################
 #
 # The start of the main line of code 
 #
 #############################################################
 
-$systime = time;
+$starttime = $systime = time;
 
 # open the debug file, set various FHs to be unbuffered
 foreach (@debug) {