From 4a134278a40e451ff1769c7b98d1a4f709a6b828 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 26 May 2020 09:18:46 +0100 Subject: [PATCH] WIP RBN --- perl/DXChannel.pm | 8 ++ perl/DXCommandmode.pm | 3 + perl/DXUser.pm | 9 ++ perl/Messages | 2 + perl/RBN.pm | 239 ++++++++++++++++++++++++++++++++++++++++++ perl/cluster.pl | 6 +- perl/rbn.pl | 2 + 7 files changed, 267 insertions(+), 2 deletions(-) create mode 100644 perl/RBN.pm diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 0e543e9c..73102ff4 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -62,6 +62,9 @@ $count = 0; here => '0,Here?,yesno', conf => '0,In Conference?,yesno', dx => '0,DX Spots,yesno', + rbn => '0,RBN Spots,yesno', + ft => '0,(RBN) FT4/8 Spots,yesno', + cw => '0,RBN CW Spots,yesno', redirect => '0,Redirect messages to', lang => '0,Language', func => '5,Function', @@ -679,6 +682,11 @@ sub broadcast_list ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; next unless $filter; } + if ($sort eq 'rbn') { + next unless $dxchan->{dx}; # this is deliberate! + ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; + next unless $filter; + } next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; next if $sort eq 'wwv' && !$dxchan->{wwv}; next if $sort eq 'wcy' && !$dxchan->{wcy}; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 8bb6659e..a75bf157 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -139,6 +139,9 @@ sub start $self->{here} = 1; $self->{prompt} = $user->prompt if $user->prompt; $self->{lastmsgpoll} = 0; + $self->{rbn} = $user->wantrbn; + $self->{ft} = $user->wantft; + $self->{cw} = $user->wantcw; # sort out new dx spot stuff $user->wantdxcq(0) unless defined $user->{wantdxcq}; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 57bef501..1fc8dd86 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -83,6 +83,9 @@ our $maxconnlist = 3; # remember this many connection time (duration) [start, wantdxitu => '0,Show ITU Zone,yesno', wantgtk => '0,Want GTK interface,yesno', wantpc9x => '0,Want PC9X interface,yesno', + wantrbn => '0,Want RBN spots,yesno', + wantft => '0,Want FT4/8 spots,yesno', + wantcw => '0,Want (RBN) CW spots,yesno', lastoper => '9,Last for/oper,cldatetime', nothere => '0,Not Here Text', registered => '9,Registered?,yesno', @@ -835,6 +838,12 @@ sub is_ak1a return $self->{sort} eq 'A'; } +sub is_rbn +{ + my $self = shift; + return $self->{sort} eq 'N' +} + sub unset_passwd { my $self = shift; diff --git a/perl/Messages b/perl/Messages index d1e731af..96167a7e 100644 --- a/perl/Messages +++ b/perl/Messages @@ -234,6 +234,8 @@ package DXM; noderc => '$_[0] created as AR-Cluster style Node', nodes => '$_[0] set as DXSpider style Node', nodesc => '$_[0] created as DXSpider style Node', + noden => '$_[0] set as RBN Feed ', + nodenc => '$_[0] created as RBN Feed', nodex => '$_[0] set as DXNET style Node', nodexc => '$_[0] created as DXNET style Node', nodeu => '$_[0] set back as a User', diff --git a/perl/RBN.pm b/perl/RBN.pm new file mode 100644 index 00000000..b6c0fef0 --- /dev/null +++ b/perl/RBN.pm @@ -0,0 +1,239 @@ +# +# The RBN connection system +# +# Copyright (c) 2020 Dirk Koopman G1TLH +# + +use warnings; +use strict; + +package RBN; + +use 5.10.1; + +use DXUtil; +use DXDebug; +use DXLog; +use DXUser; +use DXChannel; +use Math::Round qw(nearest); + +our @ISA = qw(DXChannel); + +sub new +{ + my $self = DXChannel::alloc(@_); + + # routing, this must go out here to prevent race condx + my $pkg = shift; + my $call = shift; + + DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], ); + $self->{d} = {}; + $self->{spot} = {}; + $self->{last} = 0; + $self->{noraw} = 0; + $self->{nospot} = 0; + $self->{norbn} = 0; + $self->{sort} = 'N'; + $self->{lasttime} = $main::systime; + $self->{minspottime} = 60*60; + $self->{showstats} = 0; + + return $self; +} + +sub start +{ + my ($self, $line, $sort) = @_; + my $user = $self->{user}; + my $call = $self->{call}; + my $name = $user->{name}; + my $dref = $self->{d}; + my $spotref = $self->{spot}; + + # log it + my $host = $self->{conn}->peerhost; + $host ||= "unknown"; + $self->{hostname} = $host; + + $self->{name} = $name ? $name : $call; + $self->state('prompt'); # a bit of room for further expansion, passwords etc + $self->{lang} = $user->lang || $main::lang || 'en'; + if ($line =~ /host=/) { + my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/; + $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h; + unless ($h) { + ($h) = $line =~ /host=([\da..fA..F:]+)/; + $line =~ s/\s*host=[\da..fA..F:]+// if $h; + } + $self->{hostname} = $h if $h; + } + $self->{width} = 80 unless $self->{width} && $self->{width} > 80; + $self->{consort} = $line; # save the connection type + + LogDbg('DXCommand', "$call connected from $self->{hostname}"); + + # set some necessary flags on the user if they are connecting + $self->{registered} = 1; + # sort out privilege reduction + $self->{priv} = 0; + + # get the filters + my $nossid = $call; + $nossid =~ s/-\d+$//; + + $self->{spotsfilter} = Filter::read_in('spots', $call, 0) + || Filter::read_in('spots', $nossid, 0) + || Filter::read_in('spots', 'user_default', 0); + + # clean up qra locators + my $qra = $user->qra; + $qra = undef if ($qra && !DXBearing::is_qra($qra)); + unless ($qra) { + my $lat = $user->lat; + my $long = $user->long; + $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); + } +} + +sub normal +{ + my $self = shift; + my $line = shift; + my @ans; + my $d = $self->{d}; + my $spot = $self->{spot}; + + # save this for them's that need it + my $rawline = $line; + + # remove leading and trailing spaces + chomp $line; + $line =~ s/^\s*//; + $line =~ s/\s*$//; + + # add base RBN + + my $tim = $main::systime; + + # parse line + dbg "RBN:RAW,$line" if isdbg('rbnraw'); + + my ($origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line; + $tx ||= ''; + dbg qq{0:$origin 1:$qrg 2:$call 3:$mode 4:$s 5:m 6:$spd 7:$u 8:$sort 9:$t 10:$tx} if $line =~ /DX/; + + my $b; + + if ($t || $tx) { + + # fix up times for things like 'NXDXF B' etc + if ($tx && $t !~ /^\d{4}Z$/) { + if ($tx =~ /^\d{4}Z$/) { + $b = $t; + $t = $tx; + } else { + dbg "RBN:ERR,$line"; + return (0); + } + } + + # We have an RBN data line, dedupe it very simply on time, ignore QRG completely. + # This works because the skimmers are NTP controlled (or should be) and will receive + # the spot at the same time (velocity factor of the atmosphere and network delays + # carefully (not) taken into account :-) + + # Note, there is no intelligence here, but there are clearly basic heuristics that could + # be applied at this point that reject (more likely rewrite) the call of a busted spot that would + # useful for a zonal hotspot requirement from the cluster node. + + # In reality, this mechanism would be incorporated within the cluster code, utilising the dxqsl database, + # and other resources in DXSpider, thus creating a zone map for an emitted spot. This is then passed through the + # normal "to-user" spot system (where normal spots are sent to be displayed per user) and then be + # processed through the normal, per user, spot filtering system - like a regular spot. + + # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters + # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider + # data sources (for singleton spots) to then generate a "centre" from and to zone (whatever that will mean if it isn't the usual one) + # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user + # and spotted. A map can be generated once per user and spotter as they are essentially mostly static. + # The spotted will only get a coarse position unless other info is available. Programs that parse + # DX bulletins and the online data online databases could be be used and then cached. + + # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and + # ignored. + + # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external + # data requests to ephemeral or semi resident forked processes that do any grunt work and the main + # process to just the standard "message passing" which has been shown to be able to sustain over 5000 + # per second (limited by the test program's output and network speed, rather than DXSpider's handling). + + my $p = "$t|$call"; + ++$self->{noraw}; + return if $d->{$p}; + + # new RBN input + $d->{$p} = $tim; + ++$self->{norbn}; + $qrg = sprintf('%.1f', nearest(.1, $qrg)); # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']). + if (isdbg('rbnraw')) { + my $ss = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t); + $ss .= ",$b" if $b; + dbg "RBNRAW:$ss"; + } + + # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or, + # if we have, has it been a "while" since the last time we spotted it? If it has been spotted + # before then "RESPOT" it. + my $nqrg = nearest(1, $qrg); # normalised to nearest Khz + my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well! + my $ts = $spot->{$sp}; + + if (!$ts || ($self->{minspottime} > 0 && $tim - $ts >= $self->{minspottime})) { + ++$self->{nospot}; + my $tag = $ts ? "RESPOT" : "SPOT"; + $t .= ",$b" if $b; + dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t); + $spot->{$sp} = $tim; + } + } else { + dbg "RBN:DATA,$line" if isdbg('rbn'); + } + + # periodic clearing out of the two caches + if (($tim % 60 == 0 && $tim > $self->{last}) || ($self->{last} && $tim >= $self->{last} + 60)) { + my $count = 0; + my $removed = 0; + + while (my ($k,$v) = each %{$d}) { + if ($tim-$v > 60) { + delete $d->{$k}; + ++$removed + } else { + ++$count; + } + } + dbg "RBN:ADMIN,rbn cache: $removed removed $count remain" if isdbg('rbn'); + $count = $removed = 0; + while (my ($k,$v) = each %{$spot}) { + if ($tim-$v > $self->{minspottime}*2) { + delete $spot->{$k}; + ++$removed; + } else { + ++$count; + } + } + dbg "RBN:ADMIN,spot cache: $removed removed $count remain" if isdbg('rbn'); + + dbg "RBN:" . join(',', "STAT", $self->{noraw}, $self->{norbn}, $self->{nospot}) if $self->{showstats}; + $self->{noraw} = $self->{norbn} = $self->{nospot} = 0; + + $self->{last} = int($tim / 60) * 60; + } +} + + + + +1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 6bd0c744..d3b24ba9 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -147,7 +147,7 @@ use DXXml; use DXSql; use IsoTime; use BPQMsg; - +use RBN; use Data::Dumper; @@ -349,7 +349,9 @@ sub new_channel $user->startt($systime); # mark the start time of this connection if ($user->is_node) { - $dxchan = DXProt->new($call, $conn, $user); + $dxchan = DXProt->new($call, $conn, $user); + } elsif ($user->is_rbn) { + $dxchan = RBN->new($newcall, $conn, $user); } elsif ($user->is_user) { $dxchan = DXCommandmode->new($newcall, $conn, $user); } else { diff --git a/perl/rbn.pl b/perl/rbn.pl index dd69cd28..8fb0bd5d 100755 --- a/perl/rbn.pl +++ b/perl/rbn.pl @@ -93,6 +93,8 @@ my $nospot = 0; while (<$sock>) { chomp; + s/\s*$//; + my $tim = time; # parse line -- 2.34.1