perl/wsjtl.pl

   1 #!/usr/bin/env perl
   2 #
   3 # A basic listener and decoder of wsjtx packets
   4 #
   5 #
   6
   7 our ($systime, $root, $local_data);
   8
   9 BEGIN {
  10         umask 002;
  11         $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
  12
  13         # take into account any local::lib that might be present
  14         eval {
  15                 require local::lib;
  16         };
  17         unless ($@) {
  18 #               import local::lib;
  19                 import local::lib qw(/spider/perl5lib);
  20         }
  21
  22         # root of directory tree for this system
  23         $root = "/spider";
  24         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  25
  26         unshift @INC, "$root/perl5lib" unless grep {$_ eq "$root/perl5lib"} @INC;
  27         unshift @INC, "$root/perl";     # this IS the right way round!
  28         unshift @INC, "$root/local";
  29
  30         # do some validation of the input
  31         die "The directory $root doesn't exist, please RTFM" unless -d $root;
  32
  33         # locally stored data lives here
  34         $local_data = "$root/local_data";
  35         mkdir $local_data, 02774 unless -d $local_data;
  36
  37         # try to create and lock a lockfile (this isn't atomic but
  38         # should do for now
  39         $lockfn = "$root/local_data/wsjtxl.lck";       # lock file name
  40         if (-w $lockfn) {
  41                 open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
  42                 my $pid = <CLLOCK>;
  43                 if ($pid) {
  44                         chomp $pid;
  45                         if (kill 0, $pid) {
  46                                 warn "Lockfile ($lockfn) and process $pid exist, another cluster running?\n";
  47                                 exit 1;
  48                         }
  49                 }
  50                 unlink $lockfn;
  51                 close CLLOCK;
  52         }
  53         open(CLLOCK, ">$lockfn") or die "Can't open Lockfile ($lockfn) $!";
  54         print CLLOCK "$$\n";
  55         close CLLOCK;
  56
  57         $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows?
  58         $systime = time;
  59 }
  60
  61 use strict;
  62 use warnings;
  63 use 5.22.0;
  64
  65 use Mojolicious 8.1;
  66 use Mojo::IOLoop;
  67 use Mojo::IOLoop::Server;
  68 use DXDebug;
  69 use DXUDP;
  70
  71 use WSJTX;
  72
  73 our $udp_host = '::';
  74 our $udp_port = 2237;
  75 our $tcp_host = '::';
  76 our $tcp_port = 2238;
  77
  78 my $uh;                                                 # the mojo handle for the UDP listener
  79 my $th;                                                 #  ditto TCP
  80 my $wsjtx;                                              # the wsjtx decoder
  81 my $cease;
  82
  83 our %slot;                        # where the connected TCP client structures live
  84
  85
  86 dbginit('wsjtl');
  87
  88 my @queue;
  89
  90 $uh = DXUDP->new;
  91 $uh->start(host => $udp_host, port => $udp_port) or die "Cannot listen on $udp_host:$udp_port $!\n";
  92
  93 $wsjtx = WSJTX->new();
  94 $uh->on(read => \&_udpread);
  95
  96 $th = Mojo::IOLoop::Server->new;
  97 $th->on(accept => \&_accept);
  98 $th->listen(address => $tcp_host, port => $tcp_port);
  99 $th->start;
 100
 101 Mojo::IOLoop->start() unless Mojo::IOLoop->is_running;
 102
 103 exit;
 104
 105 sub _udpread
 106 {
 107         my ($handle, $data) = @_;
 108
 109         my $host = $handle->peerhost;
 110         my $port = $handle->peerport;
 111
 112         my $in = $wsjtx->handle($handle, $data, "$host:$port");
 113
 114         distribute($in) if $in && length $in;
 115 }
 116
 117 sub _accept
 118 {
 119         my ($id, $handle) = @_;
 120         my $host = $handle->peerhost;
 121         my $port = $handle->peerport;
 122
 123
 124         my $s = $slot{"$host:$port"} = { addr => "$host:$port"};
 125         my $stream = $s->{stream} = Mojo::IOLoop::Stream->new($handle);
 126         $stream->on(error => sub { $stream->close; delete $s->{addr}});
 127         $stream->on(close => sub { delete $s->{addr}});
 128         $stream->on(read => sub {_tcpread($s, $_[1])});
 129         $stream->timeout(0);
 130         $stream->start;
 131 }
 132
 133 sub _tcpread
 134 {
 135         my $s = shift;
 136         my $data = shift;
 137
 138         dbg("incoming: $data");
 139 }
 140
 141 sub distribute
 142 {
 143         my $in = shift;
 144         foreach my $c (values %slot) {
 145                 $c->{stream}->write("$in\r\n");
 146         }
 147 }
 148
 149
 150