all dxdebug to have other directories, add wsjtl.pl
authorDirk Koopman <djk@tobit.co.uk>
Sun, 13 Sep 2020 12:11:00 +0000 (13:11 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Sun, 13 Sep 2020 12:11:00 +0000 (13:11 +0100)
perl/DXDebug.pm
perl/DXProt.pm
perl/DXUDP.pm [new file with mode: 0644]
perl/DXUtil.pm
perl/cluster.pl
perl/wsjtl.pl [new file with mode: 0644]

index 9084062c0226020bd9c7aea2f32e2354b466ee48..57a8237a45d48561349f45ebba5c30e9d3efb7f6 100644 (file)
@@ -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();
 }
 
index 6cc0eea4bdb9241e6bb9090ed515b64ef9c27c30..bd317de470d6441e5969edf0d853614db7a913fe 100644 (file)
@@ -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 (file)
index 0000000..28daf80
--- /dev/null
@@ -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</listen> 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<Mojo::IOLoop>.
+
+=cut
+
+has ioloop => sub { Mojo::IOLoop->singleton };
+
+=head2 inactive_timeout
+
+How long a L<connection|Mojo::TFTPd::Connection> 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</Listen>. The L</error>
+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<harryl@cpan.org>
+
+Jan Henning Thorsen - C<jhthorsen@cpan.org>
+
+=cut
+
+1;
index b04cf4905d87435c37e50568c99d48014450264c..5edb1994a3ac80f3d496c6d0bc61b5364cf3abb6 100644 (file)
@@ -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 {
index 36989dee124c599160c31866d34232dff7753974..07fd6ab594630c0606a48bae4932f3abf38e4d2d 100755 (executable)
@@ -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 (file)
index 0000000..2fabfe9
--- /dev/null
@@ -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 = <CLLOCK>;
+               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;
+
+