bin/udpovertcp

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4 # Copyright (C) 2004-2007 Jan Kratochvil <project-udpovertcp@jankratochvil.net>
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; exactly version 2 of June 1991 is required
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18
  19
  20 use strict;
  21 use warnings;
  22 use Getopt::Long;
  23 require IO::Socket::INET;
  24 use Fcntl;
  25 use Carp qw(cluck confess);
  26 use Socket;
  27 require IPC::Open2;
  28
  29
  30 $SIG{__DIE__}=sub { confess @_; };
  31 my $V=1;
  32 $|=1;
  33
  34 my $D;
  35 die "$0: <server-addr>:<port> [<local-port>:<server-addr>:<server-port>...]" if !GetOptions(
  36         "d|debug+",\$D,
  37 );
  38
  39 my $forward_arg=shift||"";
  40 my($forward_hostuser,$forward_portuser)=($forward_arg=~/^([\S^:]+):([\S^:]+)$/);
  41 my($forward_in,$forward_out);
  42 my $listen_tcp;
  43 if ($forward_arg=~/^\w+$/) {
  44         $listen_tcp=IO::Socket::INET->new(
  45                 LocalPort=>$forward_arg,
  46                 Proto=>"tcp",
  47                 Listen=>1,
  48                 ReuseAddr=>1,
  49         ) or die "socket(listen-tcp-<$forward_arg>): $!";
  50         die "Excessive arguments: @ARGV" if @ARGV;
  51 } elsif ($forward_hostuser) {
  52         $forward_in=$forward_out=IO::Socket::INET->new(
  53                 Proto=>"tcp",
  54                 PeerHost=>$forward_hostuser,
  55                 PeerPort=>$forward_portuser,
  56         ) or die "socket(connect-tcp-<$forward_hostuser>:<$forward_portuser>): $!";
  57 } elsif ($forward_arg) {
  58         IPC::Open2::open2($forward_in,$forward_out,$forward_arg) or die "$forward_arg: $!";
  59 } else {
  60         $forward_in=\*STDIN;
  61         $forward_out=\*STDOUT;
  62         die "Excessive arguments: @ARGV" if @ARGV;
  63 }
  64
  65 my %listenport;
  66 while (@ARGV) {
  67         my $triple=shift;
  68         my($localport,$serverhostuser,$serverportuser)=($triple=~/^([\S^:]+):([\S^:]+):([\S^:]+)$/);
  69         my $serverhost=gethostbyname $serverhostuser or die "resolving host $serverhostuser: $!";
  70         my $serverport=getservbyname($serverportuser,"udp")||$serverportuser;
  71         my $serveraddr=sockaddr_in($serverport,$serverhost) or die "assembling ".inet_ntoa($serverhost).":$serverport: $!";
  72         die if 16!=length $serveraddr;
  73         my $localsock=IO::Socket::INET->new(
  74                 LocalPort=>$localport,
  75                 Proto=>"udp",
  76                 ReuseAddr=>1,
  77         ) or die "socket(listen-udp-<$forward_arg>): $!";
  78         die $localport if $listenport{$localsock->sockname()};
  79         $listenport{$serveraddr}={
  80                 "localsock"=>$localsock,
  81                 "serverhostuser"=>$serverhostuser,
  82                 "serverportuser"=>$serverportuser,
  83                 "serveraddr"=>$serveraddr,
  84         };
  85 }
  86
  87 my $TYPE_SEND=0;        # SEND,sockaddr_in-where,sockaddr_in-from,length,data
  88
  89 sub sockaddr_in_name($)
  90 {
  91         my($sockaddr_in)=@_;
  92         my($port,$iaddr)=sockaddr_in($sockaddr_in);
  93         my $peer_addr=inet_ntoa($iaddr);
  94         return "$peer_addr:$port";
  95 }
  96
  97 sub send_udp($$$)
  98 {
  99         my($to,$from,$data)=@_;
 100
 101         my $listenport=$listenport{$from}||={
 102                 "localsock"=>do {
 103                         my($from_port,$from_iaddr)=sockaddr_in $from;
 104                         warn "UDP-new-local: port=$from_port\n" if $D;
 105                         IO::Socket::INET->new(
 106                                 LocalPort=>$from_port,
 107                                 ReuseAddr=>1,
 108                                 Proto=>"udp",
 109                         ) or die "New local UDP socket";
 110                 },
 111                 "serveraddr"=>$from,
 112         };
 113         warn "UDP-send: to=<".sockaddr_in_name($to).">,from-stored-serveraddr=<".sockaddr_in_name($from).">\n" if $D;
 114         my $got=send $listenport->{"localsock"},$data,0,$to;
 115         cluck "sendmsg(): $!" if !$got || $got!=length $data;
 116 }
 117
 118 sub got_udp($$$)
 119 {
 120         my($listenport,$peer_addr,$data)=@_;
 121         die if 16!=length $peer_addr;
 122         warn "TCP-write: to=<".sockaddr_in_name($listenport->{"serveraddr"}).">,from=<".sockaddr_in_name($peer_addr).">\n" if $D;
 123         my $packet=pack "Ca16a16Sa*",$TYPE_SEND,$listenport->{"serveraddr"},$peer_addr,length($data),$data;
 124         my $got=syswrite $forward_out,$packet;
 125         cluck "syswrite(): $!" if !$got || $got!=length $packet;
 126 }
 127
 128 warn "START\n" if $D;
 129 my $forward_buf="";
 130 for (;;) {
 131         my $rfds="";
 132         vec($rfds,fileno($forward_in),1)=1 if $forward_in;
 133         vec($rfds,fileno($listen_tcp),1)=1 if $listen_tcp;
 134         for my $listenport (values(%listenport)) {
 135                 vec($rfds,fileno($listenport->{"localsock"}),1)=1;
 136         }
 137         my $got=select $rfds,undef(),undef(),undef();
 138         die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 139         if ($listen_tcp && vec($rfds,fileno($listen_tcp),1)) {
 140                 if ($forward_in) {
 141                         $forward_in eq $forward_out or close $forward_out or confess "Error closing old forward_out socket: $!";
 142                         close $forward_in or confess "Error closing old forward_in socket: $!";
 143                 }
 144                 accept $forward_in,$listen_tcp or confess "Error accepting new TCP socket: $!";
 145                 $forward_out=$forward_in;
 146         }
 147         if ($forward_in && vec($rfds,fileno($forward_in),1)) {
 148                 my $buf;
 149                 fcntl($forward_in,F_SETFL,O_NONBLOCK) or die "fnctl(forward_in,F_SETFL,O_NONBLOCK)";
 150                 my $got=sysread $forward_in,$buf,0x100000;
 151                 fcntl($forward_in,F_SETFL,0)          or die "fnctl(forward_in,F_SETFL,0)";
 152                 if (!$got) {
 153                         die "Got TCP EOF/error on forward_in";
 154                 } elsif ($got==length $buf) {
 155                         $forward_buf.=$buf;
 156                 } else {
 157                         confess "Invalid socket read return value: $got";
 158                 }
 159                 while (length($forward_buf)>=1+16+16+2) {
 160                         my($type,$to,$from,$length,$data)=unpack "Ca16a16Sa*",$forward_buf;
 161                         last if length($data)<$length;
 162                         ($data,$forward_buf)=unpack "a${length}a*",$data;
 163                         die if $length!=length $data;
 164                         die if $type!=$TYPE_SEND;
 165                         send_udp $to,$from,$data;
 166                 }
 167         }
 168         for my $listenport (values(%listenport)) {
 169                 my $localsock=$listenport->{"localsock"};
 170                 next if !vec($rfds,fileno($localsock),1);
 171                 my $buf;
 172                 my $peer_addr=recv $localsock,$buf,0x100000,0;
 173                 if (!$peer_addr || !defined $buf) {
 174                         die "Got TCP EOF/error on one of the listenports";
 175                 } else {
 176                         got_udp $listenport,$peer_addr,$buf;
 177                 }
 178         }
 179 }