+29Jan22=======================================================================
+1. Implement RBN set/seeme which displays any passing RBN spots for your
+ callsign in "raw" format.
+28Jan22=======================================================================
+1. Add Capabilities Line to logged in users.
+2. Make absolutely sure that all DB_Files are closed correctly.
+3. Introduce (un)set/debug rbnchan to control the visualisation of raw RBN
+ input lines.
25Jan22=======================================================================
1. Fixed grepdbg so that it does what -help says it does.
24Jan22=======================================================================
--- /dev/null
+#
+# set list of bad dx nodes
+#
+# Copyright (c) 2021 - Dirk Koopman G1TLH
+#
+#
+#
+my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+# are we permitted?
+return (1, $self->msg('e5')) if $self->priv < 6;
+my @out;
+my @added;
+my @in = split /\s+/, $line;
+return (1, "set/badip: need IP, IP-IP or IP/24") unless @in;
+for (@in) {
+ eval{ DXCIDR::add($_); };
+ return (1, "set/badip: $_ $@") if $@;
+ push @added, $_;
+}
+my $count = @added;
+my $list = join ' ', @in;
+push @out, "set/badip: added $count entries: $list";
+return (1, @out);
--- /dev/null
+#
+# set the ve7cc output flag
+#
+# Copyright (c) 2000 - Dirk Koopman
+#
+#
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+
+return (0, $self->msg('e5')) unless $self->isa('DXCommandmode');
+
+$self->rbnseeme(1);
+$self->user->rbnseeme(1);
+RBN::add_seeme($self->call);
+
+push @out, $self->msg('ok');
+return (1, @out);
--- /dev/null
+#
+# set list of bad dx nodes
+#
+# Copyright (c) 2021 - Dirk Koopman G1TLH
+#
+#
+#
+my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+# are we permitted?
+return (1, $self->msg('e5')) if $self->priv < 6;
+my @out;
+my @added;
+my @in = split /\s+/, $line;
+my @list= DXCIDR::list();
+foreach my $list (@list) {
+ if (@in) {
+ for (@in) {
+ if ($list =~ /$_/i) {
+ push @out, $list;
+ last;
+ }
+ }
+ } else {
+ push @out, $list;
+ }
+}
+return (1, @out);
--- /dev/null
+#
+# show/registered
+#
+# show all registered users
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+#
+#
+
+sub handle
+{
+ my ($self, $line) = @_;
+ return (1, $self->msg('e5')) unless $self->priv >= 9;
+
+ my @out;
+
+ use DB_File;
+
+ if ($line) {
+ $line =~ s/[^\w\-\/]+//g;
+ $line = "\U\Q$line";
+ }
+
+ if ($self->{_nospawn}) {
+ @out = generate($self, $line);
+ } else {
+ @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); });
+ }
+
+ return (1, @out);
+}
+
+sub generate
+{
+ my $self = shift;
+ my $line = shift;
+ my @out;
+ my @val;
+
+# dbg("set/register line: $line");
+
+ my %call = ();
+ $call{$_} = 1 for split /\s+/, $line;
+ delete $call{'ALL'};
+
+ my ($action, $count, $key, $data) = (0,0,0,0);
+ unless (keys %call) {
+ for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
+ if ($data =~ m{registered}) {
+ $call{$key} = 1; # possible candidate
+ }
+ }
+ }
+
+ foreach $key (sort keys %call) {
+ my $u = DXUser::get_current($key);
+ if ($u && defined (my $r = $u->registered)) {
+ push @val, "${key}($r)";
+ ++$count;
+ }
+ }
+
+ my @l;
+ push @out, "Registration is " . ($main::reqreg ? "Required" : "NOT Required");
+ foreach my $call (@val) {
+ if (@l >= 5) {
+ push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
+ @l = ();
+ }
+ push @l, $call;
+ }
+ if (@l) {
+ push @l, "" while @l < 5;
+ push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
+ }
+
+ push @out, $self->msg('rec', $count);
+ return @out;
+
+}
+
--- /dev/null
+#
+# unset the RBN seeme flag
+#
+# Copyright (c) 2000 - Dirk Koopman
+#
+#
+#
+
+my ($self, $line) = @_;
+my @out;
+
+return (0, $self->msg('e5')) unless $self->isa('DXCommandmode');
+
+$self->rbnseeme(0);
+$self->user->rbnseeme(0);
+$self->user->put;
+RBN::del_seeme($self->call);
+
+push @out, $self->msg('ok');
+return (1, @out);
priv => '9,Privilege',
prompt => '0,Required Prompt',
rbnfilter => '5,RBN Filt-out',
+ rbnseeme => '0,RBN See Me,yesno',
redirect => '0,Redirect messages to',
registered => '9,Registered?,yesno',
remotecmd => '9,doing rcmd,yesno',
while (my $data = shift @{$self->{inqueue}}) {
my ($sort, $call, $line) = $self->decode_input($data);
next unless defined $sort;
-
- # do the really sexy console interface bit! (Who is going to do the TK interface then?)
- dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
+
+ if ($sort ne 'D') {
+ if (isdbg('chan')) {
+ if (($self->is_rbn && isdbg('rbnchan')) || !$self->is_rbn) {
+ dbg("<- $sort $call $line") if isdbg('chan');
+ }
+ }
+ }
# handle A records
my $user = $self->user;
$self->{name} = $name ? $name : $call;
$self->send($self->msg('l2',$self->{name}));
+ $self->send("Capabilities: ve7cc rbn");
$self->state('prompt'); # a bit of room for further expansion, passwords etc
$self->{priv} = $user->priv || 0;
$self->{lang} = $user->lang || $main::lang || 'en';
$self->{here} = 1;
$self->{prompt} = $user->prompt if $user->prompt;
$self->{lastmsgpoll} = 0;
-
+ $self->{rbnseeme} = $user->rbnseeme;
+ RBN::add_seeme($call) if $self->{rbnseeme};
+
# sort out new dx spot stuff
$user->wantdxcq(0) unless defined $user->{wantdxcq};
$user->wantdxitu(0) unless defined $user->{wantdxitu};
$user->wantusstate(0) unless defined $user->{wantusstate};
-
+
# sort out registration
if ($main::reqreg == 2) {
$self->{registered} = !$user->registered;
return if $self->{disconnecting}++;
delete $self->{senddbg};
+ RBN::del_seeme($call);
my $uref = Route::User::get($call);
my @rout;
sub finish
{
+ dbg("DXDupe finishing");
undef $dbm;
untie %d;
undef %d;
}
return @out;
}
+
+sub END
+{
+ if ($dbm) {
+ dbg("DXDupe ENDing");
+ finish();
+ }
+}
1;
buddies => '0,Buddies,parray',
build => '1,Build',
call => '0,Callsign',
+ clientoutput => '0,User OUT Format',
+ clientinput => '0,User IN Format',
connlist => '1,Connections,parraydifft',
dxok => '9,Accept DX Spots?,yesno', # accept his dx spots?
email => '0,E-mail Address,parray',
prompt => '0,Required Prompt',
qra => '0,Locator',
qth => '0,Home QTH',
- rbnseeme => '0,RBN See Me',
+ rbnseeme => '0,RBN See Me,yesno',
registered => '9,Registered?,yesno',
startt => '0,Start Time,cldatetime',
version => '1,Version',
sub finish
{
+ dbg('DXUser finished');
$dbm->sync;
undef $dbm;
untie %u;
LogDbg('command', $s);
return ($s);
}
-
+
+sub END
+{
+ if ($dbm) {
+ print "DXUser Ended\n";
+ finish();
+ }
+}
+
1;
__END__
sub finish
{
+ dbg("DXQSL finished");
$dbm->sync;
undef $dbm;
untie %u;
return $json->encode($_[0]);
}
+sub END
+{
+ if ($dbm) {
+ dbg "DXQSL ENDing";
+ finish();
+ }
+}
+
1;
my $noinrush = 0; # override the inrushpreventor if set
our $maxdeviants = 5; # the number of deviant QRGs to record for skimmer records
+our %seeme; # the list of users that want to see themselves
+
+
sub init
{
$json = DXJSON->new;
my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
+ # deal with the unix time
+ my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
+ my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
+ $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
+
+ #
+ # But before we do anything, if this call is in the seeme hash then just send the spot to them
+ #
+ if (exists $seeme{$call} && (my $scall = $seeme{$call})) {
+ my $uchan = DXChannel::get($call);
+ if ($uchan->is_user) {
+ if (isdbg('seeme')) {
+ dbg("seeme: $line");
+ dbg( qq{seemme:decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra});
+ }
+ my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
+ my $buf = $uchan->format_dx_spot(@s);
+ dbg("seeme: result '$buf'") if isdbg('seeme');
+ $uchan->local_send('S', $buf) if $scall;
+ } else {
+ LogDbg("RBN Someone is playing silly persons $call is not a user and cannot do 'seeme', ignored and reset");
+ delete $seeme{$call};
+ }
+ }
# find it?
my $cand = $spots->{$sp};
unless ($cand) {
return unless $noinrush || $self->{inrushpreventor} < $main::systime;
# build up a new record and store it in the buildup
- # deal with the unix time
- my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
- my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
- $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
-
# create record and add into the buildup
my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
my $quality = shift;
my $cand = shift;
my $call = $dxchan->{call};
- my $seeme = $dxchan->user->rbnseeme();
my $strength = 100; # because it could if we talk about FTx
my $saver;
my %zone;
++$zone{$s->[SZone]}; # save the spotter's zone
- # if the 'see me' flag is set, then show all the spots without further adornment (see set/rbnseeme for more info)
- if ($seeme) {
- send_final($dxchan, $s);
- next;
- }
-
# save the lowest strength one
if ($r->[RStrength] < $strength) {
$strength = $r->[RStrength];
$buf = $dxchan->format_dx_spot(@$saver);
$saver->[SOrigin] = $call;
}
- $dxchan->local_send('N', $buf);
+ $dxchan->local_send('R', $buf);
}
# per second
return undef;
}
+sub add_seeme
+{
+ my $call = shift;
+ $seeme{$call} = 1;
+}
+
+sub del_seeme
+{
+ my $call = shift;
+ delete $seeme{$call};
+}
1;
return \&new_channel;
}
-our $ceasing;
+my $ceasing;
# cease running this program, close down all the connections nicely
sub cease
cluck("ceasing") if $ceasing;
return if $ceasing++;
+
+ dbg("DXSpider Ceasing");
unless ($is_win) {
$SIG{'TERM'} = 'IGNORE';
UDPMsg::finish();
# end everything else
+ QSL::finish();
RBN::finish();
- DXUser::finish();
DXDupe::finish();
# close all databases
$l->close_server;
}
+ DXUser::finish();
+
LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O ended");
dbg("bye bye everyone - bye bye");
dbgclose();
my ($year) = (gmtime)[5];
$year += 1900;
LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started");
- dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
+ LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH");
+ LogDbg('cluster', "Capabilities: ve7cc rbn");
# load Prefixes
dbg("loading prefixes ...");
exit(0);
+sub END
+{
+ unless ($ceasing) {
+ print "DXSpider Ending\n";
+ cease();
+ }
+}
projects / spider.git / commitdiff