mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
added set/page and paging
added logging for wwv, talk and announce
This commit is contained in:
djk
parent
8a0f0fc3c5
commit
cce345b95c
@ -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',
|
||||
|
||||
@ -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!
|
||||
|
||||
@ -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,
|
||||
|
||||
13
cmd/set/page.pl
Normal file
13
cmd/set/page.pl
Normal file
@ -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);
|
||||
4
cmd/show/cluster.pl
Normal file
4
cmd/show/cluster.pl
Normal file
@ -0,0 +1,4 @@
|
||||
#
|
||||
# show some statistics
|
||||
#
|
||||
return (1, DXCluster::cluster() );
|
||||
0
cmd/show/log.pl
Normal file
0
cmd/show/log.pl
Normal 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, ());
|
||||
|
||||
@ -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)]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
my @ans = run_cmd($self, $cmdline);
|
||||
$self->send(@ans) if @ans > 0;
|
||||
# remove leading and trailing spaces
|
||||
$cmdline =~ s/^\s*(.*)\s*$/$1/;
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
#
|
||||
|
||||
@ -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};
|
||||
}
|
||||
|
||||
@ -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^~";
|
||||
}
|
||||
|
||||
#
|
||||
|
||||
@ -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]',
|
||||
|
||||
@ -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) {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user