mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
1. Added RCMD for clx
2. Added WCY processing 3. Added new node types (clx, spider, dxnet, arcluster) 4. Store echo settings 5. Store pagelth settings 6. sort out source of DXVars for callbot.pl
This commit is contained in:
djk
parent
d95df46027
commit
f155969d60
7
Changes
7
Changes
@ -1,3 +1,10 @@
|
||||
12Jun00=======================================================================
|
||||
1. Added RCMD for clx
|
||||
2. Added WCY processing
|
||||
3. Added new node types (clx, spider, dxnet, arcluster)
|
||||
4. Store echo settings
|
||||
5. Store pagelth settings
|
||||
6. sort out source of DXVars for callbot.pl
|
||||
11Jun00=======================================================================
|
||||
1. removed extraneous DXDebug from DXUtil
|
||||
2. added help for set/echo
|
||||
|
||||
@ -434,6 +434,8 @@ of telnet handle echo differently depending on whether you are
|
||||
connected via port 23 or some other port. You can use this command
|
||||
to change the setting appropriately.
|
||||
|
||||
The setting is stored in your user profile.
|
||||
|
||||
YOU DO NOT NEED TO USE THIS COMMAND IF YOU ARE CONNECTED VIA AX25.
|
||||
|
||||
=== 0^SET/HERE^Tell the system you are present at your terminal
|
||||
@ -502,6 +504,8 @@ explicitly to 0 will disable paging.
|
||||
SET/PAGE 30
|
||||
SET/PAGE 0
|
||||
|
||||
The setting is stored in your user profile.
|
||||
|
||||
=== 9^SET/PINGINTERVAL <time> <nodecall>^Set ping time to neighbouring nodes
|
||||
As from release 1.35 all neighbouring nodes are pinged at regular intervals
|
||||
in order to determine the rolling quality of the link and, in future, to
|
||||
@ -553,6 +557,9 @@ Tell the system where you are. For example:-
|
||||
=== 0^SET/TALK^Allow TALK messages to come out on your terminal
|
||||
=== 0^UNSET/TALK^Stop TALK messages coming out on your terminal
|
||||
|
||||
=== 0^SET/WCY^Allow WCY messages to come out on your terminal
|
||||
=== 0^UNSET/WCY^Stop WCY messages coming out on your terminal
|
||||
|
||||
=== 0^SET/WWV^Allow WWV messages to come out on your terminal
|
||||
=== 0^UNSET/WWV^Stop WWV messages coming out on your terminal
|
||||
|
||||
@ -806,6 +813,10 @@ time and UTC as the computer has it right now. If you give some prefixes
|
||||
then it will show UTC and UTC + the local offset (not including DST) at
|
||||
the prefixes or callsigns that you specify.
|
||||
|
||||
=== 0^SHOW/WCY^Show last 10 WCY broadcasts
|
||||
=== 0^SHOW/WCY <n>^Show last <n> WCY broadcasts
|
||||
Display the most recent WCY information that has been received by the system
|
||||
|
||||
=== 0^SHOW/WWV^Show last 10 WWV broadcasts
|
||||
=== 0^SHOW/WWV <n>^Show last <n> WWV broadcasts
|
||||
Display the most recent WWV information that has been received by the system
|
||||
|
||||
@ -15,7 +15,7 @@ foreach $call (@calls) {
|
||||
next if $call eq $main::mycall;
|
||||
my $dxchan = DXChannel->get($call);
|
||||
if ($dxchan) {
|
||||
if ($dxchan->is_ak1a) {
|
||||
if ($dxchan->is_node) {
|
||||
# $dxchan->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', $self->call)));
|
||||
} else {
|
||||
return (1, $self->msg('e5')) if $self->priv < 8;
|
||||
|
||||
@ -17,7 +17,7 @@ foreach $call (@calls) {
|
||||
next if $call eq $main::mycall;
|
||||
my $dxchan = DXChannel->get($call);
|
||||
if ($dxchan) {
|
||||
if ($dxchan->is_ak1a) {
|
||||
if ($dxchan->is_node) {
|
||||
|
||||
# first clear out any nodes on this dxchannel
|
||||
my @gonenodes = grep { $_->dxchan == $dxchan } DXNode::get_all();
|
||||
|
||||
@ -24,11 +24,11 @@ $call = uc $call;
|
||||
my $noderef = DXCluster->get_exact($call);
|
||||
unless ($noderef) {
|
||||
$noderef = DXChannel->get($call);
|
||||
$noderef = undef unless $noderef && $noderef->is_ak1a;
|
||||
$noderef = undef unless $noderef && $noderef->is_node;
|
||||
}
|
||||
return (1, $self->msg('e7', $call)) unless $noderef;
|
||||
|
||||
# rcmd it
|
||||
DXProt::addrcmd($self->call, $call, $line);
|
||||
DXProt::addrcmd($self, $call, $line);
|
||||
|
||||
return (1, $self->msg('rcmdo', $line, $call));
|
||||
|
||||
48
cmd/set/arcluster.pl
Normal file
48
cmd/set/arcluster.pl
Normal file
@ -0,0 +1,48 @@
|
||||
#
|
||||
# set user type to 'S' for Spider node
|
||||
#
|
||||
# Please note that this is only effective if the user is not on-line
|
||||
#
|
||||
# Copyright (c) 1998 - Dirk Koopman
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
my ($self, $line) = @_;
|
||||
my @args = split /\s+/, $line;
|
||||
my $call;
|
||||
my @out;
|
||||
my $user;
|
||||
my $create;
|
||||
|
||||
return (1, $self->msg('e5')) if $self->priv < 5;
|
||||
|
||||
foreach $call (@args) {
|
||||
$call = uc $call;
|
||||
my $chan = DXChannel->get($call);
|
||||
if ($chan) {
|
||||
push @out, $self->msg('nodee1', $call);
|
||||
} else {
|
||||
$user = DXUser->get($call);
|
||||
$create = !$user;
|
||||
$user = DXUser->new($call) if $create;
|
||||
if ($user) {
|
||||
$user->sort('R');
|
||||
$user->homenode($call);
|
||||
$user->priv(1) unless $user->priv;
|
||||
$user->close();
|
||||
push @out, $self->msg($create ? 'noderc' : 'noder', $call);
|
||||
} else {
|
||||
push @out, $self->msg('e3', "Set Spider", $call);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (1, @out);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
40
cmd/set/clx.pl
Normal file
40
cmd/set/clx.pl
Normal file
@ -0,0 +1,40 @@
|
||||
#
|
||||
# set user type to 'S' for Spider node
|
||||
#
|
||||
# Please note that this is only effective if the user is not on-line
|
||||
#
|
||||
# Copyright (c) 1998 - Dirk Koopman
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
my ($self, $line) = @_;
|
||||
my @args = split /\s+/, $line;
|
||||
my $call;
|
||||
my @out;
|
||||
my $user;
|
||||
my $create;
|
||||
|
||||
return (1, $self->msg('e5')) if $self->priv < 5;
|
||||
|
||||
foreach $call (@args) {
|
||||
$call = uc $call;
|
||||
my $chan = DXChannel->get($call);
|
||||
if ($chan) {
|
||||
push @out, $self->msg('nodee1', $call);
|
||||
} else {
|
||||
$user = DXUser->get($call);
|
||||
$create = !$user;
|
||||
$user = DXUser->new($call) if $create;
|
||||
if ($user) {
|
||||
$user->sort('C');
|
||||
$user->homenode($call);
|
||||
$user->priv(1) unless $user->priv;
|
||||
$user->close();
|
||||
push @out, $self->msg($create ? 'nodecc' : 'nodec', $call);
|
||||
} else {
|
||||
push @out, $self->msg('e3', "Set Spider", $call);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (1, @out);
|
||||
40
cmd/set/dxnet.pl
Normal file
40
cmd/set/dxnet.pl
Normal file
@ -0,0 +1,40 @@
|
||||
#
|
||||
# set user type to 'S' for Spider node
|
||||
#
|
||||
# Please note that this is only effective if the user is not on-line
|
||||
#
|
||||
# Copyright (c) 1998 - Dirk Koopman
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
my ($self, $line) = @_;
|
||||
my @args = split /\s+/, $line;
|
||||
my $call;
|
||||
my @out;
|
||||
my $user;
|
||||
my $create;
|
||||
|
||||
return (1, $self->msg('e5')) if $self->priv < 5;
|
||||
|
||||
foreach $call (@args) {
|
||||
$call = uc $call;
|
||||
my $chan = DXChannel->get($call);
|
||||
if ($chan) {
|
||||
push @out, $self->msg('nodee1', $call);
|
||||
} else {
|
||||
$user = DXUser->get($call);
|
||||
$create = !$user;
|
||||
$user = DXUser->new($call) if $create;
|
||||
if ($user) {
|
||||
$user->sort('X');
|
||||
$user->homenode($call);
|
||||
$user->priv(1) unless $user->priv;
|
||||
$user->close();
|
||||
push @out, $self->msg($create ? 'nodexc' : 'nodex', $call);
|
||||
} else {
|
||||
push @out, $self->msg('e3', "Set Spider", $call);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (1, @out);
|
||||
@ -7,4 +7,5 @@
|
||||
#
|
||||
my $self = shift;
|
||||
$self->send_now("E", "1");
|
||||
$self->user->wantecho(1);
|
||||
return (1, $self->msg('echoon'));
|
||||
|
||||
@ -29,8 +29,9 @@ foreach $call (@args) {
|
||||
if ($user) {
|
||||
$user->sort('A');
|
||||
$user->homenode($call);
|
||||
$user->priv(1) unless $user->priv;
|
||||
$user->close();
|
||||
push @out, $self->msg($create ? 'nodec' : 'node', $call);
|
||||
push @out, $self->msg($create ? 'nodeac' : 'nodea', $call);
|
||||
} else {
|
||||
push @out, $self->msg('e3', "Set Node", $call);
|
||||
}
|
||||
|
||||
@ -10,4 +10,5 @@ my $l = shift;
|
||||
$l = 20 if $l == 0;
|
||||
$l = 10 if $l < 10;
|
||||
$self->pagelth($l);
|
||||
$self->user->pagelth($l);
|
||||
return (1, $self->msg('pagelth', $l));
|
||||
|
||||
@ -28,6 +28,8 @@ foreach $call (@args) {
|
||||
$user = DXUser->new($call) if $create;
|
||||
if ($user) {
|
||||
$user->sort('S');
|
||||
$user->homenode($call);
|
||||
$user->priv(1) unless $user->priv;
|
||||
$user->close();
|
||||
push @out, $self->msg($create ? 'nodesc' : 'nodes', $call);
|
||||
} else {
|
||||
@ -36,3 +38,13 @@ foreach $call (@args) {
|
||||
}
|
||||
}
|
||||
return (1, @out);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
49
cmd/show/wcy.pl
Normal file
49
cmd/show/wcy.pl
Normal file
@ -0,0 +1,49 @@
|
||||
#
|
||||
# print out the wcy stats
|
||||
#
|
||||
# Copyright (c) 2000 - Dirk Koopman G1TLH
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
my $self = shift;
|
||||
|
||||
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; # is it a to count?
|
||||
next if $to;
|
||||
}
|
||||
}
|
||||
|
||||
$from = 1 unless $from;
|
||||
$to = 10 unless $to;
|
||||
|
||||
push @out, "Date Hour SFI A K Exp.K R SA GMF Aurora Logger";
|
||||
my @in = WCY::search($from, $to, $main::systime);
|
||||
for (@in) {
|
||||
push @out, WCY::print_item($_);
|
||||
}
|
||||
return (1, @out);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -10,7 +10,7 @@ my $ref;
|
||||
if ($self->priv >= 5) {
|
||||
foreach $ref (DXChannel::get_all()) {
|
||||
$ref->send_now("D", DXProt::pc39($main::mycall, "Shutdown by $call"))
|
||||
if $ref->is_ak1a && $ref != $DXProt::me;
|
||||
if $ref->is_node && $ref != $DXProt::me;
|
||||
$ref->send_now("D", $self->msg('shutting')) if $ref->is_user;
|
||||
}
|
||||
|
||||
|
||||
@ -7,4 +7,5 @@
|
||||
#
|
||||
my $self = shift;
|
||||
$self->send_now("E", "0");
|
||||
$self->user->wantecho(0);
|
||||
return (1, $self->msg('echooff'));
|
||||
|
||||
@ -26,6 +26,7 @@ foreach $call (@args) {
|
||||
$user = DXUser->get($call);
|
||||
return (1, $self->msg('usernf', $call)) if !$user;
|
||||
$user->sort('U');
|
||||
$user->priv(0);
|
||||
$user->close();
|
||||
push @out, $self->msg('nodeu', $call);
|
||||
}
|
||||
|
||||
@ -16,7 +16,7 @@ push @out, " Callsign Type Started Name Ave RTT";
|
||||
foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) {
|
||||
my $call = $dxchan->call();
|
||||
my $t = cldatetime($dxchan->startt);
|
||||
my $sort = $dxchan->is_ak1a() ? "NODE" : "USER";
|
||||
my $sort = $dxchan->is_node() ? "NODE" : "USER";
|
||||
my $name = $dxchan->user->name || " ";
|
||||
my $ping = $dxchan->is_ak1a && $dxchan != $DXProt::me ? sprintf("%8.2f", $dxchan->pingave) : "";
|
||||
push @out, sprintf "%10s $sort $t %-18.18s $ping", $call, $name;
|
||||
|
||||
22
filter/wcy/DB0SUE-7.pl.issue
Normal file
22
filter/wcy/DB0SUE-7.pl.issue
Normal file
@ -0,0 +1,22 @@
|
||||
#
|
||||
# This is an example WWV filter
|
||||
#
|
||||
# The element list is:-
|
||||
# 0 - nominal unix date of spot (ie the day + hour:13)
|
||||
# 1 - the hour
|
||||
# 2 - SFI
|
||||
# 3 - K
|
||||
# 4 - I
|
||||
# 5 - text
|
||||
# 6 - spotter
|
||||
# 7 - origin
|
||||
# 8 - incoming interface callsign
|
||||
#
|
||||
# this one doesn't filter, it just sets the hop count to 6 and is
|
||||
# used mainly just to override any isolation from WWV coming from
|
||||
# the internet.
|
||||
|
||||
$in = [
|
||||
[ 1, 0, 'd', 0, 6 ]
|
||||
];
|
||||
|
||||
@ -39,7 +39,6 @@ sub init
|
||||
sub new
|
||||
{
|
||||
my $self = DXChannel::alloc(@_);
|
||||
$self->{'sort'} = 'B';
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
@ -42,7 +42,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) {
|
||||
[ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
|
||||
[ '^DX', COLOR_PAIR(5) ],
|
||||
[ '^To', COLOR_PAIR(3) ],
|
||||
[ '^WWV', COLOR_PAIR(4) ],
|
||||
[ '^(?:WWV|WCY)', COLOR_PAIR(4) ],
|
||||
[ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
|
||||
[ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
|
||||
[ '^WX', COLOR_PAIR(3) ],
|
||||
@ -59,7 +59,7 @@ if ($ENV{'TERM'} =~ /(console|linux)/) {
|
||||
[ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
|
||||
[ '^DX', COLOR_PAIR(4) ],
|
||||
[ '^To', COLOR_PAIR(3) ],
|
||||
[ '^WWV', COLOR_PAIR(5) ],
|
||||
[ '^(?:WWV|WCY)', COLOR_PAIR(5) ],
|
||||
[ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
|
||||
[ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
|
||||
[ '^WX', COLOR_PAIR(3) ],
|
||||
|
||||
@ -51,6 +51,7 @@ use vars qw(%channels %valid);
|
||||
consort => '5,Connection Type',
|
||||
'sort' => '5,Type of Channel',
|
||||
wwv => '0,Want WWV,yesno',
|
||||
wcy => '0,Want WCY,yesno',
|
||||
wx => '0,Want WX,yesno',
|
||||
talk => '0,Want Talk,yesno',
|
||||
ann => '0,Want Announce,yesno',
|
||||
@ -72,6 +73,7 @@ use vars qw(%channels %valid);
|
||||
delayed => '5,Delayed messages,parray',
|
||||
annfilter => '5,Announce Filter',
|
||||
wwvfilter => '5,WWV Filter',
|
||||
wcyfilter => '5,WCY Filter',
|
||||
spotfilter => '5,Spot Filter',
|
||||
inannfilter => '5,Input Ann Filter',
|
||||
inwwvfilter => '5,Input WWV Filter',
|
||||
@ -119,6 +121,7 @@ sub alloc
|
||||
$self->{lang} = $user->lang;
|
||||
$user->new_group() if !$user->group;
|
||||
$self->{group} = $user->group;
|
||||
$self->{sort} = $user->sort;
|
||||
}
|
||||
$self->{startt} = $self->{t} = time;
|
||||
$self->{state} = 0;
|
||||
@ -158,7 +161,7 @@ sub get_all_ak1a
|
||||
my $ref;
|
||||
my @out;
|
||||
foreach $ref (@list) {
|
||||
push @out, $ref if $ref->is_ak1a;
|
||||
push @out, $ref if $ref->is_node;
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
@ -215,7 +218,12 @@ sub is_bbs
|
||||
return $self->{'sort'} eq 'B';
|
||||
}
|
||||
|
||||
# is it an ak1a cluster ?
|
||||
sub is_node
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{'sort'} =~ /[ACRSX]/;
|
||||
}
|
||||
# is it an ak1a node ?
|
||||
sub is_ak1a
|
||||
{
|
||||
my $self = shift;
|
||||
@ -229,13 +237,34 @@ sub is_user
|
||||
return $self->{'sort'} eq 'U';
|
||||
}
|
||||
|
||||
# is it a connect type
|
||||
sub is_connect
|
||||
# is it a clx node
|
||||
sub is_clx
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{'sort'} eq 'C';
|
||||
}
|
||||
|
||||
# is it a spider node
|
||||
sub is_spider
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{'sort'} eq 'S';
|
||||
}
|
||||
|
||||
# is it a DXNet node
|
||||
sub is_dxnet
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{'sort'} eq 'X';
|
||||
}
|
||||
|
||||
# is it a ar-cluster node
|
||||
sub is_arcluster
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{'sort'} eq 'R';
|
||||
}
|
||||
|
||||
# for perl 5.004's benefit
|
||||
sub sort
|
||||
{
|
||||
|
||||
@ -27,6 +27,7 @@ use Filter;
|
||||
use Minimuf;
|
||||
use DXDb;
|
||||
use AnnTalk;
|
||||
use WCY;
|
||||
use Sun;
|
||||
|
||||
use strict;
|
||||
@ -45,7 +46,6 @@ $scriptbase = "$main::root/scripts"; # the place where all users start scripts g
|
||||
sub new
|
||||
{
|
||||
my $self = DXChannel::alloc(@_);
|
||||
$self->{'sort'} = 'U'; # in absence of how to find out what sort of an object I am
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -66,7 +66,7 @@ sub start
|
||||
$self->state('prompt'); # a bit of room for further expansion, passwords etc
|
||||
$self->{priv} = $user->priv;
|
||||
$self->{lang} = $user->lang;
|
||||
$self->{pagelth} = 20;
|
||||
$self->{pagelth} = $user->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
|
||||
|
||||
@ -74,12 +74,14 @@ sub start
|
||||
$self->{beep} = $user->wantbeep;
|
||||
$self->{ann} = $user->wantann;
|
||||
$self->{wwv} = $user->wantwwv;
|
||||
$self->{wcy} = $user->wantwcy;
|
||||
$self->{talk} = $user->wanttalk;
|
||||
$self->{wx} = $user->wantwx;
|
||||
$self->{dx} = $user->wantdx;
|
||||
$self->{logininfo} = $user->wantlogininfo;
|
||||
$self->{here} = 1;
|
||||
|
||||
|
||||
# add yourself to the database
|
||||
my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database";
|
||||
my $cuser = DXNodeuser->new($self, $node, $call, 0, 1);
|
||||
@ -102,6 +104,12 @@ sub start
|
||||
$self->send($self->msg('hnodee1')) if !$user->qth;
|
||||
$self->send($self->msg('m9')) if DXMsg::for_me($call);
|
||||
$self->send($self->msg('pr', $call));
|
||||
|
||||
# decide on echo
|
||||
if (!$user->wantecho) {
|
||||
$self->send_now('E', "0");
|
||||
$self->send($self->msg('echow'));
|
||||
}
|
||||
|
||||
$self->tell_login('loginu');
|
||||
|
||||
|
||||
188
perl/DXProt.pm
188
perl/DXProt.pm
@ -27,6 +27,7 @@ use Local;
|
||||
use DXDb;
|
||||
use AnnTalk;
|
||||
use Geomag;
|
||||
use WCY;
|
||||
use Time::HiRes qw(gettimeofday tv_interval);
|
||||
|
||||
use strict;
|
||||
@ -81,7 +82,6 @@ sub init
|
||||
sub new
|
||||
{
|
||||
my $self = DXChannel::alloc(@_);
|
||||
$self->{'sort'} = 'A'; # in absence of how to find out what sort of an object I am
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -156,7 +156,7 @@ sub normal
|
||||
# process PC frames
|
||||
my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
|
||||
return unless $pcno;
|
||||
return if $pcno < 10 || $pcno > 51;
|
||||
return if $pcno < 10 || $pcno > 99;
|
||||
|
||||
# dump bad protocol messages unless it is a PC29
|
||||
if ($line =~ /\%[0-9A-F][0-9A-F]/o && $pcno != 29) {
|
||||
@ -601,7 +601,12 @@ sub normal
|
||||
$self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!"));
|
||||
}
|
||||
} else {
|
||||
$self->route($field[1], $line);
|
||||
my $ref = DXUser->get_current($field[1]);
|
||||
if ($ref && $ref->is_clx) {
|
||||
route($field[1], pc84($field[2], $field[1], $field[2], $field[3]));
|
||||
} else {
|
||||
$self->route($field[1], $line);
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -615,7 +620,12 @@ sub normal
|
||||
delete $rcmds{$field[2]} if !$dxchan;
|
||||
}
|
||||
} else {
|
||||
$self->route($field[1], $line);
|
||||
my $ref = DXUser->get_current($field[1]);
|
||||
if ($ref && $ref->is_clx) {
|
||||
route($field[1], pc85($field[2], $field[1], $field[2], $field[3]));
|
||||
} else {
|
||||
$self->route($field[1], $line);
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -694,7 +704,7 @@ sub normal
|
||||
my $s = sprintf "%.2f", $t;
|
||||
my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
|
||||
$dxchan->send($dxchan->msg('pingi', $field[2], $s, $ave))
|
||||
} elsif ($dxchan->is_ak1a) {
|
||||
} elsif ($dxchan->is_node) {
|
||||
if ($tochan) {
|
||||
$tochan->{nopings} = 2; # pump up the timer
|
||||
push @{$tochan->{pingtime}}, $t;
|
||||
@ -715,15 +725,102 @@ sub normal
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
if ($pcno == 73) { # WCY broadcasts
|
||||
|
||||
# do some de-duping
|
||||
my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
|
||||
if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
|
||||
dbg('chan', "WCY Date ($field[1] $field[2]) out of range");
|
||||
return;
|
||||
}
|
||||
@field = map { unpad($_) } @field;
|
||||
if (WCY::dup($d,@field[3..7])) {
|
||||
dbg('chan', "Dup WCY Spot ignored\n");
|
||||
return;
|
||||
}
|
||||
|
||||
my $wcy = WCY::update($d, @field[2..12]);
|
||||
|
||||
my $rep;
|
||||
eval {
|
||||
$rep = Local::wwv($self, @field[1..12]);
|
||||
};
|
||||
# dbg('local', "Local::wcy error $@") if $@;
|
||||
return if $rep;
|
||||
|
||||
# broadcast to the eager world
|
||||
send_wcy_spot($self, $line, $d, @field[2..12]);
|
||||
return;
|
||||
}
|
||||
|
||||
if ($pcno == 84) { # remote commands (incoming)
|
||||
if ($field[1] eq $main::mycall) {
|
||||
my $ref = DXUser->get_current($field[2]);
|
||||
my $cref = DXCluster->get($field[2]);
|
||||
Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]);
|
||||
unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS!
|
||||
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
|
||||
my $oldpriv = $self->{priv};
|
||||
$self->{priv} = $ref->{priv}; # assume the user's privilege level
|
||||
my @in = (DXCommandmode::run_cmd($self, $field[4]));
|
||||
$self->{priv} = $oldpriv;
|
||||
for (@in) {
|
||||
s/\s*$//og;
|
||||
$self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:$_"));
|
||||
Log('rcmd', 'out', $field[2], $_);
|
||||
}
|
||||
delete $self->{remotecmd};
|
||||
} else {
|
||||
$self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:sorry...!"));
|
||||
}
|
||||
} else {
|
||||
$self->send(pc85($main::mycall, $field[2], $field[3],"$main::mycall:your attempt is logged, Tut tut tut...!"));
|
||||
}
|
||||
} else {
|
||||
my $ref = DXUser->get_current($field[1]);
|
||||
if ($ref && $ref->is_clx) {
|
||||
$self->route($field[1], $line);
|
||||
} else {
|
||||
route($field[1], pc34($field[2], $field[1], $field[3]));
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
if ($pcno == 85) { # remote command replies
|
||||
if ($field[1] eq $main::mycall) {
|
||||
my $dxchan = DXChannel->get($field[3]);
|
||||
if ($dxchan) {
|
||||
$dxchan->send($field[4]);
|
||||
} else {
|
||||
my $s = $rcmds{$field[2]};
|
||||
if ($s) {
|
||||
$dxchan = DXChannel->get($s->{call});
|
||||
$dxchan->send($field[4]) if $dxchan;
|
||||
delete $rcmds{$field[2]} if !$dxchan;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
my $ref = DXUser->get_current($field[1]);
|
||||
if ($ref && $ref->is_clx) {
|
||||
$self->route($field[1], $line);
|
||||
} else {
|
||||
route($field[1], pc35($field[2], $field[1], $field[3]));
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# if get here then rebroadcast the thing with its Hop count decremented (if
|
||||
# there is one). If it has a hop count and it decrements to zero then don't
|
||||
# rebroadcast it.
|
||||
#
|
||||
# NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
|
||||
# REBROADCAST!!!!
|
||||
#
|
||||
# if get here then rebroadcast the thing with its Hop count decremented (if
|
||||
# there is one). If it has a hop count and it decrements to zero then don't
|
||||
# rebroadcast it.
|
||||
#
|
||||
# NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
|
||||
# REBROADCAST!!!!
|
||||
#
|
||||
|
||||
unless ($self->{isolate}) {
|
||||
broadcast_ak1a($line, $self); # send it to everyone but me
|
||||
@ -741,7 +838,7 @@ sub process
|
||||
my $dxchan;
|
||||
|
||||
foreach $dxchan (@dxchan) {
|
||||
next unless $dxchan->is_ak1a();
|
||||
next unless $dxchan->is_node();
|
||||
next if $dxchan == $me;
|
||||
|
||||
# send a pc50 out on this channel
|
||||
@ -836,7 +933,7 @@ sub send_dx_spot
|
||||
next unless $filter;
|
||||
}
|
||||
|
||||
if ($dxchan->is_ak1a) {
|
||||
if ($dxchan->is_node) {
|
||||
next if $dxchan == $self;
|
||||
if ($hops) {
|
||||
$routeit = $line;
|
||||
@ -875,11 +972,11 @@ sub send_wwv_spot
|
||||
my $routeit;
|
||||
my ($filter, $hops);
|
||||
|
||||
if ($dxchan->{spotfilter}) {
|
||||
if ($dxchan->{wwvfilter}) {
|
||||
($filter, $hops) = Filter::it($dxchan->{wwvfilter}, @_, $self->{call} );
|
||||
next unless $filter;
|
||||
}
|
||||
if ($dxchan->is_ak1a) {
|
||||
if ($dxchan->is_node) {
|
||||
next if $dxchan == $self;
|
||||
if ($hops) {
|
||||
$routeit = $line;
|
||||
@ -906,6 +1003,49 @@ sub send_wwv_spot
|
||||
}
|
||||
}
|
||||
|
||||
sub send_wcy_spot
|
||||
{
|
||||
my $self = shift;
|
||||
my $line = shift;
|
||||
my @dxchan = DXChannel->get_all();
|
||||
my $dxchan;
|
||||
|
||||
# send it if it isn't the except list and isn't isolated and still has a hop count
|
||||
# taking into account filtering and so on
|
||||
foreach $dxchan (@dxchan) {
|
||||
my $routeit;
|
||||
my ($filter, $hops);
|
||||
|
||||
if ($dxchan->{wcyfilter}) {
|
||||
($filter, $hops) = Filter::it($dxchan->{wcyfilter}, @_, $self->{call} );
|
||||
next unless $filter;
|
||||
}
|
||||
if ($dxchan->is_clx || $dxchan->is_spider) {
|
||||
next if $dxchan == $self;
|
||||
if ($hops) {
|
||||
$routeit = $line;
|
||||
$routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
|
||||
} else {
|
||||
$routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name
|
||||
next unless $routeit;
|
||||
}
|
||||
if ($filter) {
|
||||
$dxchan->send($routeit) if $routeit;
|
||||
} else {
|
||||
$dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
|
||||
}
|
||||
} elsif ($dxchan->is_user && $dxchan->{wcy}) {
|
||||
my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]";
|
||||
$buf .= "\a\a" if $dxchan->{beep};
|
||||
if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
|
||||
$dxchan->send($buf);
|
||||
} else {
|
||||
$dxchan->delay($buf);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# send an announce
|
||||
sub send_announce
|
||||
{
|
||||
@ -942,7 +1082,7 @@ sub send_announce
|
||||
($filter, $hops) = Filter::it($dxchan->{annfilter}, @_, $self->{call} );
|
||||
next unless $filter;
|
||||
}
|
||||
if ($dxchan->is_ak1a && $_[1] ne $main::mycall) { # i.e not specifically routed to me
|
||||
if ($dxchan->is_node && $_[1] ne $main::mycall) { # i.e not specifically routed to me
|
||||
next if $dxchan == $self;
|
||||
if ($hops) {
|
||||
$routeit = $line;
|
||||
@ -1107,6 +1247,7 @@ sub broadcast_list
|
||||
}
|
||||
next if $sort eq 'ann' && !$dxchan->{ann};
|
||||
next if $sort eq 'wwv' && !$dxchan->{wwv};
|
||||
next if $sort eq 'wcy' && !$dxchan->{wcy};
|
||||
next if $sort eq 'wx' && !$dxchan->{wx};
|
||||
|
||||
$s =~ s/\a//og unless $dxchan->{beep};
|
||||
@ -1194,13 +1335,20 @@ sub addping
|
||||
# add a rcmd request to the rcmd queues
|
||||
sub addrcmd
|
||||
{
|
||||
my ($from, $to, $cmd) = @_;
|
||||
my ($self, $to, $cmd) = @_;
|
||||
|
||||
my $r = {};
|
||||
$r->{call} = $from;
|
||||
$r->{call} = $self->{call};
|
||||
$r->{t} = $main::systime;
|
||||
$r->{cmd} = $cmd;
|
||||
route(undef, $to, pc34($main::mycall, $to, $cmd));
|
||||
$rcmds{$to} = $r;
|
||||
|
||||
my $ref = DXCluster->get_exact($to);
|
||||
if ($ref && $ref->dxchan && $ref->dxchan->is_clx) {
|
||||
route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd));
|
||||
} else {
|
||||
route(undef, $to, pc34($main::mycall, $to, $cmd));
|
||||
}
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
|
||||
@ -316,5 +316,22 @@ sub pc51
|
||||
my ($to, $from, $val) = @_;
|
||||
return "PC51^$to^$from^$val^";
|
||||
}
|
||||
|
||||
# clx remote cmd send
|
||||
sub pc84
|
||||
{
|
||||
my($fromnode, $tonode, $call, $msg) = @_;
|
||||
return "PC84^$tonode^$fromnode^$call^$msg^~";
|
||||
}
|
||||
|
||||
# clx remote cmd reply
|
||||
sub pc85
|
||||
{
|
||||
my($fromnode, $tonode, $call, $msg) = @_;
|
||||
return "PC85^$tonode^$fromnode^$call^$msg^~";
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
@ -54,9 +54,12 @@ $filename = undef;
|
||||
wantbeep => '0,Rec Beep,yesno',
|
||||
wantann => '0,Rec Announce,yesno',
|
||||
wantwwv => '0,Rec WWV,yesno',
|
||||
wantwcy => '0,Rec WCY,yesno',
|
||||
wantecho => '0,Rec Echo,yesno',
|
||||
wanttalk => '0,Rec Talk,yesno',
|
||||
wantwx => '0,Rec WX,yesno',
|
||||
wantdx => '0,Rec DX Spots,yesno',
|
||||
pagelth => '0,Current Pagelth',
|
||||
pingint => '9,Node Ping interval',
|
||||
nopings => '9,Ping Obs Count',
|
||||
wantlogininfo => '9,Login info req,yesno',
|
||||
@ -347,6 +350,16 @@ sub wantwwv
|
||||
return _want('wwv', @_);
|
||||
}
|
||||
|
||||
sub wantwcy
|
||||
{
|
||||
return _want('wcy', @_);
|
||||
}
|
||||
|
||||
sub wantecho
|
||||
{
|
||||
return _want('echo', @_);
|
||||
}
|
||||
|
||||
sub wantwx
|
||||
{
|
||||
return _want('wx', @_);
|
||||
@ -370,5 +383,52 @@ sub wantlogininfo
|
||||
return exists $self->{wantlogininfo} ? $self->{wantlogininfo} : 0;
|
||||
}
|
||||
|
||||
sub is_node
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} =~ /[ACRSX]/;
|
||||
}
|
||||
|
||||
sub is_user
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'U';
|
||||
}
|
||||
|
||||
sub is_bbs
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'B';
|
||||
}
|
||||
|
||||
sub is_spider
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'S';
|
||||
}
|
||||
|
||||
sub is_clx
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'C';
|
||||
}
|
||||
|
||||
sub is_dxnet
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'X';
|
||||
}
|
||||
|
||||
sub is_arcluster
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{sort} eq 'R';
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -43,7 +43,6 @@ $param = "$dirprefix/param";
|
||||
sub init
|
||||
{
|
||||
$fp = DXLog::new('wwv', 'dat', 'm');
|
||||
mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
|
||||
do "$param" if -e "$param";
|
||||
confess $@ if $@;
|
||||
}
|
||||
@ -254,9 +253,9 @@ sub dup
|
||||
return 2 if $d < $main::systime - $dupage;
|
||||
|
||||
$d /= 60; # to the nearest minute
|
||||
chomp $text;
|
||||
$text = substr($text, 0, $duplth) if length $text > $duplth;
|
||||
my $dupkey = "$d|$sfi|$k|$a|$text";
|
||||
# chomp $text;
|
||||
# $text = substr($text, 0, $duplth) if length $text > $duplth;
|
||||
my $dupkey = "$d|$sfi|$k|$a";
|
||||
return 1 if exists $dup{$dupkey};
|
||||
$dup{$dupkey} = $d * 60; # in seconds (to the nearest minute)
|
||||
return 0;
|
||||
@ -282,3 +281,4 @@ sub listdups
|
||||
}
|
||||
1;
|
||||
__END__;
|
||||
|
||||
|
||||
@ -207,6 +207,12 @@ sub wwv
|
||||
return 0;
|
||||
}
|
||||
|
||||
# same for wcy broadcasts
|
||||
sub wcy
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
# no idea what or when these are called yet
|
||||
sub userstart
|
||||
{
|
||||
|
||||
@ -60,6 +60,7 @@ package DXM;
|
||||
|
||||
echoon => 'Echoing enabled',
|
||||
echooff => 'Echoing disabled',
|
||||
echow => '*Echoing is currently disabled, set/echo to enable',
|
||||
emaile1 => 'Please enter your email address, set/email <your e-mail address>',
|
||||
emaila => 'Your E-Mail Address is now \"$_[0]\"',
|
||||
email => 'E-mail address set to: $_[0]',
|
||||
@ -121,10 +122,16 @@ package DXM;
|
||||
namee1 => 'Please enter your name, set/name <your name>',
|
||||
namee2 => 'Can\'t find user $_[0]!',
|
||||
name => 'Your name is now \"$_[0]\"',
|
||||
node => '$_[0] set as AK1A style Node',
|
||||
nodec => '$_[0] created as AK1A style Node',
|
||||
nodea => '$_[0] set as AK1A style Node',
|
||||
nodeac => '$_[0] created as AK1A style Node',
|
||||
nodec => '$_[0] set as CLX style Node',
|
||||
nodecc => '$_[0] created as CLX style Node',
|
||||
noder => '$_[0] set as AR-Cluster style Node',
|
||||
noderc => '$_[0] created as AR-Cluster style Node',
|
||||
nodes => '$_[0] set as DXSpider style Node',
|
||||
nodesc => '$_[0] created as DXSpider style Node',
|
||||
nodex => '$_[0] set as DXNET style Node',
|
||||
nodexc => '$_[0] created as DXNET style Node',
|
||||
nodeu => '$_[0] set back as a User',
|
||||
nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
|
||||
ok => 'Operation successful',
|
||||
|
||||
259
perl/WCY.pm
Normal file
259
perl/WCY.pm
Normal file
@ -0,0 +1,259 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# The WCY analog of the WWV geomagnetic information and calculation module
|
||||
#
|
||||
# Copyright (c) 2000 - Dirk Koopman G1TLH
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
package WCY;
|
||||
|
||||
use DXVars;
|
||||
use DXUtil;
|
||||
use DXLog;
|
||||
use Julian;
|
||||
use IO::File;
|
||||
use DXDebug;
|
||||
use Data::Dumper;
|
||||
|
||||
use strict;
|
||||
use vars qw($date $sfi $k $expk $a $r $sa $gmf $au @allowed @denied $fp $node $from
|
||||
$dirprefix $param
|
||||
%dup $duplth $dupage);
|
||||
|
||||
$fp = 0; # the DXLog fcb
|
||||
$date = 0; # the unix time of the WWV (notional)
|
||||
$sfi = 0; # the current SFI value
|
||||
$k = 0; # the current K value
|
||||
$a = 0; # the current A value
|
||||
$r = 0; # the current R value
|
||||
$sa = ""; # solar activity
|
||||
$gmf = ""; # Geomag activity
|
||||
$au = 'no'; # aurora warning
|
||||
$node = ""; # originating node
|
||||
$from = ""; # who this came from
|
||||
@allowed = (); # if present only these callsigns are regarded as valid WWV updators
|
||||
@denied = (); # if present ignore any wwv from these callsigns
|
||||
%dup = (); # the spot duplicates hash
|
||||
$duplth = 20; # the length of text to use in the deduping
|
||||
$dupage = 12*3600; # the length of time to hold spot dups
|
||||
|
||||
$dirprefix = "$main::data/wcy";
|
||||
$param = "$dirprefix/param";
|
||||
|
||||
sub init
|
||||
{
|
||||
$fp = DXLog::new('wcy', 'dat', 'm');
|
||||
do "$param" if -e "$param";
|
||||
confess $@ if $@;
|
||||
}
|
||||
|
||||
# write the current data away
|
||||
sub store
|
||||
{
|
||||
my $fh = new IO::File;
|
||||
open $fh, "> $param" or confess "can't open $param $!";
|
||||
print $fh "# WCY data parameter file last mod:", scalar gmtime, "\n";
|
||||
my $dd = new Data::Dumper([ $date, $sfi, $a, $k, $expk, $r, $sa, $gmf, $au, $from, $node, \@denied, \@allowed ], [qw(date sfi a k expk r sa gmf au from node *denied *allowed)]);
|
||||
$dd->Indent(1);
|
||||
$dd->Terse(0);
|
||||
$dd->Quotekeys(0);
|
||||
$fh->print($dd->Dumpxs);
|
||||
$fh->close;
|
||||
|
||||
# log it
|
||||
$fp->writeunix($date, "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node");
|
||||
}
|
||||
|
||||
# update WWV info in one go (usually from a PC23)
|
||||
sub update
|
||||
{
|
||||
my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_;
|
||||
if ((@allowed && grep {$_ eq $from} @allowed) ||
|
||||
(@denied && !grep {$_ eq $from} @denied) ||
|
||||
(@allowed == 0 && @denied == 0)) {
|
||||
|
||||
# my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime));
|
||||
if ($mydate >= $date) {
|
||||
if ($myr) {
|
||||
$r = 0 + $myr;
|
||||
} else {
|
||||
$r = 0 unless abs ($mysfi - $sfi) > 3;
|
||||
}
|
||||
$sfi = $mysfi;
|
||||
$a = $mya;
|
||||
$k = $myk;
|
||||
$expk = $myexpk;
|
||||
$r = $myr;
|
||||
$sa = $mysa;
|
||||
$gmf = $mygmf;
|
||||
$au = $myau;
|
||||
$date = $mydate;
|
||||
$from = $myfrom;
|
||||
$node = $mynode;
|
||||
|
||||
store();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# add or substract an allowed callsign
|
||||
sub allowed
|
||||
{
|
||||
my $flag = shift;
|
||||
if ($flag eq '+') {
|
||||
push @allowed, map {uc $_} @_;
|
||||
} else {
|
||||
my $c;
|
||||
foreach $c (@_) {
|
||||
@allowed = map {$_ ne uc $c} @allowed;
|
||||
}
|
||||
}
|
||||
store();
|
||||
}
|
||||
|
||||
# add or substract a denied callsign
|
||||
sub denied
|
||||
{
|
||||
my $flag = shift;
|
||||
if ($flag eq '+') {
|
||||
push @denied, map {uc $_} @_;
|
||||
} else {
|
||||
my $c;
|
||||
foreach $c (@_) {
|
||||
@denied = map {$_ ne uc $c} @denied;
|
||||
}
|
||||
}
|
||||
store();
|
||||
}
|
||||
|
||||
#
|
||||
# print some items from the log backwards in time
|
||||
#
|
||||
# This command outputs a list of n lines starting from line $from to $to
|
||||
#
|
||||
sub search
|
||||
{
|
||||
my $from = shift;
|
||||
my $to = shift;
|
||||
my @date = $fp->unixtoj(shift);
|
||||
my $pattern = shift;
|
||||
my $search;
|
||||
my @out;
|
||||
my $eval;
|
||||
my $count;
|
||||
|
||||
$search = 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, \$ref;
|
||||
last if \$count >= \$to; # stop after n
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
$fp->close; # close any open files
|
||||
|
||||
my $fh = $fp->open(@date);
|
||||
for ($count = 0; $count < $to; ) {
|
||||
my @in = ();
|
||||
if ($fh) {
|
||||
while (<$fh>) {
|
||||
chomp;
|
||||
push @in, [ split '\^' ] if length > 2;
|
||||
}
|
||||
eval $eval; # do the search on this file
|
||||
return ("Geomag search error", $@) if $@;
|
||||
last if $count >= $to; # stop after n
|
||||
}
|
||||
$fh = $fp->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 $d = cldate($r->[0]);
|
||||
my $t = (gmtime($r->[0]))[2];
|
||||
|
||||
return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %-3s <%s>",
|
||||
$t, @$r[1..9]);
|
||||
}
|
||||
|
||||
#
|
||||
# read in this month's data
|
||||
#
|
||||
sub readfile
|
||||
{
|
||||
my @date = $fp->unixtoj(shift);
|
||||
my $fh = $fp->open(@date);
|
||||
my @spots = ();
|
||||
my @in;
|
||||
|
||||
if ($fh) {
|
||||
while (<$fh>) {
|
||||
chomp;
|
||||
push @in, [ split '\^' ] if length > 2;
|
||||
}
|
||||
}
|
||||
return @in;
|
||||
}
|
||||
|
||||
# enter the spot for dup checking and return true if it is already a dup
|
||||
sub dup
|
||||
{
|
||||
my ($d, $sfi, $a, $k, $r) = @_;
|
||||
|
||||
# dump if too old
|
||||
return 2 if $d < $main::systime - $dupage;
|
||||
|
||||
$d /= 60; # to the nearest minute
|
||||
# chomp $text;
|
||||
# $text = substr($text, 0, $duplth) if length $text > $duplth;
|
||||
my $dupkey = "$d|$sfi|$k|$a|$r";
|
||||
return 1 if exists $dup{$dupkey};
|
||||
$dup{$dupkey} = $d * 60; # in seconds (to the nearest minute)
|
||||
return 0;
|
||||
}
|
||||
|
||||
# called every hour and cleans out the dup cache
|
||||
sub process
|
||||
{
|
||||
my $cutoff = $main::systime - $dupage;
|
||||
while (my ($key, $val) = each %dup) {
|
||||
delete $dup{$key} if $val < $cutoff;
|
||||
}
|
||||
}
|
||||
|
||||
sub listdups
|
||||
{
|
||||
my @out;
|
||||
for (sort { $dup{$a} <=> $dup{$b} } keys %dup) {
|
||||
my $val = $dup{$_};
|
||||
push @out, "$_ = $val (" . cldatetime($val) . ")";
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
1;
|
||||
__END__;
|
||||
|
||||
@ -16,7 +16,14 @@
|
||||
package main;
|
||||
|
||||
BEGIN {
|
||||
unshift @INC, '.';
|
||||
umask 002;
|
||||
|
||||
# root of directory tree for this system
|
||||
$root = "/spider";
|
||||
$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
|
||||
|
||||
unshift @INC, "$root/perl"; # this IS the right way round!
|
||||
unshift @INC, "$root/local";
|
||||
}
|
||||
|
||||
use strict;
|
||||
|
||||
@ -60,6 +60,7 @@ use CmdAlias;
|
||||
use Filter;
|
||||
use DXDb;
|
||||
use AnnTalk;
|
||||
use WCY;
|
||||
|
||||
use Data::Dumper;
|
||||
use Fcntl ':flock';
|
||||
@ -119,18 +120,18 @@ sub rec
|
||||
# is there one already connected to me - locally?
|
||||
my $user = DXUser->get($call);
|
||||
if (DXChannel->get($call)) {
|
||||
my $mess = DXM::msg($lang, ($user && $user->sort eq 'A') ? 'concluster' : 'conother', $call);
|
||||
my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call);
|
||||
already_conn($conn, $call, $mess);
|
||||
return;
|
||||
}
|
||||
|
||||
# is there one already connected elsewhere in the cluster?
|
||||
if ($user) {
|
||||
if (($user->sort eq 'A' || $call eq $myalias) && !DXCluster->get_exact($call)) {
|
||||
if (($user->is_node || $call eq $myalias) && !DXCluster->get_exact($call)) {
|
||||
;
|
||||
} else {
|
||||
if (DXCluster->get_exact($call)) {
|
||||
my $mess = DXM::msg($lang, $user->sort eq 'A' ? 'concluster' : 'conother', $call);
|
||||
my $mess = DXM::msg($lang, $user->is_node ? 'concluster' : 'conother', $call);
|
||||
already_conn($conn, $call, $mess);
|
||||
return;
|
||||
}
|
||||
@ -153,9 +154,9 @@ sub rec
|
||||
}
|
||||
|
||||
# create the channel
|
||||
$dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U');
|
||||
$dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A');
|
||||
$dxchan = BBS->new($call, $conn, $user) if ($user->sort eq 'B');
|
||||
$dxchan = DXCommandmode->new($call, $conn, $user) if $user->is_user;
|
||||
$dxchan = DXProt->new($call, $conn, $user) if $user->is_node;
|
||||
$dxchan = BBS->new($call, $conn, $user) if $user->is_bbs;
|
||||
die "Invalid sort of user on $call = $sort" if !$dxchan;
|
||||
}
|
||||
|
||||
@ -188,7 +189,7 @@ sub cease
|
||||
|
||||
# disconnect nodes
|
||||
foreach $dxchan (DXChannel->get_all()) {
|
||||
next unless $dxchan->is_ak1a;
|
||||
next unless $dxchan->is_node;
|
||||
disconnect($dxchan) unless $dxchan == $DXProt::me;
|
||||
}
|
||||
Msg->event_loop(1, 0.05);
|
||||
@ -200,7 +201,7 @@ sub cease
|
||||
|
||||
# disconnect users
|
||||
foreach $dxchan (DXChannel->get_all()) {
|
||||
next if $dxchan->is_ak1a;
|
||||
next if $dxchan->is_node;
|
||||
disconnect($dxchan) unless $dxchan == $DXProt::me;
|
||||
}
|
||||
Msg->event_loop(1, 0.05);
|
||||
@ -333,6 +334,7 @@ CmdAlias->init();
|
||||
|
||||
# initialise the Geomagnetic data engine
|
||||
Geomag->init();
|
||||
WCY->init();
|
||||
|
||||
# initial the Spot stuff
|
||||
Spot->init();
|
||||
|
||||
47
src/client.c
47
src/client.c
@ -81,6 +81,7 @@ char *connsort; /* the type of connection */
|
||||
fcb_t *in; /* the fcb of 'stdin' that I shall use */
|
||||
fcb_t *node; /* the fcb of the msg system */
|
||||
char nl = '\n'; /* line end character */
|
||||
char mode = 1; /* 0 - ax25, 1 - normal telnet, 2 - nlonly telnet */
|
||||
char ending = 0; /* set this to end the program */
|
||||
char send_Z = 1; /* set a Z record to the node on termination */
|
||||
char echo = 1; /* echo characters on stdout from stdin */
|
||||
@ -235,7 +236,8 @@ void send_text(fcb_t *f, char *s, int l)
|
||||
if (nl == '\r')
|
||||
*mp->inp++ = nl;
|
||||
else {
|
||||
*mp->inp++ = '\r';
|
||||
if (mode != 2)
|
||||
*mp->inp++ = '\r';
|
||||
*mp->inp++ = '\n';
|
||||
}
|
||||
if (!f->buffer_it)
|
||||
@ -500,6 +502,29 @@ lend:;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* set up the various mode flags, NL endings and things
|
||||
*/
|
||||
void setmode(char *m)
|
||||
{
|
||||
char *connsort = strlower(m);
|
||||
if (eq(connsort, "telnet") || eq(connsort, "local") || eq(connsort, "nlonly") {
|
||||
nl = '\n';
|
||||
echo = 1;
|
||||
mode = eq(connsort, "nlonly") 2 : 1;
|
||||
} else if (eq(connsort, "ax25")) {
|
||||
nl = '\r';
|
||||
echo = 0;
|
||||
mode = 0;
|
||||
} else if (eq(connsort, "connect")) {
|
||||
nl = '\n';
|
||||
echo = 0;
|
||||
mode = 3;
|
||||
} else {
|
||||
die("Connection type must be \"telnet\", \"nlonly\", \"ax25\", \"login\" or \"local\"");
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* things to do with initialisation
|
||||
*/
|
||||
@ -546,20 +571,9 @@ lerr:
|
||||
die("Must have at least a callsign (for now)");
|
||||
|
||||
if (optind < argc) {
|
||||
connsort = strlower(argv[optind]);
|
||||
if (eq(connsort, "telnet") || eq(connsort, "local")) {
|
||||
nl = '\n';
|
||||
echo = 1;
|
||||
} else if (eq(connsort, "ax25")) {
|
||||
nl = '\r';
|
||||
echo = 0;
|
||||
} else {
|
||||
die("2nd argument must be \"telnet\" or \"ax25\" or \"local\"");
|
||||
}
|
||||
setmode(argv[optind]);
|
||||
} else {
|
||||
connsort = "local";
|
||||
nl = '\n';
|
||||
echo = 1;
|
||||
setmode("local");
|
||||
}
|
||||
|
||||
/* this is kludgy, but hey so is the rest of this! */
|
||||
@ -755,7 +769,10 @@ main(int argc, char *argv[])
|
||||
}
|
||||
|
||||
/* is this a login? */
|
||||
if (eq(call, "LOGIN")) {
|
||||
if (eq(call, "LOGIN") || eq(call, "login")) {
|
||||
chgstate(LOGIN);
|
||||
} else if (eq(
|
||||
|
||||
char buf[MAXPACLEN+1];
|
||||
char callsign[MAXCALLSIGN+1];
|
||||
int r, i;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user