sub dbginit
{
+ my $basename = shift || 'debug';
$callback = shift;
# add sig{__DIE__} handling
}
}
- $fp = DXLog::new('debug', 'dat', 'd');
+ $fp = DXLog::new($basename, 'dat', 'd');
dbgclearring();
}
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 {
--- /dev/null
+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;
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 {
}
# 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($_);
}
--- /dev/null
+#!/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;
+
+