From 099c6b4a10d9f1e7471b0c94273cd992b5814cdc Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 30 Nov 1998 00:02:20 +0000 Subject: [PATCH] added Log Parsing started work on allowing SSID for local users/clusters --- cmd/set/homenode.pl | 7 +++ cmd/show/announce.pl | 34 +++++++++++++ cmd/show/log.pl | 34 +++++++++++++ cmd/show/station.pl | 18 +++---- cmd/show/talk.pl | 34 +++++++++++++ perl/DXCluster.pm | 5 +- perl/DXCommandmode.pm | 9 ++-- perl/DXLog.pm | 2 +- perl/DXLogPrint.pm | 108 ++++++++++++++++++++++++++++++++++++++++++ perl/cluster.pl | 3 +- perl/create_sysop.pl | 3 +- 11 files changed, 240 insertions(+), 17 deletions(-) create mode 100644 perl/DXLogPrint.pm diff --git a/cmd/set/homenode.pl b/cmd/set/homenode.pl index e69de29b..2c7c6c9f 100644 --- a/cmd/set/homenode.pl +++ b/cmd/set/homenode.pl @@ -0,0 +1,7 @@ +# +# set the user's home node +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl index e69de29b..89d87192 100644 --- a/cmd/show/announce.pl +++ b/cmd/show/announce.pl @@ -0,0 +1,34 @@ +# +# print out the general log file for announces only +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; + +return (1, $self->msg('e5')) if $self->priv < 9; + +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 = 20 if !$to; + +@out = DXLog::print($from, $to, $main::systime, '^ann'); +return (1, @out); diff --git a/cmd/show/log.pl b/cmd/show/log.pl index e69de29b..63326b7b 100644 --- a/cmd/show/log.pl +++ b/cmd/show/log.pl @@ -0,0 +1,34 @@ +# +# print out the general log file +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; + +return (1, $self->msg('e5')) if $self->priv < 9; + +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 = 20 if !$to; + +@out = DXLog::print($from, $to, $main::systime); +return (1, @out); diff --git a/cmd/show/station.pl b/cmd/show/station.pl index 9efa5b1f..6c78f45c 100644 --- a/cmd/show/station.pl +++ b/cmd/show/station.pl @@ -20,19 +20,19 @@ if (@f == 0) { my $sort = $ref->sort; my $qth = $ref->qth; my $home = $ref->node; - push @out, "$call $sort $home $qth"; + push @out, "$call $sort $qth $node"; } } else { foreach $call (@f) { - my $ref = DXUser::get_current($call); + my $ref = DXUser->get_current($call); if ($ref) { - my $name; - my $qth; - my $lat; - my $long; - my $node; - my $homenode; - push @out, "$call $qth"; + my $name = $ref->name; + my $qth = $ref->qth; + my $lat = $ref->lat; + my $long = $ref->long; + my $node = $ref->node; +# my $homenode = $ref->homenode; + push @out, "$call $qth $lat $long $node"; } else { push @out, "$call not known"; } diff --git a/cmd/show/talk.pl b/cmd/show/talk.pl index e69de29b..612f2b08 100644 --- a/cmd/show/talk.pl +++ b/cmd/show/talk.pl @@ -0,0 +1,34 @@ +# +# print out the general log file for talks only +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my $self = shift; + +return (1, $self->msg('e5')) if $self->priv < 9; + +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 = 20 if !$to; + +@out = DXLog::print($from, $to, $main::systime, '^talk'); +return (1, @out); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 6daf65a3..51c63f82 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -97,8 +97,9 @@ 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"; + my $tot = $DXNode::users + 1; + + return " $DXNode::nodes nodes, $users local / $tot total users Max users $DXNode::maxusers Uptime $uptime"; } sub DESTROY diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ab8d9573..84d809fd 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -18,6 +18,7 @@ use DXVars; use DXDebug; use DXM; use DXLog; +use DXLogPrint; use CmdAlias; use FileHandle; use Carp; @@ -51,13 +52,10 @@ 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; @@ -79,6 +77,11 @@ sub start my @pc16 = DXProt::pc16($nchan, $cuser); DXProt::broadcast_ak1a(@pc16); Log('DXCommand', "$call connected"); + + # send prompts and things + my $info = DXCluster::cluster(); + $self->send("Cluster:$info"); + $self->send($self->msg('pr', $call)); } # diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 96b39971..3a6e0e35 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -176,7 +176,7 @@ sub Log $log->writeunix($t, join('^', $t, @_) ); } -sub DESTROY # catch undefs and do what is required further do the tree +sub DESTROY # catch undefs and do what is required further down the tree { my $self = shift; DXDebug::dbg("dxlog", "closing $self->{fn}\n"); diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm new file mode 100644 index 00000000..fff39d12 --- /dev/null +++ b/perl/DXLogPrint.pm @@ -0,0 +1,108 @@ +# +# Log Printing routines +# +# Copyright (c) - 1998 Dirk Koopman G1TLH +# +# $Id$ +# + +package DXLog; + +use FileHandle; +use DXVars; +use DXDebug (); +use DXUtil; +use DXLog; +use Julian; +use Carp; + +use strict; + +# +# print some items from the log backwards in time +# +# This command outputs a list of n lines starting from time t with $pattern tags +# +sub print +{ + my $self = $DXLog::log; + 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 = $pattern ? "\$ref->[1] =~ /$pattern/" : '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 '\^' ]; + } + 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 = atime($ref[0]); + my $s = 'undef'; + + if ($ref[1] eq 'rcmd') { + if ($ref[2] eq 'in') { + $s = "$ref[4] (priv: $ref[3]) rcmd: $ref[5]"; + } else { + $s = "$ref[3] reply: $ref[4]"; + } + } elsif ($ref[1] eq 'talk') { + $s = "$ref[3] -> $ref[2] ($ref[4]) $ref[5]"; + } elsif ($ref[1] eq 'ann') { + $s = "$ref[2] -> $ref[3] $ref[4]"; + } else { + $s = "$ref[2]"; + } + return "$d $s"; +} + +1; diff --git a/perl/cluster.pl b/perl/cluster.pl index d783bff3..666f4f87 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -27,6 +27,7 @@ use Msg; use DXVars; use DXDebug; use DXLog; +use DXLogPrint; use DXUtil; use DXChannel; use DXUser; @@ -149,7 +150,7 @@ sub process_inqueue my $data = $self->{data}; my $dxchan = $self->{dxchan}; - my ($sort, $call, $line) = $data =~ /^(\w)(\w+)\|(.*)$/; + my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/; # do the really sexy console interface bit! (Who is going to do the TK interface then?) dbg('chan', "<- $sort $call $line\n"); diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index 1e553209..da242811 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -58,7 +58,8 @@ sub create_it $self->{lastin} = 0; $self->{dxok} = 1; $self->{annok} = 1; - + $self->{lang} = 'en'; + # write it away $self->close(); -- 2.43.0