#! /usr/bin/perl -w

# Quite KISS, and assumes there is never any delay in writing. Which
# might be wrong and lead to data loss.  Not that bad because it's
# UDP anyway.

use strict;

use Socket;

# somehost:phantom <-> server:5072  (UDP)
# server:9999 <-> client:phantom2 (TCP)
# client:phantom3 <-> whatever:5072 (UDP)

# Start the TCP client as
#    ./udprelay.pl phantom3 whatever 5072 server:9999
# Start the TCP server as
#    ./udprelay.pl 5072 somehost phantom 9999

my ($local_udp_port, $remote_udp_host, $remote_udp_port, $tcp_spec) = @ARGV;

my $udp_proto = getprotobyname('udp');
my $tcp_proto = getprotobyname('tcp');

socket(UDP, PF_INET, SOCK_DGRAM, $udp_proto);
setsockopt(UDP, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
my $udp_local = sockaddr_in($local_udp_port, INADDR_ANY);
bind(UDP, $udp_local) or die("bind()");

my $iaddr = gethostbyname($remote_udp_host);
my $udp_dest = sockaddr_in($remote_udp_port, $iaddr);

if ($tcp_spec =~ '^(.+):(.+)$') {
   socket(TCP, PF_INET, SOCK_STREAM, $tcp_proto);

   my ($remote_tcp_server, $remote_tcp_port) = ($1, $2);

   $iaddr = gethostbyname($1);
   my $tcp_dest = sockaddr_in($remote_tcp_port, $iaddr);
   connect(TCP, $tcp_dest) or die("TCP connect");
   print "TCP Client Connected.\n";
}
else {
   socket(Server, PF_INET, SOCK_STREAM, $tcp_proto);
   setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
   my $tcp_local = sockaddr_in($tcp_spec, INADDR_ANY);
   bind(Server, $tcp_local) or die("bind()");
   listen(Server, 1);
   my $paddr = accept(TCP, Server) or die("accept()");
   my($port, $iaddr) = sockaddr_in($paddr);

   print "TCP Server Connected from ", inet_ntoa($iaddr), ":", $port, ".\n";
}

my $rin = '';
vec($rin, fileno(TCP), 1) = 1;
vec($rin, fileno(UDP), 1) = 1;

my $buffer;
my $max_len = 1400;
my $tmp_buffer = '';
my $the_length = 0;

while (select(my $rout = $rin, undef, undef, undef)) {
   if (vec($rout, fileno(TCP), 1) == 1) {
      if ($the_length != 0) {
         if (my $actual
                = sysread(TCP, $tmp_buffer, $the_length, length($tmp_buffer))) {
            $the_length -= $actual;
            if ($the_length == 0) {
               send(UDP, $tmp_buffer, 0, $udp_dest);
               $tmp_buffer = '';
            }
         }
      }
      # if trying to get the two bytes of length
      # (when $the_length == 0)
      elsif (length($tmp_buffer) < 2) {
         if (sysread(TCP,
                     $tmp_buffer,
                     2 - length($tmp_buffer),
                     length($tmp_buffer))) {
            if (length($tmp_buffer) == 2) {
               $the_length = unpack('n', $tmp_buffer);
               $tmp_buffer = '';
            }
         }
      }
      else {
         die("fatal 2");
      }        
   }

   if (vec($rout, fileno(UDP), 1) == 1) {
      # no security on actual sender
      if (recv(UDP, $buffer, $max_len, 0)) {
         my $tmp = pack('n', length($buffer));
         (length($tmp) == 2) or die("fatal");
         syswrite(TCP, $tmp, 2);
         syswrite(TCP, $buffer, length($buffer));
      }
   }
}