From: djk Date: Sun, 29 Nov 1998 15:14:48 +0000 (+0000) Subject: added set/page and paging X-Git-Tag: SPIDER_1_5~9 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=cce345b95c555a0b45218c5b452bc0f5f4f13bab;p=spider.git added set/page and paging added logging for wwv, talk and announce --- diff --git a/cmd/Aliases b/cmd/Aliases index 6089171f..8c44c402 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -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', diff --git a/cmd/announce.pl b/cmd/announce.pl index 1f2d24ab..f9d3fc4b 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -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! diff --git a/cmd/read.pl b/cmd/read.pl index a1352724..e21a77e6 100644 --- a/cmd/read.pl +++ b/cmd/read.pl @@ -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 index 00000000..f7dc64dc --- /dev/null +++ b/cmd/set/page.pl @@ -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 index 00000000..6fe9b356 --- /dev/null +++ b/cmd/show/cluster.pl @@ -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 index 00000000..e69de29b diff --git a/cmd/talk.pl b/cmd/talk.pl index 23efabfc..a53b213e 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -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, ()); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index eb306e67..58dc3b86 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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)] diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 98ceafa9..6daf65a3 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -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 diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 8af394b8..ab8d9573 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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); } # diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 18fafa82..d1352b8c 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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}; } diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 555bc0c7..07d5a0e9 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -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^~"; } # diff --git a/perl/Messages b/perl/Messages index 4ef03985..aacef797 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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]', diff --git a/perl/cluster.pl b/perl/cluster.pl index 8e888842..d783bff3 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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) {