k => [
],
l => [
+ '^l$', 'directory', 'directory',
+ '^ll$', 'directory', 'directory',
+ '^ll/(\d+)', 'directory $1', 'directory',
],
m => [
],
'^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',
$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!
}
}
-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,
--- /dev/null
+#
+# 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);
--- /dev/null
+#
+# show some statistics
+#
+return (1, DXCluster::cluster() );
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, ());
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)]
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;
use DXDebug;
use strict;
-use vars qw($users);
-
-$users = 0;
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;
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;
use DXDebug;
use strict;
-use vars qw($nodes);
+use vars qw($nodes $users $maxusers);
$nodes = 0;
+$users = 0;
+$maxusers = 0;
+
sub new
{
{
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
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
{
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;
} else {
# special case only \n input => " "
- if ($cmdline eq " ") {
- $self->prompt();
- return;
- }
+# if ($cmdline eq " ") {
+# $self->prompt();
+# return;
+# }
# strip out //
$cmdline =~ s|//|/|og;
@ans = $self->msg('e1');
}
}
- return @ans;
+ return (@ans);
}
#
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
}
# 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 {
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};
}
# 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^~";
}
#
#!/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$
#
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]',
@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
{
}
}
+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) {