+06Jan99========================================================================
+1. Do some range checking for spots and WWV in the future (got a WWV for Oct
+2034 whhich caused a bit of confusion!)
+2. Make WWV spots broadcast them to the users! (as opposed to merely storing
+them)(thank you G0RDI).
+3. Allow users to do show/announce (thank you JE1SGH).
+4. Delay broadcasts to users if they are not in a 'prompt' state (means you can
+add messages and see what you are doing on a busy system)
+5. Made set/unset dx,ann,wx,talk,wwv do what is expected
+6. added set/sys_location and set/set_qra to set the cluster lat/long and qra
+7. New messages will now be announced on logon (if there are any)
03Jan99========================================================================
1. Upped the version no !!!!
2. made the DXProtocol routines much less sensitive to '~' characters (JE1SGH)
's' => [
'^set/nobe', 'unset/beep', 'unset/beep',
'^set/nohe', 'unset/here', 'unset/here',
+ '^set/noan', 'unset/announce', 'unset/announce',
+ '^set/nodx', 'unset/dx', 'unset/dx',
+ '^set/nota', 'unset/talk', 'unset/talk',
+ '^set/noww', 'unset/wwv', 'unset/wwv',
+ '^set/nowx', 'unset/wx', 'unset/wx',
'^sh.*/c/n', 'show/configuration nodes', 'show/configuration',
'^sh.*/c$', 'show/configuration', 'show/configuration',
'^sh.*/dx/(\d+)-(\d+)', 'show/dx $1-$2', 'show/dx',
Remove isolation from a node - SET/ISOLATE
=== 0^SET/LOCATION <lat & long>^Set your latitude and longitude
+=== 9^SET/SYS_LOCATION <lat & long>^Set your cluster latitude and longitude
In order to get accurate headings and such like you must tell the system
what your latitude and longitude is. If you have not yet done a SET/QRA
then this command will set your QRA locator for you. For example:-
your privilege will automatically be set to 0.
=== 0^SET/QRA <locator>^Set your QRA locator
+=== 9^SET/SYS_QRA <locator>^Set your cluster QRA locator
Tell the system what your QRA (or Maidenhead) locator is. If you have not
done a SET/LOCATION then your latitude and longitude will be set roughly
correctly (assuming your locator is correct ;-). For example:-
=== 0^SET/WWV^Allow WWV messages to come out on your terminal
=== 0^UNSET/WWV^Stop WWV messages coming out on your terminal
+=== 0^SET/WX^Allow WX messages to come out on your terminal
+=== 0^UNSET/WX^Stop WX messages coming out on your terminal
+
=== 0^SHOW/DX^Interrogate the spot database
If you just type SHOW/DX you will get the last so many spots
(sysop configurable, but usually 10).
$line =~ s/\^/:/og;
Log('ann', $to, $from, $line);
-DXProt::broadcast_list("To $to de $from <$t>: $line", @locals);
+DXProt::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals);
if ($to ne "LOCAL") {
$line =~ s/\^//og; # remove ^ characters!
my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
if (Spot::add($freq, $spotted, $main::systime, $line, $spotter)) {
# send orf to the users
my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
- DXProt::broadcast_users($buf);
+ DXProt::broadcast_users($buf, 'dx', $buf);
# send it orf to the cluster (hang onto your tin helmets)!
my $chan = DXChannel->get($call);
if ($chan) {
$chan->ann(1);
- push @out, DXM::msg('anns', $call);
+ push @out, $self->msg('anns', $call);
} else {
- push @out, DXM::msg('e3', "Set Announce", $call);
+ push @out, $self->msg('e3', "Set Announce", $call);
}
}
return (1, @out);
$user = DXUser->get_current($call);
if ($user) {
$line = uc $line;
- $user->qra($line);
my ($lat, $long) = DXBearing::stoll($line);
$user->lat($lat);
$user->long($long);
#
my $self = shift;
-return (1, $self->msg('e5')) if $self->priv < 9;
+# this appears to be a reasonable thing for users to do (thank you JE1SGH)
+# return (1, $self->msg('e5')) if $self->priv < 9;
my $cmdline = shift;
my @f = split /\s+/, $cmdline;
my $dxchan = DXCommandmode->get($to); # is it for us?
if ($dxchan && $dxchan->is_user) {
- $dxchan->send("$to de $from $line");
+ $dxchan->send("$to de $from $line") if $dxchan->talk;
Log('talk', $to, $from, $main::mycall, $line);
} else {
$line =~ s/\^//og; # remove any ^ characters
#
-# unset the announce flag
+# set the announce flag
#
# Copyright (c) 1998 - Dirk Koopman
#
foreach $call (@args) {
$call = uc $call;
- my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
- if ($user) {
- $user->ann(0);
+ my $chan = DXChannel->get($call);
+ if ($chan) {
+ $chan->ann(0);
push @out, $self->msg('annu', $call);
} else {
push @out, $self->msg('e3', "Unset Announce", $call);
foreach $call (@args) {
$call = uc $call;
- my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
- if ($user) {
- $user->dx(0);
+ my $chan = DXChannel->get($call);
+ if ($chan) {
+ $chan->dx(0);
push @out, $self->msg('dxu', $call);
} else {
push @out, $self->msg('e3', "Unset DX Spots", $call);
foreach $call (@args) {
$call = uc $call;
- my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
- if ($user) {
- $user->talk(0);
+ my $chan = DXChannel->get($call);
+ if ($chan) {
+ $chan->talk(0);
push @out, $self->msg('talku', $call);
} else {
push @out, $self->msg('e3', "Unset Talk", $call);
foreach $call (@args) {
$call = uc $call;
- my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
- if ($user) {
- $user->wwv(0);
+ my $chan = DXChannel->get($call);
+ if ($chan) {
+ $chan->wwv(0);
push @out, $self->msg('wwvu', $call);
} else {
push @out, $self->msg('e3', "Unset WWV", $call);
# $Id$
#
my ($self, $line) = @_;
-my @f =
+return (1, "not implimented yet");
$to = "LOCAL";
}
-DXProt::broadcast_list("WX de $from <$t>: $line", @locals);
+DXProt::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals);
if ($to ne "LOCAL") {
$line =~ s/\^//og; # remove ^ characters!
my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1);
consort => '9,Connection Type',
'sort' => '9,Type of Channel',
wwv => '0,Want WWV,yesno',
+ wx => '0,Want WX,yesno',
talk => '0,Want Talk,yesno',
ann => '0,Want Announce,yesno',
here => '0,Here?,yesno',
pagedata => '9,Page Data Store',
group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other
isolate => '9,Isolate network,yesno',
+ delayed => '9,Delayed messages,parray',
);
# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
return DXM::msg($self->{lang}, @_);
}
+# stick a broadcast on the delayed queue
+sub delay
+{
+ my $self = shift;
+ my $s = shift;
+
+ $self->{delayed} = [] unless $self->{delayed};
+ push @{$self->{delayed}}, $s;
+}
+
# change the state of the channel - lots of scope for debugging here :-)
sub state
{
$self->{state} = shift;
$self->{func} = '' unless defined $self->{func};
dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
+
+ # if there is any queued up broadcasts then splurge them out here
+ if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'convers')) {
+ for (@{$self->{delayed}}) {
+ $self->send($_);
+ }
+ delete $self->{delayed};
+ }
}
return $self->{state};
}
$self->{consort} = $line; # save the connection type
# set some necessary flags on the user if they are connecting
- $self->{beep} = $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
+ $self->{beep} = $self->{wwv} = $self->{wx} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
# $self->prompt() if $self->{state} =~ /^prompt/o;
# add yourself to the database
$self->send($self->msg('qthe1')) if !$user->qth;
$self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
$self->send($self->msg('hnodee1')) if !$user->qth;
-
+ $self->send($self->msg('msgnew')) if DXMsg::for_me($call);
$self->send($self->msg('pr', $call));
}
$ref->store($ref->{lines});
add_dir($ref);
my $dxchan = DXChannel->get($ref->{to});
- $dxchan->send("New mail has arrived for you") if $dxchan;
+ $dxchan->msg('msgnew') if $dxchan;
Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
}
}
}
}
+# is there a message for me?
+sub for_me
+{
+ my $call = uc shift;
+ my $ref;
+
+ foreach $ref (@msg) {
+ # is it for me, private and unread?
+ if ($ref->{to} eq $call && $ref->{private}) {
+ return 1 if !$ref->{'read'};
+ }
+ }
+ return 0;
+}
+
# start the message off on its travels with a PC28
sub start_msg
{
delete $loc->{lines};
delete $loc->{to};
delete $self->{loc};
- $self->state('prompt');
$self->func(undef);
DXMsg::queue_msg(0);
+ $self->state('prompt');
} elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
#push @out, $self->msg('sendabort');
push @out, "aborted";
Log('talk', $call, $field[1], $field[6], $text);
$call = $main::myalias if $call eq $main::mycall;
my $ref = DXChannel->get($call);
- $ref->send("$call de $field[1]: $text") if $ref;
+ $ref->send("$call de $field[1]: $text") if $ref && $ref->{talk};
} else {
route($field[2], $line); # relay it on its way
}
# convert the date to a unix date
my $d = cltounix($field[3], $field[4]);
- # bang out (and don't pass on) if date is invalid or the spot is too old
- if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) {
- dbg('chan', "Spot ignored, invalid date or too old\n");
+ # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
+ if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
+ dbg('chan', "Spot ignored, invalid date or out of range ($field[3] $field[4])\n");
return;
}
# send orf to the users
if ($spot && $pcno == 11) {
my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
- broadcast_users("$buf\a\a");
+ broadcast_users("$buf\a\a", 'dx', $spot);
}
# DON'T be silly and send on PC26s!
$target = "All" if !$target;
if (@list > 0) {
- broadcast_list("$to$target de $field[1]: $text", @list);
+ broadcast_list("$to$target de $field[1]: $text", 'ann', undef, @list);
} else {
- broadcast_users("$target de $field[1]: $text");
+ broadcast_users("$target de $field[1]: $text", 'ann', undef);
}
Log('ann', $target, $field[1], $text);
dbg('chan', "Dup WWV Spot ignored\n");
return;
}
+ if ($d > $main::systime + 900) {
+ dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
+ return;
+ }
$wwvdup{$dupkey} = $d;
- Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+ my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..$#field]);
my $r;
eval {
# DON'T be silly and send on PC27s!
return if $pcno == 27;
-
+
+ # broadcast to the eager users
+ broadcast_users("WWV de $field[7] <$field[2]>: SFI=$sfi, K=$k, A=$i, $field[6]", 'wwv', $wwv );
last SWITCH;
}
}
# broadcast to all users
+# storing the spot or whatever until it is in a state to receive it
sub broadcast_users
{
my $s = shift; # the line to be rebroadcast
+ my $sort = shift; # the type of transmission
+ my $fref = shift; # a reference to an object to filter on
my @except = @_; # to all channels EXCEPT these (dxchannel refs)
my @dxchan = get_all_users();
my $dxchan;
+ my @out;
foreach $dxchan (@dxchan) {
next if grep $dxchan == $_, @except;
- $s =~ s/\a//og if !$dxchan->{beep};
- $dxchan->send($s); # send it if it isn't the except list or hasn't a passout flag
+ push @out, $dxchan;
}
+ broadcast_list($s, $sort, $fref, @out);
}
# broadcast to a list of users
sub broadcast_list
{
my $s = shift;
+ my $sort = shift;
+ my $fref = shift;
my $dxchan;
foreach $dxchan (@_) {
- $dxchan->send($s); # send it
+
+ next if $sort eq 'dx' && !$dxchan->{dx};
+ next if $sort eq 'ann' && !$dxchan->{ann};
+ next if $sort eq 'wwv' && !$dxchan->{wwv};
+ next if $sort eq 'wx' && !$dxchan->{wx};
+
+ $s =~ s/\a//og unless $dxchan->{beep};
+ if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+ $dxchan->send($s);
+ } else {
+ $dxchan->delay($s);
+ }
}
}
use strict;
use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
-$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
-$forecast = ""; # the current geomagnetic forecast
-$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
+$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
+$forecast = ""; # the current geomagnetic forecast
+$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
my $dirprefix = "$main::data/wwv";
my $param = "$dirprefix/param";
sub init
{
$fp = DXLog::new('wwv', 'dat', 'm');
- mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
+ mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
do "$param" if -e "$param";
confess $@ if $@;
}
# write the current data away
sub store
{
- my $fh = new FileHandle;
- open $fh, "> $param" or confess "can't open $param $!";
- print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
- print $fh "\$date = $date;\n";
- print $fh "\$sfi = $sfi;\n";
- print $fh "\$a = $a;\n";
- print $fh "\$k = $k;\n";
- print $fh "\$from = '$from';\n";
- print $fh "\$node = '$node';\n";
- print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
- print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
- close $fh;
-
- # log it
- $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
+ my $fh = new FileHandle;
+ open $fh, "> $param" or confess "can't open $param $!";
+ print $fh "# Geomagnetic data parameter file last mod:", scalar gmtime, "\n";
+ print $fh "\$date = $date;\n";
+ print $fh "\$sfi = $sfi;\n";
+ print $fh "\$a = $a;\n";
+ print $fh "\$k = $k;\n";
+ print $fh "\$from = '$from';\n";
+ print $fh "\$node = '$node';\n";
+ print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
+ print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
+ close $fh;
+
+ # log it
+ $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node");
}
# update WWV info in one go (usually from a PC23)
sub update
{
- my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $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 ($trydate >= $date) {
- $sfi = 0 + $mysfi;
- $k = 0 + $myk;
- $a = 0 + $mya;
- $forecast = $myforecast;
- $date = $trydate;
- $from = $myfrom;
- $node = $mynode;
-
- store();
+ my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $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) {
+ $sfi = 0 + $mysfi;
+ $k = 0 + $myk;
+ $a = 0 + $mya;
+ $forecast = $myforecast;
+ $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();
+ 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();
+ my $flag = shift;
+ if ($flag eq '+') {
+ push @denied, map {uc $_} @_;
+ } else {
+ my $c;
+ foreach $c (@_) {
+ @denied = map {$_ ne uc $c} @denied;
+ }
+ }
+ store();
}
# accessor routines (when I work how symbolic refs work I might use one of those!)
sub sfi
{
- @_ ? $sfi = shift : $sfi ;
+ @_ ? $sfi = shift : $sfi ;
}
sub k
{
- @_ ? $k = shift : $k ;
+ @_ ? $k = shift : $k ;
}
sub a
{
- @_ ? $a = shift : $a ;
+ @_ ? $a = shift : $a ;
}
sub forecast
{
- @_ ? $forecast = shift : $forecast ;
+ @_ ? $forecast = shift : $forecast ;
}
#
my @out;
my $eval;
my $count;
-
+
$search = 1;
$eval = qq(
my \$c;
my \$ref;
- for (\$c = \$#in; \$c >= 0; \$c--) {
+ 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
+ last if \$count >= \$to; # stop after n
}
}
);
- $fp->close; # close any open files
-
+ $fp->close; # close any open files
+
my $fh = $fp->open(@date);
for ($count = 0; $count < $to; ) {
my @in = ();
chomp;
push @in, [ split '\^' ] if length > 2;
}
- eval $eval; # do the search on this file
+ eval $eval; # do the search on this file
return ("Geomag search error", $@) if $@;
- last if $count >= $to; # stop after n
+ last if $count >= $to; # stop after n
}
- $fh = $fp->openprev(); # get the next file
+ $fh = $fp->openprev(); # get the next file
last if !$fh;
}
-
+
return @out;
}
my @ref = @$r;
my $d = cldate($ref[1]);
my ($t) = (gmtime($ref[1]))[2];
-
+
return sprintf("$d %02d %5d %3d %3d %-37s <%s>", $t, $ref[2], $ref[3], $ref[4], $ref[5], $ref[0]);
}
lockoutun => '$_[0] Unlocked',
m2 => '$_[0] Information: $_[1]',
merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]',
+ msgnew => 'New mail has arrived for you',
namee1 => 'Please enter your name, set/name <your name>',
namee2 => 'Can\'t find user $_[0]!',
name => 'Your name is now \"$_[0]\"',
read2 => 'Msg $_[0] not found',
read3 => 'Msg $_[0] not available',
shutting => '$main::mycall shutting down...',
+ sloc => 'Cluster lat $_[0] long $_[1], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
+ sqra => 'Cluster QRA Locator$_[0], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
talks => 'Talk flag set on $_[0]',
talku => 'Talk flag unset on $_[0]',
usernf => '*** User record for $_[0] not found ***',
wwvs => 'WWV flag set on $_[0]',
wwvu => 'WWV flag unset on $_[0]',
+ wxs => 'WX flag set on $_[0]',
+ wxu => 'WX flag unset on $_[0]',
},
fr => {
},
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
-
-# require Exporter;
-# $Exporter::Verbose = 1;
}
use Msg;
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
-$version = "1.20"; # the version no of the software
+$version = "1.21"; # the version no of the software
$starttime = 0; # the starting time of the cluster
# handle disconnections
projects / spider.git / commitdiff