From: Dirk Koopman Date: Sun, 13 Sep 2020 12:11:00 +0000 (+0100) Subject: all dxdebug to have other directories, add wsjtl.pl X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=9c8f43f26a7db08c4ff6ef2213c95c9f509abe36 all dxdebug to have other directories, add wsjtl.pl --- diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 9084062c..57a8237a 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -135,6 +135,7 @@ sub dbg sub dbginit { + my $basename = shift || 'debug'; $callback = shift; # add sig{__DIE__} handling @@ -161,7 +162,7 @@ sub dbginit } } - $fp = DXLog::new('debug', 'dat', 'd'); + $fp = DXLog::new($basename, 'dat', 'd'); dbgclearring(); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 6cc0eea4..bd317de4 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -928,7 +928,7 @@ sub gen_my_pc92_config clear_pc92_changes(); # remove any slugged data, we are generating it as now my @dxchan = grep { $_->call ne $main::mycall && !$_->{isolate} } DXChannel::get_all(); dbg("ROUTE: all dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); - my @localnodes = map { my $r = Route::get($_->{call});($_->is_node || $_->is_user) && $r ? $r : () } @dxchan; + my @localnodes = map { my $r = Route::get($_->{call}); ($_->is_node || $_->is_user) && $r ? $r : () } @dxchan; dbg("ROUTE: localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); return pc92c($node, @localnodes); } else { diff --git a/perl/DXUDP.pm b/perl/DXUDP.pm new file mode 100644 index 00000000..28daf805 --- /dev/null +++ b/perl/DXUDP.pm @@ -0,0 +1,158 @@ +package DXUDP; + +=head1 NAME + +DXUDP - A Mojo compatible UDP thingy + +=head1 VERSION + +0.01 + +=head1 SYNOPSIS + + use DXUDP; + my $handle = DXUDP->new; + + $handle->on(read => sub { + my ($handle, $data) = @_; + ... + }); + + $handle->on(error => sub { + warn "DXUDP: $_[1]\n"; + }); + + $handle->on(finish => sub { + my($handle, $c, $error) = @_; + warn "Connection: $error\n" if $error; + }); + + $handle->start; + $handle->ioloop->start unless $handle->ioloop->is_running; + +=head1 DESCRIPTION + +A simple Mojo compatible UDP thingy + +=cut + +use Mojo::Base 'Mojo::EventEmitter'; +use Mojo::IOLoop; +use Scalar::Util qw(weaken); + +our $VERSION = '0.04'; + +=head1 EVENTS + +=head2 error + + $self->on(error => sub { + my($self, $str) = @_; + }); + +This event is emitted when something goes wrong: Fail to L to socket, +read from socket or other internal errors. + +=head2 finish + + $self->on(finish => sub { + my($self, $c, $error) = @_; + }); + +This event is emitted when the client finish, either successfully or due to an +error. C<$error> will be an empty string on success. + +=head2 read + + $self->on(read => sub { + my($self, $data) = @_; + }); + +This event is emitted when a new read request arrives from a client. + +=head1 ATTRIBUTES + +=head2 ioloop + +Holds an instance of L. + +=cut + +has ioloop => sub { Mojo::IOLoop->singleton }; + +=head2 inactive_timeout + +How long a L can stay idle before +being dropped. Default is 0 (no timeout). + +=cut + +has inactive_timeout => 0; + + +=head1 METHODS + +=head2 start + +Starts listening to the address and port set in L. The L +event will be emitted if the server fail to start. + +=cut + +sub start { + my ($self, $args) = (shift, ref $_[0] ? $_[0] : {@_}); + my $reactor = $self->ioloop->reactor; + my $socket; + + my $host = $args->{LocalAddr} || $args->{host} || '0.0.0.0'; + my $port = $args->{LocalPort} || $args->{port} || 1234; + + $socket = IO::Socket::IP->new( + LocalAddr => $host, + LocalPort => $port, + Proto => 'udp', + ); + + if(!$socket) { + return $self->emit(error => "Can't create listen socket: $!"); + }; + + Scalar::Util::weaken($self); + + $socket->blocking(0); + $reactor->io($socket, sub { $self->_incoming }); + $reactor->watch($socket, 1, 0); # watch read events + $self->{socket} = $socket; + + return $self; +} + +sub _incoming { + my $self = shift; + my $socket = $self->{socket}; + my $read = $socket->recv(my $datagram, 65534); + + if(!defined $read) { + $self->emit(error => "Read: $!"); + } + + $self->emit(read => $datagram); +} + + +sub DEMOLISH { + my $self = shift; + my $reactor = eval { $self->ioloop->reactor } or return; # may be undef during global destruction + + $reactor->remove($self->{socket}) if $self->{socket}; +} + +=head1 AUTHOR + +Svetoslav Naydenov - C + +Jan Henning Thorsen - C + +=cut + +1; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index b04cf490..5edb1994 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -549,7 +549,7 @@ sub difft if (ref $b eq 'ARRAY') { $t = $b->[1] - $b->[0]; } else { - if ($adds && $adds >= $b) { + if ($adds && $adds =~ /^\d+$/ && $adds >= $b) { $t = $adds - $b; $adds = shift; } else { diff --git a/perl/cluster.pl b/perl/cluster.pl index 36989dee..07fd6ab5 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -488,7 +488,7 @@ sub setup_start } # open the debug file, set various FHs to be unbuffered - dbginit($broadcast_debug ? \&DXCommandmode::broadcast_debug : undef); + dbginit(undef, $broadcast_debug ? \&DXCommandmode::broadcast_debug : undef); foreach (@debug) { dbgadd($_); } diff --git a/perl/wsjtl.pl b/perl/wsjtl.pl new file mode 100644 index 00000000..2fabfe9e --- /dev/null +++ b/perl/wsjtl.pl @@ -0,0 +1,99 @@ +#!/usr/binenv perl +# +# A basic listener and decoder of wsjtx packets +# +# + +our ($systime, $root, $local_data); + +BEGIN { + umask 002; + $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; + + # take into account any local::lib that might be present + eval { + require local::lib; + }; + unless ($@) { +# import local::lib; + import local::lib qw(/spider/perl5lib); + } + + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl5lib" unless grep {$_ eq "$root/perl5lib"} @INC; + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; + + # do some validation of the input + die "The directory $root doesn't exist, please RTFM" unless -d $root; + + # locally stored data lives here + $local_data = "$root/local_data"; + mkdir $local_data, 02774 unless -d $local_data; + + # try to create and lock a lockfile (this isn't atomic but + # should do for now + $lockfn = "$root/local_data/wsjtxl.lck"; # lock file name + if (-w $lockfn) { + open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!"; + my $pid = ; + if ($pid) { + chomp $pid; + if (kill 0, $pid) { + warn "Lockfile ($lockfn) and process $pid exist, another cluster running?\n"; + exit 1; + } + } + unlink $lockfn; + close CLLOCK; + } + open(CLLOCK, ">$lockfn") or die "Can't open Lockfile ($lockfn) $!"; + print CLLOCK "$$\n"; + close CLLOCK; + + $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows? + $systime = time; +} + +use strict; +use warnings; +use 5.22.0; + +use Mojolicious 8.1; +use Mojo::IOLoop; +use Mojo::IOLoop::Server; +use DXDebug; +use DXUDP; + +use WSJTX; + +our $udp_host = '0.0.0.0'; +our $udp_port = 2237; +our $tcp_host = '::'; +our $tcp_port = 2238; + +my $uh; # the mojo handle for the UDP listener +my $th; # ditto TCP +my $wsjtx; # the wsjtx decoder + + +our %slot; # where the connected TCP client structures live + + +dbginit('wsjtl'); +dbgadd('udp'); + +$uh = DXUDP->new; +$uh->start(host => $udp_host, port => $udp_port) or die "Cannot listen on $udp_host:$udp_port $!\n"; + +$wsjtx = WSJTX->new(); +$uh->on(read => sub {wstjx->handle(@_)}); + +Mojo::IOLoop->start() unless Mojo::IOLoop->is_running; + +exit; + +