+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
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
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
=== 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
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
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;
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();
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));
--- /dev/null
+#
+# 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);
+
+
+
+
+
+
+
+
--- /dev/null
+#
+# 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);
--- /dev/null
+#
+# 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);
#
my $self = shift;
$self->send_now("E", "1");
+$self->user->wantecho(1);
return (1, $self->msg('echoon'));
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);
}
$l = 20 if $l == 0;
$l = 10 if $l < 10;
$self->pagelth($l);
+$self->user->pagelth($l);
return (1, $self->msg('pagelth', $l));
$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 {
}
}
return (1, @out);
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+#
+# 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);
+
+
+
+
+
+
+
+
+
+
+
+
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;
}
#
my $self = shift;
$self->send_now("E", "0");
+$self->user->wantecho(0);
return (1, $self->msg('echooff'));
$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);
}
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;
--- /dev/null
+#
+# 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 ]
+];
+
sub new
{
my $self = DXChannel::alloc(@_);
- $self->{'sort'} = 'B';
return $self;
}
[ '^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) ],
[ '^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) ],
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',
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',
$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;
my $ref;
my @out;
foreach $ref (@list) {
- push @out, $ref if $ref->is_ak1a;
+ push @out, $ref if $ref->is_node;
}
return @out;
}
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;
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
{
use Minimuf;
use DXDb;
use AnnTalk;
+use WCY;
use Sun;
use strict;
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;
}
$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
$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);
$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');
use DXDb;
use AnnTalk;
use Geomag;
+use WCY;
use Time::HiRes qw(gettimeofday tv_interval);
use strict;
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;
}
# 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) {
$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;
}
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;
}
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;
}
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
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
next unless $filter;
}
- if ($dxchan->is_ak1a) {
+ if ($dxchan->is_node) {
next if $dxchan == $self;
if ($hops) {
$routeit = $line;
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;
}
}
+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
{
($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;
}
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};
# 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__
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__
+
+
+
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',
return _want('wwv', @_);
}
+sub wantwcy
+{
+ return _want('wcy', @_);
+}
+
+sub wantecho
+{
+ return _want('echo', @_);
+}
+
sub wantwx
{
return _want('wx', @_);
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__
+
+
+
+
+
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 $@;
}
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;
}
1;
__END__;
+
return 0;
}
+# same for wcy broadcasts
+sub wcy
+{
+ return 0;
+}
+
# no idea what or when these are called yet
sub userstart
{
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]',
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',
--- /dev/null
+#!/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__;
+
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;
use Filter;
use DXDb;
use AnnTalk;
+use WCY;
use Data::Dumper;
use Fcntl ':flock';
# 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;
}
}
# 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;
}
# 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);
# 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);
# initialise the Geomagnetic data engine
Geomag->init();
+WCY->init();
# initial the Spot stuff
Spot->init();
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 */
if (nl == '\r')
*mp->inp++ = nl;
else {
- *mp->inp++ = '\r';
+ if (mode != 2)
+ *mp->inp++ = '\r';
*mp->inp++ = '\n';
}
if (!f->buffer_it)
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
*/
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! */
}
/* 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;
projects / spider.git / commitdiff